1{-# LANGUAGE TupleSections #-}
2
3module Test.Directory(main) where
4
5import Development.Shake
6import Development.Shake.FilePath
7import Test.Type
8import Data.List
9import Data.Function
10import Control.Monad
11import General.Extra
12import System.Directory(createDirectory)
13import qualified System.Directory as IO
14import qualified System.IO.Extra as IO
15
16
17-- Use escape characters, _o=* _l=/ __=<space>
18readEsc ('_':'o':xs) = '*' : readEsc xs
19readEsc ('_':'l':xs) = '/' : readEsc xs
20readEsc ('_':'_':xs) = ' ' : readEsc xs
21readEsc (x:xs) = x : readEsc xs
22readEsc [] = []
23
24showEsc = concatMap f
25    where f '*' = "_o"
26          f '/' = "_l"
27          f ' ' = "__"
28          f x = [x]
29
30
31main = testBuild test $ do
32    "*.contents" %> \out ->
33        writeFileLines out =<< getDirectoryContents (readEsc $ dropExtension out)
34    "*.dirs" %> \out ->
35        writeFileLines out =<< getDirectoryDirs (readEsc $ dropExtension out)
36    "*.files" %> \out -> do
37        let pats = readEsc $ dropExtension out
38        let (x:xs) = ["" | " " `isPrefixOf` pats] ++ words pats
39        writeFileLines out . map toStandard =<< getDirectoryFiles x xs
40
41    "*.exist" %> \out -> do
42        let xs = words $ readEsc $ dropExtension out
43        fs <- mapM doesFileExist xs
44        ds <- mapM doesDirectoryExist xs
45        let bool x = if x then "1" else "0"
46        writeFileLines out $ zipWith ((++) `on` bool) fs ds
47
48    "dots" %> \out -> do
49        b1 <- liftM2 (==) (getDirectoryContents ".") (getDirectoryContents "")
50        b2 <- liftM2 (==) (getDirectoryDirs ".") (getDirectoryDirs "")
51        b3 <- liftM2 (==) (getDirectoryFiles "." ["*.txt"]) (getDirectoryFiles "" ["*.txt"])
52        b4 <- liftM2 (==) (getDirectoryFiles "." ["C.txt/*.txt"]) (getDirectoryFiles "" ["C.txt/*.txt"])
53        b5 <- liftM2 (==) (getDirectoryFiles "." ["//*.txt"]) (getDirectoryFiles "" ["//*.txt"])
54        writeFileLines out $ map show [b1,b2,b3,b4,b5]
55
56test build = do
57    let demand x ys = let f = showEsc x in do build [f]; assertContents f $ unlines $ words ys
58    build ["clean"]
59    demand " *.txt.files" ""
60    demand " //*.txt.files" ""
61    demand ".dirs" ""
62    demand "A.txt B.txt C.txt.exist" "00 00 00"
63
64    writeFile "A.txt" ""
65    writeFile "B.txt" ""
66    createDirectory "C.txt"
67    writeFile "C.txt/D.txt" ""
68    writeFile "C.txt/E.xtx" ""
69    demand " *.txt.files" "A.txt B.txt"
70    demand ".dirs" "C.txt"
71    demand "A.txt B.txt C.txt.exist" "10 10 01"
72    demand " //*.txt.files" "A.txt B.txt C.txt/D.txt"
73    demand "C.txt *.txt.files" "D.txt"
74    demand " *.txt //*.xtx.files" "A.txt B.txt C.txt/E.xtx"
75    demand " C.txt/*.files" "C.txt/D.txt C.txt/E.xtx"
76
77    demand " missing_dir/*.files" ""
78    demand " missing_dir/bar/*.files" ""
79    demand " //missing_dir/*.files" ""
80    assertException ["missing_dir","does not exist"] $ build ["--quiet",showEsc "missing_dir *.files"]
81
82    build ["dots","--no-lint"]
83    assertContents "dots" $ unlines $ words "True True True True True"
84
85    let removeTest pat del keep =
86            IO.withTempDir $ \dir -> do
87                forM_ (del ++ keep) $ \s -> do
88                    createDirectoryRecursive $ dir </> takeDirectory s
89                    unless (hasTrailingPathSeparator s) $
90                        writeFile (dir </> s) ""
91                removeFiles dir pat
92                createDirectoryRecursive dir
93                forM_ (map (False,) del ++ map (True,) keep) $ \(b,s) -> do
94                    b2 <- (if hasTrailingPathSeparator s then IO.doesDirectoryExist else IO.doesFileExist) $ dir </> s
95                    when (b /= b2) $ do
96                        let f b = if b then "present" else "missing"
97                        error $ "removeFiles mismatch: with pattern " ++ show pat ++ ", " ++ s ++
98                                " should be " ++ f b ++ " but is " ++ f b2
99
100    removeTest ["//bob"] ["test/bob","more/bob"] ["extra/obo"]
101    removeTest ["bob"] ["bob/"] ["bar/"]
102    removeTest ["*.hs"] ["test.hs"] ["extra/more.hs","new.txt"]
103    removeTest ["baz"] ["baz"] ["foo","bar/bob"]
104    removeTest ["baz"] ["baz/bob","baz/"] ["foo","bar/bob"]
105    removeTest ["Foo//*"] ["Foo/bar","Foo/Quux/bar","Foo/Quux/"] []
106    removeTest ["Foo//"] ["Foo/"] ["bar"]
107    removeTest ["baz"] [] ["test.hs","bar/","foo/"]
108    removeTest ["bob//*"] [] ["test/bob/"]
109    removeTest ["//bob"] ["test/bob/"] ["test/"]
110    removeTest ["//*.txt"] ["more/a.txt"] ["more/"]
111    removeTest ["//*.txt"] ["more/a.txt/"] ["more/"]
112    removeTest ["//*.txt"] ["more/a.txt/","more/b.txt"] ["more/"]
113    removeTest ["//*.txt"] [] ["more/"]
114    removeTest ["a//b"] ["a/c/b"] []
115    removeFiles "non-existing-directory" ["*"]
116