1{-# LANGUAGE CPP #-}
2module Tests.Directory where
3
4import Test.Framework
5import Test.Framework.Providers.HUnit
6import Test.Framework.Providers.QuickCheck2
7import Test.QuickCheck (Property, (===))
8import Test.HUnit.Base hiding (Test)
9import Data.Function (on)
10#if !MIN_VERSION_base(4,8,0)
11import Data.Monoid (mappend)
12#endif
13import Data.List ((\\), sort)
14import qualified Data.DList as DList
15
16import System.FilePath.Glob.Base
17import System.FilePath.Glob.Directory
18import System.FilePath.Glob.Primitive
19import System.FilePath.Glob.Utils
20import Tests.Base (PString, unPS)
21
22tests :: Test
23tests = testGroup "Directory"
24   [ testCase "includeUnmatched" caseIncludeUnmatched
25   , testCase "onlyMatched" caseOnlyMatched
26   , testGroup "commonDirectory"
27       [ testGroup "edge-cases" testsCommonDirectoryEdgeCases
28       , testProperty "property" prop_commonDirectory
29       ]
30   , testCase "globDir1" caseGlobDir1
31   , testGroup "repeated-path-separators" testsRepeatedPathSeparators
32   ]
33
34caseIncludeUnmatched :: Assertion
35caseIncludeUnmatched = do
36   let pats = ["**/D*.hs", "**/[MU]*.hs"]
37   everything <- getRecursiveContentsDir "System"
38   let expectedMatches =
39          [ [ "System/FilePath/Glob/Directory.hs" ]
40          , [ "System/FilePath/Glob/Match.hs"
41            , "System/FilePath/Glob/Utils.hs"
42            ]
43          ]
44   let everythingElse = everything \\ concat expectedMatches
45
46   result <- globDirWith (GlobOptions matchDefault True)
47                         (map compile pats)
48                         "System"
49   mapM_ (uncurry assertEqualUnordered) (zip expectedMatches (fst result))
50
51   case snd result of
52       Nothing -> assertFailure "Expected Just a list of unmatched files"
53       Just unmatched -> assertEqualUnordered everythingElse unmatched
54
55caseOnlyMatched :: Assertion
56caseOnlyMatched = do
57   let pats = ["**/D*.hs", "**/[MU]*.hs"]
58   let expectedMatches =
59          [ [ "System/FilePath/Glob/Directory.hs" ]
60          , [ "System/FilePath/Glob/Match.hs"
61            , "System/FilePath/Glob/Utils.hs"
62            ]
63          ]
64
65   result <- globDirWith globDefault
66                         (map compile pats)
67                         "System"
68
69   mapM_ (uncurry assertEqualUnordered) (zip expectedMatches (fst result))
70   assertEqual "" Nothing (snd result)
71
72caseGlobDir1 :: Assertion
73caseGlobDir1 = do
74   -- this is little a bit of a hack; we pass the same pattern twice to ensure
75   -- that the optimization in the single pattern case is bypassed
76   let naiveGlobDir1 p = fmap head . globDir [p, p]
77   let pat = compile "FilePath/*/*.hs"
78   let dir = "System"
79
80   actual <- globDir1 pat dir
81   expected <- naiveGlobDir1 pat dir
82   assertEqual "" expected actual
83
84assertEqualUnordered :: (Ord a, Show a) => [a] -> [a] -> Assertion
85assertEqualUnordered = assertEqual "" `on` sort
86
87-- Like 'getRecursiveContents', except this function removes the root directory
88-- from the returned list, so that it should match* the union of matched and
89-- unmatched files returned from 'globDirWith', where the same directory was
90-- given as the directory argument.
91--
92-- * to be a little more precise, these files will only match up to
93-- normalisation of paths e.g. some patterns will cause the list of matched
94-- files to contain repeated slashes, whereas the list returned by this
95-- function will not have repeated slashes.
96getRecursiveContentsDir :: FilePath -> IO [FilePath]
97getRecursiveContentsDir root =
98  fmap (filter (/= root) . DList.toList) (getRecursiveContents root)
99
100-- These two patterns should always be equal
101prop_commonDirectory' :: String -> (Pattern, Pattern)
102prop_commonDirectory' str =
103   let pat    = compile str
104       (a, b) = commonDirectory pat
105    in (pat, literal a `mappend` b)
106
107prop_commonDirectory :: PString -> Property
108prop_commonDirectory = uncurry (===) . prop_commonDirectory' . unPS
109
110testsCommonDirectoryEdgeCases :: [Test]
111testsCommonDirectoryEdgeCases = zipWith mkTest [1 :: Int ..] testData
112 where
113   mkTest i (input, expected) =
114      testCase (show i) $ do
115         assertEqual "" expected (commonDirectory (compile input))
116         uncurry (assertEqual "") (prop_commonDirectory' input)
117
118   testData =
119      [ ("[.]/*", ("", compile "[.]"))
120      , ("foo/[.]bar/*", ("", compile "[.]"))
121      , ("[.]foo/bar/*", ("", compile "[.]foo/bar/*"))
122      , ("foo.bar/baz/*", ("foo.bar/baz/", compile "*"))
123      , ("[f]oo[.]/bar/*", ("foo./bar/", compile "*"))
124      , ("foo[.]bar/baz/*", ("foo.bar/baz/", compile "*"))
125      , (".[.]/foo/*", ("../foo/", compile "*"))
126      ]
127
128-- see #16
129testsRepeatedPathSeparators :: [Test]
130testsRepeatedPathSeparators = zipWith mkTest [1 :: Int ..] testData
131 where
132   mkTest i (dir, pat, expected) =
133      testCase (show i) $ do
134         actual <- globDir1 (compile pat) dir
135         assertEqualUnordered expected actual
136
137   testData =
138      [ ( "System"
139        , "*//Glob///[U]*.hs"
140        , [ "System/FilePath//Glob///Utils.hs"
141          ]
142        )
143      , ( "System"
144        , "**//[GU]*.hs"
145        , [ "System/FilePath//Glob.hs"
146          , "System/FilePath/Glob//Utils.hs"
147          ]
148        )
149      , ( "System"
150        , "File**/"
151        , [ "System/FilePath/"
152          ]
153        )
154      , ( "System"
155        , "File**//"
156        , [ "System/FilePath//"
157          ]
158        )
159      , ( "System"
160        , "File**///"
161        , [ "System/FilePath///"
162          ]
163        )
164      , ( "System/FilePath"
165        , "**//Glob.hs"
166        , [ "System/FilePath//Glob.hs"
167          ]
168        )
169      , ( "System"
170        , "**Path/Glob//Utils.hs"
171        , [ "System/FilePath/Glob//Utils.hs"
172          ]
173        )
174      ]
175