1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
module Main
where
-- do a quick test for Darcs:
import System.Directory.Tree
import Control.Applicative
import qualified Data.Foldable as F
import System.Directory
import System.Process
import System.IO.Error(ioeGetErrorType,isPermissionErrorType)
import Control.Monad(void)
testDir :: FilePath
testDir = "/tmp/TESTDIR-LKJHBAE"
main :: IO ()
main = do
putStrLn "-- The following tests will either fail with an error "
putStrLn "-- message or with an 'undefined' error"
-- write our testing directory structure to disk. We include Failed
-- constructors which should be discarded:
_:/written <- writeDirectory testTree
putStrLn "OK"
if (fmap (const ()) (filterDir (not . failed) $dirTree testTree)) ==
filterDir (not . failed) written
then return ()
else error "writeDirectory returned a tree that didn't match"
putStrLn "OK"
-- make file farthest to the right unreadable:
(Dir _ [_,_,Dir "C" [_,_,File "G" p_unreadable]]) <- sortDir . dirTree <$> build testDir
setPermissions p_unreadable emptyPermissions{readable = False,
writable = True,
executable = True,
searchable = True}
putStrLn "OK"
-- read with lazy and standard functions, compare for equality. Also test that our crazy
-- operator works correctly inline with <$>:
tL <- readDirectoryWithL readFile testDir
t@(_:/Dir _ [_,_,Dir "C" [unreadable_constr,_,_]]) <- sortDir </$> id <$> readDirectory testDir
if t == tL then return () else error "lazy read /= standard read"
putStrLn "OK"
-- make sure the unreadable file left the correct error type in a Failed:
if isPermissionErrorType $ ioeGetErrorType $ err unreadable_constr
then return ()
else error "wrong error type for Failed file read"
putStrLn "OK"
-- run lazy fold, concating file contents. compare for equality:
tL_again <- sortDir </$> readDirectoryWithL readFile testDir
let tL_concated = F.concat $ dirTree tL_again
if tL_concated == "abcdef" then return () else error "foldable broke"
putStrLn "OK"
-- get a lazy DirTree at root directory with lazy Directory traversal:
putStrLn "-- If lazy IO is not working, we should be stalled right now "
putStrLn "-- as we try to read in the whole root directory tree."
putStrLn "-- Go ahead and press CTRL-C if you've read this far"
mapM_ putStr =<< (map name . contents . dirTree) <$> readDirectoryWithL readFile "/"
putStrLn "\nOK"
let undefinedOrdFailed = Failed undefined undefined :: DirTree Char
undefinedOrdDir = Dir undefined undefined :: DirTree Char
undefinedOrdFile = File undefined undefined :: DirTree Char
-- simple equality and sorting
if Dir "d" [File "b" "b",File "a" "a"] == Dir "d" [File "a" "a", File "b" "b"] &&
-- recursive sort order, enforces non-recursive sorting of Dirs
Dir "d" [Dir "b" undefined,File "a" "a"] /= Dir "d" [File "a" "a", Dir "c" undefined] &&
-- check ordering of constructors:
undefinedOrdFailed < undefinedOrdDir &&
undefinedOrdDir < undefinedOrdFile &&
-- check ordering by dir contents list length:
Dir "d" [File "b" "b",File "a" "a"] > Dir "d" [File "a" "a"] &&
-- recursive ordering on contents:
Dir "d" [File "b" "b", Dir "c" [File "a" "b"]] > Dir "d" [File "b" "b", Dir "c" [File "a" "a"]]
then putStrLn "OK"
else error "Ord/Eq instance is messed up"
if Dir "d" [File "b" "b",File "a" "a"] `equalShape` Dir "d" [File "a" undefined, File "b" undefined]
then putStrLn "OK"
else error "equalShape or comparinghape functions broken"
-- clean up by removing the directory:
void $ system $ "rm -r " ++ testDir
putStrLn "SUCCESS"
testTree :: AnchoredDirTree String
testTree = "" :/ Dir testDir [dA , dB , dC , Failed "FAAAIIILL" undefined]
where dA = Dir "A" [dA1 , dA2 , Failed "FAIL" undefined]
dA1 = Dir "A1" [File "A" "a", File "B" "b"]
dA2 = Dir "A2" [File "C" "c"]
dB = Dir "B" [File "D" "d"]
dC = Dir "C" [File "E" "e", File "F" "f", File "G" "g"]
|
