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