diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index bbb527cdcdd..ed05a1d1f17 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -163,6 +163,7 @@ library Distribution.Compat.Exception Distribution.Compat.ReadP Distribution.Compiler + Distribution.Utils.Glob Distribution.InstalledPackageInfo Distribution.License Distribution.Make @@ -241,6 +242,9 @@ library Distribution.Simple.GHC.IPI641 Distribution.Simple.GHC.IPI642 Distribution.Simple.GHC.ImplInfo + Distribution.Utils.Glob.Type + Distribution.Utils.Glob.Parse + Distribution.Utils.Glob.Match Paths_Cabal if flag(bundled-binary-generic) @@ -260,6 +264,7 @@ test-suite unit-tests UnitTests.Distribution.Compat.ReadP UnitTests.Distribution.Simple.Program.Internal UnitTests.Distribution.Utils.NubList + UnitTests.Distribution.Utils.Glob main-is: UnitTests.hs build-depends: base, diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs index 9127acfb7a9..05147fd67f9 100644 --- a/Cabal/Distribution/PackageDescription/Check.hs +++ b/Cabal/Distribution/PackageDescription/Check.hs @@ -55,7 +55,7 @@ import Distribution.License import Distribution.Simple.CCompiler ( filenameCDialect ) import Distribution.Simple.Utils - ( cabalVersion, intercalate, parseFileGlob, FileGlob(..), lowercase ) + ( cabalVersion, intercalate, parseFileGlob, isRealGlob, lowercase ) import Distribution.Version ( Version(..) @@ -1098,8 +1098,8 @@ checkCabalVersion pkg = dataFilesUsingGlobSyntax = filter usesGlobSyntax (dataFiles pkg) extraSrcFilesUsingGlobSyntax = filter usesGlobSyntax (extraSrcFiles pkg) usesGlobSyntax str = case parseFileGlob str of - Just (FileGlob _ _) -> True - _ -> False + Just g -> isRealGlob g + Nothing -> False versionRangeExpressions = [ dep | dep@(Dependency _ vr) <- buildDepends pkg diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs index 4f60b34bfeb..4243050c9fa 100644 --- a/Cabal/Distribution/Simple/Utils.hs +++ b/Cabal/Distribution/Simple/Utils.hs @@ -78,11 +78,12 @@ module Distribution.Simple.Utils ( isInSearchPath, addLibraryPath, - -- * simple file globbing + -- * file globbing matchFileGlob, matchDirFileGlob, parseFileGlob, - FileGlob(..), + Glob(..), + isRealGlob, -- * modification time moreRecentFile, @@ -156,7 +157,7 @@ import System.Exit import System.FilePath ( normalise, (), (<.>) , getSearchPath, joinPath, takeDirectory, splitFileName - , splitExtension, splitExtensions, splitDirectories + , splitExtension, splitDirectories , searchPathSeparator ) import System.Directory ( createDirectory, renameFile, removeDirectoryRecursive ) @@ -199,6 +200,7 @@ import Distribution.Compat.TempFile import Distribution.Compat.Exception ( tryIO, catchIO, catchExit ) import Distribution.Verbosity +import Distribution.Utils.Glob #ifdef VERSION_base import qualified Paths_Cabal (version) @@ -723,43 +725,22 @@ addLibraryPath os paths = addEnv ---------------- -- File globbing -data FileGlob - -- | No glob at all, just an ordinary file - = NoGlob FilePath - - -- | dir prefix and extension, like @\"foo\/bar\/\*.baz\"@ corresponds to - -- @FileGlob \"foo\/bar\" \".baz\"@ - | FileGlob FilePath String - -parseFileGlob :: FilePath -> Maybe FileGlob -parseFileGlob filepath = case splitExtensions filepath of - (filepath', ext) -> case splitFileName filepath' of - (dir, "*") | '*' `elem` dir - || '*' `elem` ext - || null ext -> Nothing - | null dir -> Just (FileGlob "." ext) - | otherwise -> Just (FileGlob dir ext) - _ | '*' `elem` filepath -> Nothing - | otherwise -> Just (NoGlob filepath) - matchFileGlob :: FilePath -> IO [FilePath] matchFileGlob = matchDirFileGlob "." -matchDirFileGlob :: FilePath -> FilePath -> IO [FilePath] -matchDirFileGlob dir filepath = case parseFileGlob filepath of - Nothing -> die $ "invalid file glob '" ++ filepath - ++ "'. Wildcards '*' are only allowed in place of the file" - ++ " name, not in the directory name or file extension." - ++ " If a wildcard is used it must be with an file extension." - Just (NoGlob filepath') -> return [filepath'] - Just (FileGlob dir' ext) -> do - files <- getDirectoryContents (dir dir') - case [ dir' file - | file <- files - , let (name, ext') = splitExtensions file - , not (null name) && ext' == ext ] of - [] -> die $ "filepath wildcard '" ++ filepath - ++ "' does not match any files." +-- | Return a list of files matching a glob pattern, relative to a given source +-- directory. Note that not all the returned files are guaranteed to exist. +matchDirFileGlob :: FilePath -> String -> IO [FilePath] +matchDirFileGlob dir pattern = case parseFileGlob pattern of + Nothing -> + die $ "invalid file glob '" ++ pattern ++ "'." + Just (NoGlob filepath') -> + return [filepath'] + Just (Glob glob) -> do + files <- getDirectoryContentsRecursive dir + case filter (realIsMatch glob) files of + [] -> die $ "glob pattern '" ++ pattern + ++ "' does not match any files." matches -> return matches -------------------- diff --git a/Cabal/Distribution/Utils/Glob.hs b/Cabal/Distribution/Utils/Glob.hs new file mode 100644 index 00000000000..00647140d42 --- /dev/null +++ b/Cabal/Distribution/Utils/Glob.hs @@ -0,0 +1,12 @@ +module Distribution.Utils.Glob + ( Glob(..) + , isRealGlob + , parseFileGlob + , isMatch + , realIsMatch + ) + where + +import Distribution.Utils.Glob.Type +import Distribution.Utils.Glob.Parse +import Distribution.Utils.Glob.Match diff --git a/Cabal/Distribution/Utils/Glob/Match.hs b/Cabal/Distribution/Utils/Glob/Match.hs new file mode 100644 index 00000000000..f2fe23aec74 --- /dev/null +++ b/Cabal/Distribution/Utils/Glob/Match.hs @@ -0,0 +1,103 @@ +module Distribution.Utils.Glob.Match where + +import Control.Monad + ( (>=>) ) +import Data.Maybe + ( listToMaybe ) +import Data.List + ( stripPrefix, tails ) +import Distribution.Utils.Glob.Type + +isMatch :: Glob -> FilePath -> Bool +isMatch (Glob realGlob) fp = realIsMatch realGlob fp +isMatch (NoGlob fp') fp = fp' == fp + +realIsMatch :: RealGlob -> FilePath -> Bool +realIsMatch (RealGlob parts) fp = isMatch' True parts (toSegments fp) + +toSegments :: FilePath -> [String] +toSegments = filter (not . null) . endBy '/' + +-- Not quite the same as the function from Data.List.Split (whose first +-- argument is a sublist, not a single list element). However, we only need to +-- split on individual elements here, and this allows for a simpler +-- implementation. +endBy :: Eq a => a -> [a] -> [[a]] +endBy _ [] = [] +endBy splitter list = + let (next, rest) = span (/= splitter) list + in next : endBy splitter (drop 1 rest) + +-- | Given: +-- * A Bool which records whether we are at the beginning of the current +-- segment +-- * A list of GlobParts +-- * A list of path segments in a file path +-- Return whether the glob parts list matches the file path. +isMatch' :: Bool -> [GlobPart] -> [String] -> Bool +isMatch' _ (Literal l : parts) (seg : segs) = + case stripPrefix l seg of + Just seg' -> isMatch' False parts (seg' : segs) + Nothing -> False +isMatch' _ (PathSeparator : parts) (seg : segs) + | seg == "" = isMatch' True parts segs + | otherwise = False +isMatch' _ (CharList cs : parts) ((h:tl) : segs) = + if charListIsMatch cs h + then isMatch' False parts (tl : segs) + else False +isMatch' _ (CharListComplement cs : parts) ((h:tl) : segs) = + if charListIsMatch cs h + then False + else isMatch' False parts (tl : segs) +isMatch' startSegment (WildOne : parts) ((h:tl) : segs) + | startSegment && h == '.' = False + | otherwise = isMatch' False parts (tl : segs) +isMatch' startSegment (WildMany : parts) segs + | startSegment && (listToMaybe >=> listToMaybe) segs == Just '.' = False + | otherwise = + case segs of + first : rest -> + let candidates = map (:rest) (tails first) + in any (isMatch' False parts) candidates + [] -> + isMatch' startSegment parts segs +isMatch' startSegment (WildManyRecursive : parts) segs + | startSegment && (listToMaybe >=> listToMaybe) segs == Just '.' = False + | otherwise = + anyCandidates || handlePathSep + where + anyCandidates = + any (\(start, segs') -> isMatch' start parts segs') candidates + candidates = iterateWhile (drop1' . snd) (False, segs) + handlePathSep = + case parts of + PathSeparator : parts' -> isMatch' startSegment parts' segs + _ -> False + +isMatch' startSegment (Choice gs : parts) segs = + any (\g -> isMatch' startSegment (g ++ parts) segs) gs +isMatch' _ [] [""] = True +isMatch' _ _ _ = False + +charListIsMatch :: [CharListPart] -> Char -> Bool +charListIsMatch parts c = any (matches c) parts + where + matches x (CharLiteral y) = x == y + matches x (Range start end) = start <= x && x <= end + +-- | Drop one character from a list of path segments, or if the first segment +-- is empty, move on to the next segment. +drop1' :: [String] -> Maybe (Bool, [String]) +drop1' [] = Nothing +drop1' ("" : segs) = Just (True, segs) +drop1' (seg : segs) = Just (False, drop 1 seg : segs) + +-- | Generate a list of values obtained by repeatedly applying a function +-- to an initial value, until it stops returning Just. +iterateWhile :: (a -> Maybe a) -> a -> [a] +iterateWhile f x = x : rest + where + rest = case f x of + Just y -> iterateWhile f y + Nothing -> [] diff --git a/Cabal/Distribution/Utils/Glob/Parse.hs b/Cabal/Distribution/Utils/Glob/Parse.hs new file mode 100644 index 00000000000..2ae8e237abe --- /dev/null +++ b/Cabal/Distribution/Utils/Glob/Parse.hs @@ -0,0 +1,139 @@ +module Distribution.Utils.Glob.Parse where + +import Control.Monad + ( unless, liftM2 ) +import Distribution.Compat.ReadP +import Distribution.Utils.Glob.Type + +-- | We want to ensure this works the same way on all platforms, so we do not +-- use System.FilePath here. +-- +-- Backslashes (like on Windows) may not be used as path separators, because +-- they would significantly complicate the implementation for little benefit. +pathSeparators :: [Char] +pathSeparators = "/" + +charIsPathSeparator :: Char -> Bool +charIsPathSeparator x = x `elem` pathSeparators + +-- | Characters which must not be parsed as literals if not escaped in glob +-- patterns +globSpecialChars :: [Char] +globSpecialChars = pathSeparators ++ "\\{}*[]?!^," + +isSpecialChar :: Char -> Bool +isSpecialChar x = x `elem` globSpecialChars + +-- | Characters which can occur at the start of a bracket pattern to transform +-- it into its complement. +bracketComplementors :: [Char] +bracketComplementors = "^!" + +isBracketComplementor :: Char -> Bool +isBracketComplementor x = x `elem` bracketComplementors + +-- | Characters which must not be parsed as literals if not escaped in bracket +-- patterns. +bracketSpecialChars :: [Char] +bracketSpecialChars = bracketComplementors ++ "-[]\\/" + +isBracketSpecialChar :: Char -> Bool +isBracketSpecialChar x = x `elem` bracketSpecialChars + +-- | Like manyTill, but always consumes at least one occurence of 'p'. +manyTill1 :: ReadP r a -> ReadP [a] end -> ReadP r [a] +manyTill1 p end = liftM2 (:) p (manyTill p end) + +-- | Parse an escape sequence. Anything is allowed, except a path separator. +escapeSequence :: ReadP r Char +escapeSequence = char '\\' >> satisfy (not . charIsPathSeparator) + +parseLiteral :: ReadP r GlobPart +parseLiteral = fmap Literal $ manyTill1 literalSegment literalEnd + where + literalSegment = notSpecial +++ escapeSequence + notSpecial = satisfy (not . isSpecialChar) + literalEnd = do + str <- look + case str of + (x:_) | isSpecialChar x -> return () + "" -> return () + _ -> pfail + +parsePathSeparator :: ReadP r GlobPart +parsePathSeparator = munch1 (== '/') >> return PathSeparator + +parseCharList :: ReadP r GlobPart +parseCharList = + between (char '[') (char ']') + (fmap CharList (many1 parseCharListPart)) + +parseCharListComplement :: ReadP r GlobPart +parseCharListComplement = + between (char '[') (char ']') + (satisfy isBracketComplementor + >> fmap CharListComplement (many1 parseCharListPart)) + +parseCharListPart :: ReadP r CharListPart +parseCharListPart = range <++ fmap CharLiteral literal + where + range = do + start <- literal + _ <- char '-' + end <- literal + unless (start < end) pfail + return (Range start end) + + literal = satisfy (not . isBracketSpecialChar) +++ escapeSequence + +parseWildOne :: ReadP r GlobPart +parseWildOne = char '?' >> return WildOne + +-- | Parses either a WildMany or a WildManyRecursive. +parseWildMany :: ReadP r GlobPart +parseWildMany = do + str <- munch1 (== '*') + case str of + "*" -> return WildMany + "**" -> return WildManyRecursive + _ -> pfail + +parseChoice :: ReadP r GlobPart +parseChoice = + between (char '{') (char '}') $ do + first <- parseGlobParts + _ <- char ',' + rest <- sepBy1 (parseGlobParts <++ emptyGlob) (char ',') + return (Choice (first : rest)) + where + emptyGlob = return [] + +parseGlobPart :: ReadP r GlobPart +parseGlobPart = choice + [ parseLiteral + , parsePathSeparator + , parseCharList + , parseCharListComplement + , parseWildOne + , parseWildMany + , parseChoice + ] + +parseGlobParts :: ReadP r [GlobPart] +parseGlobParts = many1 parseGlobPart + +parseFileGlob :: String -> Maybe Glob +parseFileGlob fp = + case fullyParsed (readP_to_S parseGlobParts fp) of + [parts] -> Just (mkGlob parts) + _ -> Nothing + where + fullyParsed = map fst . filter (null . snd) + mkGlob parts = + case sequence (map asLiteral parts) of + Just literalParts -> NoGlob (concat literalParts) + Nothing -> Glob (RealGlob parts) + + asLiteral (Literal str) = Just str + asLiteral (PathSeparator) = Just "/" + asLiteral _ = Nothing diff --git a/Cabal/Distribution/Utils/Glob/Type.hs b/Cabal/Distribution/Utils/Glob/Type.hs new file mode 100644 index 00000000000..09bd77c00da --- /dev/null +++ b/Cabal/Distribution/Utils/Glob/Type.hs @@ -0,0 +1,122 @@ +module Distribution.Utils.Glob.Type where + +-- | A part of a glob. The aim is to be reasonably close to bash; see +-- http://wiki.bash-hackers.org/syntax/expansion/globs +-- +-- We do not implement the whole bash globbing syntax here; it doesn't seem +-- worth implementing some of the more unusual cases. Notably (although this +-- list is not exhaustive): +-- +-- * the POSIX character class patterns, like [[:alpha:]], +-- * the whole `extglob` extended language. +data GlobPart + = Literal String + -- ^ Match a part of a file with this exact string only. For example: + -- "dictionary.txt" would be parsed as [Literal "dictionary.txt"], and + -- would match "dictionary.txt" and nothing else. + + | PathSeparator + -- ^ A path separator, '/'. Multiple '/'s are condensed down to one. + + | CharList [CharListPart] + -- ^ Match exactly one character from any of the literal characters listed. + -- For example: + -- + -- "[abc]" matches "a", "b", "c", and nothing else. + -- "[a-z]" matches any lower case English letter. + -- "[a-zA-Z]" matches any English letter, either lower or upper case. + -- + -- Special characters inside a CharList are: + -- * exclamation mark ! + -- * hyphen-minus - + -- * caret ^ + -- + -- To match these characters, they must be escaped with a backslash, eg: + -- "[\^\!]" + -- + -- Path separators may not appear in a CharList. + + | CharListComplement [CharListPart] + -- ^ Match exactly one character, as long as it is not in any of the listed + -- literal characters; the complement of a CharList. Written as "[!..]" or + -- "[^..]". Escaping rules are the same as for a CharList. Examples: + -- + -- "[!a]" matches anything except "a". + -- "[^abc]" matches anything except "a", "b", or "c". + + | WildOne + -- ^ Match exactly one character, excluding path separators, and also + -- excluding dots at the beginning of file names. Written "?". Example: + -- + -- "Cab?l" matches "Cabal", "Cabbl", "Cabcl"... + + | WildMany + -- ^ Match zero or more characters of any part of a file name, excluding + -- path separators, and also excluding dots at the beginning of filenames. + -- Written "*". Examples: + -- + -- "jquery.*.js" matches "jquery.1.js", "jquery.2.js", "jquery.3-pre.js"... + -- "*" matches "jquery.js" but not "jquery/index.js" or ".vimrc". + + | WildManyRecursive + -- ^ Recursively matches all files and directories, excluding dots at the + -- beginning of filenames. Written "**". Examples: + -- + -- "**/*Test.hs" matches "GlobTest.hs", "test/HttpTest.hs", + -- "test/examples/ExampleTest.hs"... + + | Choice [[GlobPart]] + -- ^ Match exactly one of the given glob patterns. Written with curly + -- braces, separated by commas. For example: + -- + -- "{a,b,c*}" should be parsed as: + -- [ Choice [ [Literal "a"] + -- , [Literal "b"] + -- , [Literal "c", MatchAny] + -- ] + -- ] + -- + -- that is, "a", "b", or anything starting with "c". + + deriving (Show, Eq) + +isLiteral :: GlobPart -> Bool +isLiteral (Literal _) = True +isLiteral _ = False + +isPathSeparator :: GlobPart -> Bool +isPathSeparator PathSeparator = True +isPathSeparator _ = False + +-- | A part of a bracket pattern, like [abc]. +data CharListPart + = Range Char Char + -- ^ A character range, like "a-z". + + | CharLiteral Char + -- ^ A single character, like "a". + + deriving (Show, Eq) + +-- | A glob pattern that can match any number of files. +-- We purposefully omit an Eq instance because the derived instance would +-- return False in cases where the globs are actually the same, and also +-- because we don't really need one. +-- +-- For example, using the derived Eq instance, we would have: +-- +-- parseGlob "[abc]" /= parseGlob "{a,b,c}" +-- +-- even though these are really the same glob. +newtype RealGlob = RealGlob { runRealGlob :: [GlobPart] } + deriving (Show) + +-- | A Glob which might just be a literal FilePath. +data Glob + = Glob RealGlob + | NoGlob FilePath + deriving (Show) + +isRealGlob :: Glob -> Bool +isRealGlob (Glob _) = True +isRealGlob (NoGlob _) = False diff --git a/Cabal/changelog b/Cabal/changelog index e6d1c5e9f6f..cf5bda17795 100644 --- a/Cabal/changelog +++ b/Cabal/changelog @@ -2,6 +2,7 @@ 1.23.x.x (current development version) * Deal with extra C sources from preprocessors (#238). + * Expand glob syntax to be a subset of that of GNU bash. 1.22.0.0 Johan Tibell January 2015 * Support GHC 7.10. diff --git a/Cabal/doc/developing-packages.markdown b/Cabal/doc/developing-packages.markdown index 12e87059ff0..8f80f7d5544 100644 --- a/Cabal/doc/developing-packages.markdown +++ b/Cabal/doc/developing-packages.markdown @@ -880,27 +880,26 @@ describe the package as a whole: `data-files:` _filename list_ : A list of files to be installed for run-time use by the package. This is useful for packages that use a large amount of static data, - such as tables of values or code templates. Cabal provides a way to + such as tables of values or code templates. Cabal provides a way to [find these files at run-time](#accessing-data-files-from-package-code). - A limited form of `*` wildcards in file names, for example - `data-files: images/*.png` matches all the `.png` files in the - `images` directory. + A reasonably large subset of bash's glob pattern syntax (with the + `globstar` option enabled) is supported. For example: - The limitation is that `*` wildcards are only allowed in place of - the file name, not in the directory name or file extension. In - particular, wildcards do not include directories contents - recursively. Furthermore, if a wildcard is used it must be used with - an extension, so `data-files: data/*` is not allowed. When matching - a wildcard plus extension, a file's full extension must match - exactly, so `*.gz` matches `foo.gz` but not `foo.tar.gz`. A wildcard - that does not match any files is an error. + * `data-files: images/*.png` matches all the `.png` files in the + `images` directory. + * `data-files: test/**/*.js` matches all the `.js` files recursively + in the `test` directory. + * `data-files: test/**/*.{html,js}` matches all the `.js` _and_ + `.html` files recursively in the `test` directory. - The reason for providing only a very limited form of wildcard is to - concisely express the common case of a large number of related files - of the same file type without making it too easy to accidentally - include unwanted files. + The limitation is that the wildcards `*` and `**` are not allowed at + the very end of the pattern. + + The reason for this limitation is to concisely express the common + case of a large number of related files of the same file type without + making it too easy to accidentally include unwanted files. `data-dir:` _directory_ : The directory where Cabal looks for data files to install, relative @@ -910,14 +909,14 @@ describe the package as a whole: `extra-source-files:` _filename list_ : A list of additional files to be included in source distributions built with [`setup sdist`](installing-packages.html#setup-sdist). As - with `data-files` it can use a limited form of `*` wildcards in file - names. + with `data-files` it can use a reasonably large subset of bash's + glob syntax in file names. `extra-doc-files:` _filename list_ : A list of additional files to be included in source distributions, and also copied to the html directory when Haddock documentation is - generated. As with `data-files` it can use a limited form of `*` - wildcards in file names. + generated. As with `data-files` it can use a reasonably large subset + of bash's glob syntax in file names. `extra-tmp-files:` _filename list_ : A list of additional files or directories to be removed by [`setup diff --git a/Cabal/tests/UnitTests.hs b/Cabal/tests/UnitTests.hs index 6f22262b009..cc8aa1c8bb7 100644 --- a/Cabal/tests/UnitTests.hs +++ b/Cabal/tests/UnitTests.hs @@ -8,6 +8,7 @@ import qualified UnitTests.Distribution.Compat.CreatePipe import qualified UnitTests.Distribution.Compat.ReadP import qualified UnitTests.Distribution.Simple.Program.Internal import qualified UnitTests.Distribution.Utils.NubList +import qualified UnitTests.Distribution.Utils.Glob tests :: TestTree tests = testGroup "Unit Tests" $ @@ -19,6 +20,8 @@ tests = testGroup "Unit Tests" $ UnitTests.Distribution.Simple.Program.Internal.tests , testGroup "Distribution.Utils.NubList" UnitTests.Distribution.Utils.NubList.tests + , testGroup "Distribution.Utils.Glob" + UnitTests.Distribution.Utils.Glob.tests ] main :: IO () diff --git a/Cabal/tests/UnitTests/Distribution/Utils/Glob.hs b/Cabal/tests/UnitTests/Distribution/Utils/Glob.hs new file mode 100644 index 00000000000..82006a83c5e --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Utils/Glob.hs @@ -0,0 +1,233 @@ +module UnitTests.Distribution.Utils.Glob + ( tests + ) where + +import Data.Maybe + ( isNothing ) +import Distribution.Utils.Glob +import Test.Tasty +import Test.Tasty.HUnit + +data Result + = DoesMatch + | DoesNotMatch + deriving (Show, Eq, Ord) + +tests :: [TestTree] +tests = + [ testGroup "Unparseable globs" + (map testDoesNotCompile dataDoesNotCompile) + , testGroup "Glob matches" + (map (testMatches DoesMatch) dataDoesMatch) + , testGroup "Glob mismatches" + (map (testMatches DoesNotMatch) dataDoesNotMatch) + ] + where + testDoesNotCompile str = + testCase str + (assertBool "Expected parse to fail" + (isNothing (parseFileGlob str))) + + testMatches r (input, expecteds) = + case parseFileGlob input of + Just glob -> + testGroup input (map (testMatch r) (map (\e -> (glob, e)) expecteds)) + Nothing -> + testCase input (assertFailure "Expected parse to succeed") + + testMatch r (glob, filepath) = + testCase filepath (assertGlob r) + where + matchSuccess = isMatch glob filepath + + assertGlob DoesMatch = + assertBool "Expected glob to match" matchSuccess + assertGlob DoesNotMatch = + assertBool "Expected glob to not match" (not matchSuccess) + +-- TODO: Test with Unicode filenames. + +dataDoesNotCompile :: [String] +dataDoesNotCompile = + [ "{unterminated," + , "[unterminated" + + -- empty choice + , "{}" + + -- bad range + , "[z-a]" + + -- unescaped "!" + , "[abc!]" + + -- unescaped "^" + , "[ads^]" + + -- escaped path separator + , "hello\\/world" + + -- Path separator in CharList + , "[abc/]" + , "[\\]" + , "[abc\\/]" + ] + +dataDoesMatch :: [(String, [String])] +dataDoesMatch = + [ ("dictionary.txt", + [ "dictionary.txt" + ]) + + , ("hello/world.txt", + [ "hello/world.txt" + ]) + + , ("hello/world/a.txt", + [ "hello/world/a.txt" + ]) + + , ("[abc]", + [ "a" + , "b" + , "c" + ]) + + , ("[a-z0-9]", + [ "a" + , "m" + , "y" + , "z" + , "0" + , "5" + ]) + + , ("[a-z][0-9]", + [ "a3" + , "m0" + , "y9" + , "z2" + , "a4" + , "b8" + ]) + + , ("hello[wW]orld", + [ "helloworld" + , "helloWorld" + ]) + + , ("hello[!AaBb]orld", + [ "helloworld" + , "helloWorld" + ]) + + , ("*", + [ "hello" + , "helloworld" + ]) + + , ("**", + [ "hello" + , "helloworld" + , "hello/world" + ]) + + , ("*.hs", + [ "foo.hs" + , "bar.hs" + ]) + + , ("Foo*", + [ "Foo.hs" + , "FooBar.hs" + , "Foo" + ]) + + , ("test/*.hs", + [ "test/Foo.hs" + , "test/Bar.hs" + ]) + + , ("test/Foo.*", + [ "test/Foo." + , "test/Foo.txt" + , "test/Foo.hs" + ]) + + , ("{hello,goodbye}", + [ "hello" + , "goodbye" + ]) + + , ("tests/**/*.hs", + [ "tests/Foo.hs" + , "tests/Foo/Bar.hs" + , "tests/Foo/Bar/Baz.hs" + ]) + + -- Backslash escaping + , ("\\[hello\\]", + [ "[hello]" + ]) + + -- Backslash followed by a non-special character (in terms of globbing) + -- should be ok + , ("he\\ll\\o", + [ "hello" + ]) + + -- choices + , ("{a,b,c}", + [ "a" + , "b" + , "c" + ]) + + , ("hello{world,}", + [ "helloworld" + , "hello" + ]) + ] + +dataDoesNotMatch :: [(String, [String])] +dataDoesNotMatch = + [ ("hello[!Ww]orld", + [ "helloWorld" + , "helloworld" + ]) + + , ("[a-z0-9]", + [ "a3" + , "m0" + , "y9" + , "z2" + , "a4" + , "b8" + ]) + + , ("[a-z][0-9]", + [ "a" + , "m" + , "y" + , "z" + , "0" + , "5" + ]) + + , ("*.hs", + [ ".hs" + , ".Foo.hs" + , ".hso" + , "Foo.hso" + ]) + + , ("**/*.hs", + [ ".hs" + , ".Foo.hs" + , ".hso" + , "Foo.hso" + , "Foo/.Bar.hs" + , "Foo/.hs" + ]) + + ]