Glob 0.3.2 → 0.4

raw patch · 21 files changed

+1237/−433 lines, 21 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.txt +57/−1
• CREDITS.txt +4/−0
• Glob.cabal +4/−3
• LICENSE.txt +5/−1
• System/FilePath/Glob.hs +24/−5
• System/FilePath/Glob/Base.hs +582/−16
• System/FilePath/Glob/Compile.hs +0/−128
• System/FilePath/Glob/Directory.hs +145/−56
• System/FilePath/Glob/Match.hs +78/−35
• System/FilePath/Glob/Optimize.hs +0/−138
• System/FilePath/Glob/Primitive.hs +57/−0
• System/FilePath/Glob/Simplify.hs +42/−0
• tests/Main.hs +8/−2
• tests/Tests/Base.hs +21/−11
• tests/Tests/Compiler.hs +22/−0
• tests/Tests/Instances.hs +59/−0
• tests/Tests/Matcher.hs +24/−10
• tests/Tests/Optimizer.hs +8/−11
• tests/Tests/Regression.hs +63/−10
• tests/Tests/Simplifier.hs +30/−0
• tests/Tests/Utils.hs +4/−6

@@ -1,3 +1,59 @@+0.4, 2009-01-31:+	New functions:+		System.FilePath.Glob.commonDirectory :: Pattern -> (FilePath, Pattern)++		System.FilePath.Glob.simplify  :: Pattern -> Pattern+		System.FilePath.Glob.decompile :: Pattern -> String++		System.FilePath.Glob.tryCompileWith :: CompOptions -> String -> Either String Pattern+		System.FilePath.Glob.compileWith    :: CompOptions -> String -> Pattern+		System.FilePath.Glob.compDefault    :: CompOptions+		System.FilePath.Glob.compPosix      :: CompOptions++		System.FilePath.Glob.matchWith     :: MatchOptions -> Pattern -> FilePath -> Bool+		System.FilePath.Glob.globDirWith   :: MatchOptions -> [Pattern] -> FilePath -> IO ([[FilePath]], [FilePath])+		System.FilePath.Glob.matchDefault  :: MatchOptions+		System.FilePath.Glob.matchPosix    :: MatchOptions++		System.FilePath.Glob.Primitives.literal           :: String -> Pattern+		System.FilePath.Glob.Primitives.singleWildcard    :: Pattern+		System.FilePath.Glob.Primitives.wildcard          :: Pattern+		System.FilePath.Glob.Primitives.recursiveWildcard :: Pattern+		System.FilePath.Glob.Primitives.charRange         :: Bool -> [Either Char (Char,Char)] -> Pattern+		System.FilePath.Glob.Primitives.numberRange       :: Maybe Integer -> Maybe Integer -> Pattern++	Removed functions:+		System.FilePath.Glob.tryCompile (no longer needed / superceded by tryCompileWith)++	New instances:+		Monoid Pattern+		Read Pattern++	Change: ".." can now be matched, by patterns such as ".*".+	Change: globDir, given "" as the directory, uses getCurrentDirectory.+	Change: globDir now keeps track of the number of path separators, thus+	        "a//*" will return "a//b" instead of "a/b" as a match result.+	Change: if character ranges begin with ! or ^, these characters are now+	        considered the start of the range: [^-~] is the range ^ through ~,+	        not the inverse of [-~].++	Regression fix: handle directories without read permissions even more+	                properly.++	Bug fix: globDir doesn't convert patterns like "a./b" to "ab".+	Bug fix: the Show instance used to show "[?]" as the very different "?" (and+	         a few similar cases).+	Bug fix: "//./" wasn't getting optimized properly.+	Bug fix: ".//a" matched "/a" and not "a" or "./a".+	Bug fix: "f**/a" didn't match "foo/a".+	Bug fix: ".**/a" didn't match ".foo/a".+	Bug fix: ".**/a" matched "../a".+	Bug fixes: globDir and match, in general, handled patterns starting with+	           ".*" or ".**/" quite differently.+	Bug fix: globDir never matched "foo/" to the directory "foo".+	Bug fix: globDir never matched "foo**/" to the directory "foo".+	Bug fix: show (compile "[a!b]") resulted in "[!ab]".+ 0.3.2, 2008-12-20: 	Regression fix: handle directories without read permissions properly. @@ -24,5 +80,5 @@ 		System.FilePath.Glob.compile    :: String -> Pattern 		System.FilePath.Glob.match      :: Pattern -> FilePath -> Bool 		System.FilePath.Glob.globDir    :: [Pattern] -> FilePath -> IO ([[FilePath]], [FilePath])-	+ 	Dependencies: base, containers, directory, filepath, mtl.

@@ -0,0 +1,4 @@+In alphabetical order by surname:++Stephen Hicks+Matti   Niemenmaa

@@ -1,7 +1,7 @@ Cabal-Version: >= 1.6  Name:        Glob-Version:     0.3.2+Version:     0.4 Homepage:    http://iki.fi/matti.niemenmaa/glob/ Synopsis:    Globbing library Category:    System@@ -17,6 +17,7 @@ Build-Type: Simple  Extra-Source-Files: CHANGELOG.txt+                    CREDITS.txt                     tests/README.txt                     tests/*.hs                     tests/Tests/*.hs@@ -33,9 +34,9 @@       Build-Depends: Win32 == 2.*     Exposed-Modules: System.FilePath.Glob+                    System.FilePath.Glob.Primitive    Other-Modules:   System.FilePath.Glob.Base-                    System.FilePath.Glob.Compile                     System.FilePath.Glob.Directory                     System.FilePath.Glob.Match-                    System.FilePath.Glob.Optimize+                    System.FilePath.Glob.Simplify                     System.FilePath.Glob.Utils

@@ -1,4 +1,8 @@-Copyright (c) 2008, Matti Niemenmaa
+The code in Glob is released under the license below. Copyrights to parts of
+the code are held by whoever wrote the code in question: see CREDITS.txt for a
+list of authors.
+
+Copyright (c) 2008-2009 <authors>
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without

@@ -10,13 +10,32 @@      Pattern      -- * Functions      -- ** Compilation-   , tryCompile, compile+   , compile, decompile, simplify+     -- *** Options+   , CompOptions(..)+   , compileWith, tryCompileWith+     -- **** Predefined option sets+   , compDefault, compPosix      -- ** Matching    , match    , globDir+     -- *** Options+   , MatchOptions(..)+   , matchWith+   , globDirWith+     -- **** Predefined option sets+   , matchDefault, matchPosix+     -- ** Miscellaneous+   , commonDirectory    ) where -import System.FilePath.Glob.Base      (Pattern)-import System.FilePath.Glob.Compile   (compile, tryCompile)-import System.FilePath.Glob.Directory (globDir)-import System.FilePath.Glob.Match     (match)+import System.FilePath.Glob.Base      ( Pattern+                                      , CompOptions(..), MatchOptions(..)+                                      , compDefault, compPosix+                                      , matchDefault, matchPosix+                                      , compile, compileWith, tryCompileWith+                                      , decompile+                                      )+import System.FilePath.Glob.Directory (globDir, globDirWith, commonDirectory)+import System.FilePath.Glob.Match     (match, matchWith)+import System.FilePath.Glob.Simplify  (simplify)

@@ -1,12 +1,46 @@ -- File created: 2008-10-10 13:29:26 -module System.FilePath.Glob.Base where+{-# LANGUAGE CPP #-} -import Data.Maybe      (fromMaybe)-import System.FilePath (pathSeparator, extSeparator)+module System.FilePath.Glob.Base+   ( Token(..), Pattern(..) --- Todo? data Options = Options { allow_dots :: Bool }+   , CompOptions(..), MatchOptions(..)+   , compDefault, compPosix, matchDefault, matchPosix +   , decompile++   , compile+   , compileWith, tryCompileWith+   , tokenize -- for tests++   , optimize++   , liftP, tokToLower+   ) where++import Control.Arrow               (first)+import Control.Monad.Error         (ErrorT, runErrorT, throwError)+import Control.Monad.Writer.Strict (Writer, runWriter, tell)+import Control.Exception           (assert)+import Data.Char                   (isDigit, isAlpha, toLower)+import Data.List                   (find, sortBy)+import Data.Maybe                  (fromMaybe)+import Data.Monoid                 (Monoid, mappend, mempty, mconcat)+import System.FilePath             ( pathSeparator, extSeparator+                                   , isExtSeparator, isPathSeparator+                                   )++import System.FilePath.Glob.Utils ( dropLeadingZeroes+                                  , isLeft, fromLeft+                                  , increasingSeq+                                  , addToRange, overlap+                                  )++#if __GLASGOW_HASKELL__+import Text.Read (readPrec, lexP, parens, prec, Lexeme(Ident))+#endif+ data Token    -- primitives    = Literal !Char@@ -22,11 +56,32 @@    | LongLiteral !Int String    deriving (Eq) +-- Note: CharRanges aren't converted, because this is tricky in general.+-- Consider for instance [@-[], which includes the range A-Z. This would need+-- to become [@[a-z]: so essentially we'd need to either:+--+--    1) Have a list of ranges of uppercase Unicode. Check if our range+--       overlaps with any of them and if it does, take the non-overlapping+--       part and combine it with the toLower of the overlapping part.+--+--    2) Simply expand the entire range to a list and map toLower over it.+--+-- In either case we'd need to re-optimize the CharRange—we can't assume that+-- if the uppercase characters are consecutive, so are the lowercase.+--+-- 1) might be feasible if someone bothered to get the latest data.+--+-- 2) obviously isn't since you might have 'Right (minBound, maxBound)' in+-- there somewhere.+--+-- The current solution is to just check both the toUpper of the character and+-- the toLower.+tokToLower :: Token -> Token+tokToLower (Literal     c)   = Literal       (toLower c)+tokToLower (LongLiteral n s) = LongLiteral n (map toLower s)+tokToLower tok               = tok+ -- |An abstract data type representing a compiled pattern.--- --- The 'Show' instance is essentially the inverse of @'compile'@. Though it may--- not return exactly what was given to @'compile'@ it will return code which--- produces the same 'Pattern'. -- -- Note that the 'Eq' instance cannot tell you whether two patterns behave in -- the same way; only whether they compile to the same 'Pattern'. For instance,@@ -39,22 +94,533 @@ liftP f (Pattern pat) = Pattern (f pat)  instance Show Token where-   show (Literal c)         = [c]+   show (Literal c)+      | c `elem` "*?[<" || isExtSeparator c+                            = ['[',c,']']+      | otherwise           = assert (not $ isPathSeparator c) [c]    show ExtSeparator        = [ extSeparator]    show PathSeparator       = [pathSeparator]    show NonPathSeparator    = "?"    show AnyNonPathSeparator = "*"    show AnyDirectory        = "**/"-   show (LongLiteral _ s)   = s-   show (CharRange b r)     =-      '[' : (if b then "" else "^") ++-            concatMap (either (:[]) (\(x,y) -> [x,'-',y])) r ++ "]"+   show (LongLiteral _ s)   = concatMap (show . Literal) s    show (OpenRange a b)     =       '<' : fromMaybe "" a ++ "-" ++             fromMaybe "" b ++ ">" -   showList = showList . concatMap show+   -- We have to be careful here with ^ and ! lest [a!b] become [!ab]. So we+   -- just put them at the end.+   --+   -- Also, [^x-] was sorted and should not become [^-x].+   show (CharRange b r)     =+      let f = either (:[]) (\(x,y) -> [x,'-',y])+          (caret,exclamation,fs) =+             foldr (\c (ca,ex,ss) ->+                case c of+                     Left '^' -> ("^",ex,ss)+                     Left '!' -> (ca,"!",ss)+                     _        -> (ca,  ex,(f c ++) . ss)+                   )+                   ("", "", id)+                   r+          (beg,rest) = let s' = fs []+                           (x,y) = splitAt 1 s'+                           in if not b && x == "-"+                                 then (y,x)+                                 else (s',"")+       in concat [ "["+                 , if b then "" else "^"+                 , beg, caret, exclamation, rest+                 , "]"+                 ]  instance Show Pattern where-   showsPrec d (Pattern ts) =-      showParen (d > 10) $ showString "compile " . shows ts+   showsPrec d p = showParen (d > 10) $+      showString "compile " . showsPrec (d+1) (decompile p)++instance Read Pattern where+#if __GLASGOW_HASKELL__+   readPrec = parens . prec 10 $ do+      Ident "compile" <- lexP+      fmap compile readPrec+#else+   readsPrec d = readParen (d > 10) $ \r -> do+      ("compile",string) <- lex r+      (xs,rest) <- readsPrec (d+1) string+      [(compile xs, rest)]+#endif++instance Monoid Pattern where+   mempty                          = Pattern []+   mappend (Pattern a) (Pattern b) = optimize . Pattern $ (a ++ b)+   mconcat                         = optimize . Pattern . concatMap unPattern++-- |Options which can be passed to the 'tryCompileWith' or 'compileWith'+-- functions: with these you can selectively toggle certain features at compile+-- time.+--+-- Note that some of these options depend on each other: classes can never+-- occur if ranges aren't allowed, for instance.++-- We could presumably put locale information in here, too.+data CompOptions = CompOptions+    { characterClasses   :: Bool -- ^Allow character classes, @[[:...:]]@.+    , characterRanges    :: Bool -- ^Allow character ranges, @[...]@.+    , numberRanges       :: Bool -- ^Allow open ranges, @\<...>@.+    , wildcards          :: Bool -- ^Allow wildcards, @*@ and @?@.+    , recursiveWildcards :: Bool -- ^Allow recursive wildcards, @**/@.++    , pathSepInRanges    :: Bool+      -- ^Allow path separators in character ranges.+      --+      -- If true, @a[/]b@ never matches anything (since character ranges can't+      -- match path separators); if false and 'errorRecovery' is enabled,+      -- @a[/]b@ matches itself, i.e. a file named @]b@ in the subdirectory+      -- @a[@.++    , errorRecovery      :: Bool+      -- ^If the input is invalid, recover by turning any invalid part into+      -- literals. For instance, with 'characterRanges' enabled, @[abc@ is an+      -- error by default (unclosed character range); with 'errorRecovery', the+      -- @[@ is turned into a literal match, as though 'characterRanges' were+      -- disabled.+    } deriving (Show,Read,Eq)++-- |The default set of compilation options: closest to the behaviour of the+-- @zsh@ shell, with 'errorRecovery' enabled.+--+-- All options are enabled.+compDefault :: CompOptions+compDefault = CompOptions+   { characterClasses   = True+   , characterRanges    = True+   , numberRanges       = True+   , wildcards          = True+   , recursiveWildcards = True+   , pathSepInRanges    = True+   , errorRecovery      = True+   }++-- |Options for POSIX-compliance, as described in @man 7 glob@.+--+-- 'numberRanges', 'recursiveWildcards', and 'pathSepInRanges' are disabled.+compPosix :: CompOptions+compPosix = CompOptions+   { characterClasses   = True+   , characterRanges    = True+   , numberRanges       = False+   , wildcards          = True+   , recursiveWildcards = False+   , pathSepInRanges    = False+   , errorRecovery      = True+   }++-- |Options which can be passed to the 'matchWith' or 'globDirWith' functions:+-- with these you can selectively toggle certain features at matching time.+data MatchOptions = MatchOptions+    { matchDotsImplicitly :: Bool+      -- ^Allow @*@, @?@, and @**/@ to match @.@ at the beginning of paths.++    , ignoreCase          :: Bool+      -- ^Case-independent matching.++    , ignoreDotSlash      :: Bool+      -- ^Treat @./@ as a no-op in both paths and patterns.+      --+      -- (Of course e.g. @../@ means something different and will not be+      -- ignored.)+    }++-- |The default set of execution options: closest to the behaviour of the @zsh@+-- shell.+--+-- Currently identical to 'matchPosix'.+matchDefault :: MatchOptions+matchDefault = matchPosix++-- |Options for POSIX-compliance, as described in @man 7 glob@.+--+-- 'ignoreDotSlash' is enabled, the rest are disabled.+matchPosix :: MatchOptions+matchPosix = MatchOptions+   { matchDotsImplicitly = False+   , ignoreCase          = False+   , ignoreDotSlash      = True+   }++-- |Decompiles a 'Pattern' object into its textual representation: essentially+-- the inverse of 'compile'.+--+-- Note, however, that due to internal optimization, @decompile . compile@ is+-- not the identity function. Instead, @compile . decompile@ is.+--+-- Be careful with 'CompOptions': 'decompile' always produces a 'String' which+-- can be passed to 'compile' to get back the same 'Pattern'. @compileWith+-- options . decompile@ is /not/ the identity function unless @options@ is+-- 'compDefault'.+decompile :: Pattern -> String+decompile = concatMap show . unPattern++------------------------------------------+-- COMPILATION+------------------------------------------+++-- |Compiles a glob pattern from its textual representation into a 'Pattern'+-- object.+--+-- For the most part, a character matches itself. Recognized operators are as+-- follows:+--+-- [@?@]      Matches any character except path separators.+--+-- [@*@]      Matches any number of characters except path separators,+--            including the empty string.+--+-- [@[..\]@]  Matches any of the enclosed characters. Ranges of characters can+--            be specified by separating the endpoints with a @\'-'@. @\'-'@ or+--            @']'@ can be matched by including them as the first character(s)+--            in the list. Never matches path separators: @[\/]@ matches+--            nothing at all. Named character classes can also be matched:+--            @[:x:]@ within @[]@ specifies the class named @x@, which matches+--            certain predefined characters. See below for a full list.+--+-- [@[^..\]@ or @[!..\]@] Like @[..]@, but matches any character /not/ listed.+--                        Note that @[^-x]@ is not the inverse of @[-x]@, but+--                        the range @[^-x]@.+--+-- [@\<m-n>@] Matches any integer in the range m to n, inclusive. The range may+--            be open-ended by leaving out either number: @\"\<->\"@, for+--            instance, matches any integer.+--+-- [@**/@]    Matches any number of characters, including path separators,+--            excluding the empty string.+--+-- Supported character classes:+--+-- [@[:alnum:\]@]  Equivalent to @\"0-9A-Za-z\"@.+--+-- [@[:alpha:\]@]  Equivalent to @\"A-Za-z\"@.+--+-- [@[:blank:\]@]  Equivalent to @\"\\t \"@.+--+-- [@[:cntrl:\]@]  Equivalent to @\"\\0-\\x1f\\x7f\"@.+--+-- [@[:digit:\]@]  Equivalent to @\"0-9\"@.+--+-- [@[:graph:\]@]  Equivalent to @\"!-~\"@.+--+-- [@[:lower:\]@]  Equivalent to @\"a-z\"@.+--+-- [@[:print:\]@]  Equivalent to @\" -~\"@.+--+-- [@[:punct:\]@]  Equivalent to @\"!-\/:-\@[-`{-~\"@.+--+-- [@[:space:\]@]  Equivalent to @\"\\t-\\r \"@.+--+-- [@[:upper:\]@]  Equivalent to @\"A-Z\"@.+--+-- [@[:xdigit:\]@] Equivalent to @\"0-9A-Fa-f\"@.+--+-- Note that path separators (typically @\'/\'@) have to be matched explicitly+-- or using the @**/@ pattern. In addition, extension separators (typically+-- @\'.\'@) have to be matched explicitly at the beginning of the pattern or+-- after any path separator.+--+-- If a system supports multiple path separators, any one of them will match+-- any of them. For instance, on Windows, @\'/\'@ will match itself as well as+-- @\'\\\'@.+--+-- Error recovery will be performed: erroneous operators will not be considered+-- operators, but matched as literal strings. Such operators include:+--+-- * An empty @[]@ or @[^]@ or @[!]@+--+-- * A @[@ or @\<@ without a matching @]@ or @>@+--+-- * A malformed @\<>@: e.g. nonnumeric characters or no hyphen+--+-- So, e.g. @[]@ will match the string @\"[]\"@.+compile :: String -> Pattern+compile = compileWith compDefault++-- |Like 'compile', but recognizes operators according to the given+-- 'CompOptions' instead of the defaults.+--+-- If an error occurs and 'errorRecovery' is disabled, 'error' will be called.+compileWith :: CompOptions -> String -> Pattern+compileWith opts = either error id . tryCompileWith opts++-- |A safe version of 'compileWith'.+--+-- If an error occurs and 'errorRecovery' is disabled, the error message will+-- be returned in a 'Left'.+tryCompileWith :: CompOptions -> String -> Either String Pattern+tryCompileWith opts = fmap optimize . tokenize opts++tokenize :: CompOptions -> String -> Either String Pattern+tokenize opts = fmap Pattern . sequence . go+ where+   err _ c cs | errorRecovery opts = Right (Literal c) : go cs+   err s _ _                       = [Left s]++   go :: String -> [Either String Token]+   go [] = []+   go ('?':cs) | wcs = Right NonPathSeparator : go cs+   go ('*':cs) | wcs =+      case cs of+           '*':p:xs | rwcs && isPathSeparator p+              -> Right AnyDirectory        : go xs+           _  -> Right AnyNonPathSeparator : go cs++   go ('[':cs) | crs = let (range,rest) = charRange opts cs+                        in case range of+                                Left s -> err s '[' cs+                                r      -> r : go rest++   go ('<':cs) | ors =+      let (range, rest) = break (=='>') cs+       in if null rest+             then err "compile :: unclosed <> in pattern" '<' cs+             else case openRange range of+                       Left s -> err s '<' cs+                       r      -> r : go (tail rest)+   go (c:cs)+      | isPathSeparator c = Right PathSeparator : go cs+      | isExtSeparator  c = Right  ExtSeparator : go cs+      | otherwise         = Right (Literal c)   : go cs++   wcs  = wildcards          opts+   rwcs = recursiveWildcards opts+   crs  = characterRanges    opts+   ors  = numberRanges       opts++-- <a-b> where a > b can never match anything; this is not considered an error+openRange :: String -> Either String Token+openRange ['-']   = Right $ OpenRange Nothing Nothing+openRange ('-':s) =+   case span isDigit s of+        (b,"") -> Right $ OpenRange Nothing (openRangeNum b)+        _      -> Left $ "compile :: bad <>, expected number, got " ++ s+openRange s =+   case span isDigit s of+        (a,"-")    -> Right $ OpenRange (openRangeNum a) Nothing+        (a,'-':s') ->+           case span isDigit s' of+                (b,"") -> Right $ OpenRange (openRangeNum a) (openRangeNum b)+                _ -> Left $ "compile :: bad <>, expected number, got " ++ s'+        _ -> Left $ "compile :: bad <>, expected number followed by - in " ++ s++openRangeNum :: String -> Maybe String+openRangeNum = Just . dropLeadingZeroes++type CharRange = [Either Char (Char,Char)]++charRange :: CompOptions -> String -> (Either String Token, String)+charRange opts zs =+   case zs of+        y:ys | y `elem` "^!" ->+           case ys of+                -- [!-#] is not the inverse of [-#], it is the range ! through+                -- #+                '-':']':xs -> (Right (CharRange False [Left '-']), xs)+                '-'    :_  -> first (fmap (CharRange True )) (start zs)+                xs         -> first (fmap (CharRange False)) (start xs)+        _                  -> first (fmap (CharRange True )) (start zs)+ where+   start :: String -> (Either String CharRange, String)+   start (']':xs) = run $ char ']' xs+   start ('-':xs) = run $ char '-' xs+   start xs       = run $ go xs++   run :: ErrorT String (Writer CharRange) String+       -> (Either String CharRange, String)+   run m = case runWriter.runErrorT $ m of+                (Left   err,  _) -> (Left err, [])+                (Right rest, cs) -> (Right cs, rest)++   go :: String -> ErrorT String (Writer CharRange) String+   go ('[':':':xs) | characterClasses opts = readClass xs+   go (    ']':xs) = return xs+   go (      c:xs) =+      if not (pathSepInRanges opts) && isPathSeparator c+         then throwError "compile :: path separator within []"+         else char c xs+   go []           = throwError "compile :: unclosed [] in pattern"++   char :: Char -> String -> ErrorT String (Writer CharRange) String+   char c ('-':x:xs) =+      if x == ']'+         then tell [Left c, Left '-'] >> return xs+         else tell [Right (c,x)]      >>     go xs++   char c xs = tell [Left c] >> go xs++   readClass :: String -> ErrorT String (Writer CharRange) String+   readClass xs = let (name,end) = span isAlpha xs+                   in case end of+                           ':':']':rest -> charClass name           >> go rest+                           _            -> tell [Left '[',Left ':'] >> go xs++   charClass :: String -> ErrorT String (Writer CharRange) ()+   charClass name =+      -- The POSIX classes+      --+      -- TODO: this is ASCII-only, not sure how this should be extended+      --       Unicode, or with a locale as input, or something else?+      case name of+           "alnum"  -> tell [digit,upper,lower]+           "alpha"  -> tell [upper,lower]+           "blank"  -> tell blanks+           "cntrl"  -> tell [Right ('\0','\x1f'), Left '\x7f']+           "digit"  -> tell [digit]+           "graph"  -> tell [Right ('!','~')]+           "lower"  -> tell [lower]+           "print"  -> tell [Right (' ','~')]+           "punct"  -> tell punct+           "space"  -> tell spaces+           "upper"  -> tell [upper]+           "xdigit" -> tell [digit, Right ('A','F'), Right ('a','f')]+           _        ->+              throwError ("compile :: unknown character class '" ++name++ "'")++   digit  = Right ('0','9')+   upper  = Right ('A','Z')+   lower  = Right ('a','z')+   punct  = map Right [('!','/'), (':','@'), ('[','`'), ('{','~')]+   blanks = [Left '\t',         Left ' ']+   spaces = [Right ('\t','\r'), Left ' ']+++------------------------------------------+-- OPTIMIZATION+------------------------------------------+++optimize :: Pattern -> Pattern+optimize = liftP (fin . go)+ where+   fin [] = []++   -- Literals to LongLiteral+   -- Has to be done here: we can't backtrack in go, but some cases might+   -- result in consecutive Literals being generated.+   -- E.g. "a[b]".+   fin (x:y:xs) | isLiteral x && isLiteral y =+      let (ls,rest) = span isLiteral xs+       in fin $ LongLiteral (length ls + 2)+                            (foldr (\(Literal a) -> (a:)) [] (x:y:ls))+                : rest++   -- concatenate LongLiterals+   -- Has to be done here because LongLiterals are generated above.+   --+   -- So one could say that we have one pass (go) which flattens everything as+   -- much as it can and one pass (fin) which concatenates what it can.+   fin (LongLiteral l1 s1 : LongLiteral l2 s2 : xs) =+      fin $ LongLiteral (l1+l2) (s1++s2) : xs++   fin (LongLiteral l s : Literal c : xs) =+      fin $ LongLiteral (l+1) (s++[c]) : xs++   fin (LongLiteral 1 s : xs) = Literal (head s) : fin xs++   fin (Literal c : LongLiteral l s : xs) =+      fin $ LongLiteral (l+1) (c:s) : xs++   fin (x:xs) = x : fin xs++   go [] = []+   go (x@(CharRange _ _) : xs) =+      case optimizeCharRange x of+           x'@(CharRange _ _) -> x' : go xs+           x'                 -> go (x':xs)++   -- <a-a> -> a+   go (OpenRange (Just a) (Just b):xs)+      | a == b = LongLiteral (length a) a : go xs++   -- <a-b> -> [a-b]+   -- a and b are guaranteed non-null+   go (OpenRange (Just [a]) (Just [b]):xs)+      | b > a = go $ CharRange True [Right (a,b)] : xs++   go (x:xs) =+      case find ($ x) compressors of+           Just c  -> let (compressed,ys) = span c xs+                       in if null compressed+                             then x : go ys+                             else go (x : ys)+           Nothing -> x : go xs++   compressors = [isStar, isStarSlash, isAnyNumber]++   isLiteral   (Literal _)                 = True+   isLiteral   _                           = False+   isStar      AnyNonPathSeparator         = True+   isStar      _                           = False+   isStarSlash AnyDirectory                = True+   isStarSlash _                           = False+   isAnyNumber (OpenRange Nothing Nothing) = True+   isAnyNumber _                           = False++optimizeCharRange :: Token -> Token+optimizeCharRange (CharRange b_ rs) = fin b_ . go . sortCharRange $ rs+ where+   -- [/] is interesting, it actually matches nothing at all+   -- [.] can be Literalized though, just don't make it into an ExtSeparator so+   --     that it doesn't match a leading dot+   fin True [Left  c] | not (isPathSeparator c) = Literal c+   fin True [Right r] | r == (minBound,maxBound) = NonPathSeparator+   fin b x = CharRange b x++   go [] = []++   go (x@(Left c) : xs) =+      case xs of+           [] -> [x]+           y@(Left d) : ys+              -- [aaaaa] -> [a]+              | c == d      -> go$ Left c : ys+              | d == succ c ->+                 let (ls,rest)        = span isLeft xs -- start from y+                     (catable,others) = increasingSeq (map fromLeft ls)+                     range            = (c, head catable)++                  in -- three (or more) Lefts make a Right+                     if null catable || null (tail catable)+                        then x : y : go ys+                        -- [abcd] -> [a-d]+                        else go$ Right range : map Left others ++ rest++              | otherwise -> x : go xs++           Right r : ys ->+              case addToRange r c of+                   -- [da-c] -> [a-d]+                   Just r' -> go$ Right r' : ys+                   Nothing -> x : go xs++   go (x@(Right r) : xs) =+      case xs of+           [] -> [x]+           Left c : ys ->+              case addToRange r c of+                   -- [a-cd] -> [a-d]+                   Just r' -> go$ Right r' : ys+                   Nothing -> x : go xs++           Right r' : ys ->+              case overlap r r' of+                   -- [a-cb-d] -> [a-d]+                   Just o  -> go$ Right o : ys+                   Nothing -> x : go xs+optimizeCharRange _ = error "Glob.optimizeCharRange :: internal error"++sortCharRange :: [Either Char (Char,Char)] -> [Either Char (Char,Char)]+sortCharRange = sortBy cmp+ where+   cmp (Left   a)    (Left   b)    = compare a b+   cmp (Left   a)    (Right (b,_)) = compare a b+   cmp (Right (a,_)) (Left   b)    = compare a b+   cmp (Right (a,_)) (Right (b,_)) = compare a b

@@ -1,128 +0,0 @@--- File created: 2008-10-10 13:29:13--module System.FilePath.Glob.Compile-   ( compile, tryCompile-   , tokenize-   ) where--import Control.Monad.Error ()-import Data.Char           (isDigit)-import System.FilePath     (isPathSeparator, isExtSeparator)--import System.FilePath.Glob.Base-import System.FilePath.Glob.Optimize (optimize)-import System.FilePath.Glob.Utils    (dropLeadingZeroes)---- |Like 'tryCompile', but calls 'error' if an error results.-compile :: String -> Pattern-compile = either error id . tryCompile---- |Compiles a glob pattern from its textual representation into a 'Pattern'--- object, giving an error message in a 'Left' if the pattern is erroneous.------ For the most part, a character matches itself. Recognized operators are as--- follows:------ [@?@]      Matches any character except path separators.--- --- [@*@]      Matches any number of characters except path separators,---            including the empty string.--- --- [@[..\]@]  Matches any of the enclosed characters. Ranges of characters can---            be specified by separating the endpoints with a \'-'. \'-' or ']'---            can be matched by including them as the first character(s) in the---            list.--- --- [@[^..\]@ or @[!..\]@] Like [..], but matches any character /not/ listed.--- --- [@\<m-n>@]  Matches any integer in the range m to n, inclusive. The range may---            be open-ended by leaving out either number: \"\<->\", for---            instance, matches any integer.--- --- [@**/@]    Matches any number of characters, including path separators,---            excluding the empty string.------ Note that path separators (typically @\'/\'@) have to be matched explicitly--- or using the @**/@ pattern. In addition, extension separators (typically--- @\'.\'@) have to be matched explicitly at the beginning of the pattern or--- after any path separator.------ If a system supports multiple path separators, any one of them will match--- any of them. For instance, on Windows, @\'/\'@ will match itself as well as--- @\'\\\'@.------ Erroneous patterns include:------ * An empty @[]@ or @[^]@ or @[!]@------ * A @[@ or @\<@ without a matching @]@ or @>@------ * A malformed @\<>@: e.g. nonnumeric characters or no hyphen-tryCompile :: String -> Either String Pattern-tryCompile = fmap optimize . tokenize--tokenize :: String -> Either String Pattern-tokenize = fmap Pattern . sequence . go- where-   err s = [Left s]--   go :: String -> [Either String Token]-   go [] = []-   go ('?':cs) = Right NonPathSeparator : go cs-   go ('*':cs) =-      case cs of-           '*':p:xs | isPathSeparator p -> Right AnyDirectory        : go xs-           _                            -> Right AnyNonPathSeparator : go cs-   go ('[':cs) =-      let (range, rest) = break (==']') cs-       in if null rest-             then err "compile :: unclosed [] in pattern"-             else if null range-                     then let (range', rest') = break (==']') (tail rest)-                           in if null rest'-                                 then err "compile :: empty [] in pattern"-                                 else charRange (']':range') : go (tail rest')-                     else charRange range : go (tail rest)-   go ('<':cs) =-      let (range, rest) = break (=='>') cs-       in if null rest-             then err "compile :: unclosed <> in pattern"-             else openRange range : go (tail rest)-   go (c:cs)-      | isPathSeparator c = Right PathSeparator : go cs-      | isExtSeparator  c = Right  ExtSeparator : go cs-      | otherwise         = Right (Literal c)   : go cs---- <a-b> where a > b can never match anything; this is not considered an error-openRange :: String -> Either String Token-openRange ['-']   = Right $ OpenRange Nothing Nothing-openRange ('-':s) =-   case span isDigit s of-        (b,"") -> Right $ OpenRange Nothing (openRangeNum b)-        _      -> Left $ "compile :: bad <>, expected number, got " ++ s-openRange s =-   case span isDigit s of-        (a,"-")    -> Right $ OpenRange (openRangeNum a) Nothing-        (a,'-':s') ->-           case span isDigit s' of-                (b,"") -> Right $ OpenRange (openRangeNum a) (openRangeNum b)-                _ -> Left $ "compile :: bad <>, expected number, got " ++ s'-        _ -> Left $ "compile :: bad <>, expected number followed by - in " ++ s--openRangeNum :: String -> Maybe String-openRangeNum = Just . dropLeadingZeroes--charRange :: String -> Either String Token-charRange [x] | x `elem` "^!" = Left ("compile :: empty [" ++ [x]-                                                           ++ "] in pattern")-charRange x =-   if head x `elem` "^!"-      then Right . CharRange False . f $ tail x-      else Right . CharRange True  . f $      x- where-   f (']':s) = Left ']' : go s-   f      s  =            go s--   go [] = []-   go (a:'-':b:cs) = (if a == b then Left a else Right (a,b)) : go cs-   go (c:cs)       = Left c : go cs

@@ -1,55 +1,92 @@ -- File created: 2008-10-16 12:12:50 -module System.FilePath.Glob.Directory (globDir) where+module System.FilePath.Glob.Directory+   ( globDir, globDirWith+   , commonDirectory+   ) where +import Control.Arrow    (first, second) import Control.Monad    (forM) import qualified Data.DList as DL import Data.DList       (DList) import Data.List        ((\\))-import System.Directory (doesDirectoryExist, getDirectoryContents)-import System.FilePath  ((</>))+import System.Directory ( doesDirectoryExist, getDirectoryContents+                        , getCurrentDirectory+                        )+import System.FilePath  ((</>), extSeparator, isExtSeparator, pathSeparator) -import System.FilePath.Glob.Base-import System.FilePath.Glob.Match (match)-import System.FilePath.Glob.Utils-   (getRecursiveContents, nubOrd, pathParts, partitionDL)+import System.FilePath.Glob.Base  ( Pattern(..), Token(..)+                                  , MatchOptions, matchDefault+                                  )+import System.FilePath.Glob.Match (matchWith)+import System.FilePath.Glob.Utils ( getRecursiveContents+                                  , nubOrd+                                  , pathParts+                                  , partitionDL+                                  )  -- The Patterns in TypedPattern don't contain PathSeparator or AnyDirectory+--+-- We store the number of PathSeparators that Dir and AnyDir were followed by+-- so that "foo////*" can match "foo/bar" but return "foo////bar". It's the+-- exact number for convenience: (</>) doesn't add a path separator if one is+-- already there. This way, '\(Dir n _) -> replicate n pathSeparator </> "bar"'+-- results in the correct amount of slashes. data TypedPattern-   = Any Pattern    -- pattern-   | Dir Pattern    -- pattern/-   | AnyDir Pattern -- pattern**/+   = Any Pattern        -- pattern+   | Dir Int Pattern    -- pattern/+   | AnyDir Int Pattern -- pattern**/    deriving Show  -- |Matches each given 'Pattern' against the contents of the given 'FilePath', -- recursively. The result pair\'s first component contains the matched paths, -- grouped for each given 'Pattern', and the second contains all paths which--- were not matched by any 'Pattern'.+-- were not matched by any 'Pattern'. The results are not in any defined order. --+-- The given directory is prepended to all the matches: the returned paths are+-- all valid from the point of view of the current working directory.+-- -- If multiple 'Pattern's match a single 'FilePath', that path will be included -- in multiple groups. --+-- Two 'FilePath's which can be canonicalized to the same file (e.g. @\"foo\"@+-- and @\"./foo\"@) may appear separately if explicit matching on paths+-- beginning with @\".\"@ is done. Looking for @\".*/*\"@, for instance, will+-- cause @\"./foo\"@ to return as a match but @\"foo\"@ to not be matched.+-- -- This function is different from a simple 'filter' over all the contents of -- the directory: the matching is performed relative to the directory, so that -- for instance the following is true: -- -- > fmap (head.fst) (globDir [compile "*"] dir) == getDirectoryContents dir ----- If @dir@ is @\"foo\"@ the pattern should be @\"foo/*\"@ to get the same--- results with a plain 'filter'.+-- (With the exception that that glob won't match anything beginning with @.@.) --+-- If the given 'FilePath' is @[]@, 'getCurrentDirectory' will be used.+--+-- Note that in some cases results outside the given directory may be returned:+-- for instance the @.*@ pattern matches the @..@ directory.+-- -- Any results deeper than in the given directory are enumerated lazily, using -- 'unsafeInterleaveIO'. -- -- Directories without read permissions are returned as entries but their -- contents, of course, are not. globDir :: [Pattern] -> FilePath -> IO ([[FilePath]], [FilePath])-globDir []   dir = do-   c <- getRecursiveContents dir+globDir = globDirWith matchDefault++-- |Like 'globDir', but applies the given 'MatchOptions' instead of the+-- defaults when matching.+globDirWith :: MatchOptions -> [Pattern] -> FilePath+            -> IO ([[FilePath]], [FilePath])+globDirWith _ []   dir = do+   dir' <- if null dir then getCurrentDirectory else return dir+   c <- getRecursiveContents dir'    return ([], DL.toList c)-globDir pats dir = do-   results <- mapM (\p -> globDir' (separate p) dir) pats +globDirWith opts pats dir = do+   results <- mapM (\p -> globDir' opts (separate p) dir) pats+    let (matches, others) = unzip results        allMatches        = DL.toList . DL.concat $ matches        allOthers         = DL.toList . DL.concat $ others@@ -58,69 +95,121 @@           , nubOrd allOthers \\ allMatches           ) -globDir' :: [TypedPattern] -> FilePath -> IO (DList FilePath, DList FilePath)-globDir' []   dir = didn'tMatch dir True-globDir' pats dir = do-   raw <- getDirectoryContents dir--   let entries = raw \\ [".",".."]+globDir' :: MatchOptions -> [TypedPattern] -> FilePath+         -> IO (DList FilePath, DList FilePath)+globDir' opts pats@(_:_) dir = do+   dir' <- if null dir then getCurrentDirectory else return dir+   entries <- getDirectoryContents dir' `catch` const (return []) -   results <- forM entries $ \e -> matchTypedAndGo pats e (dir </> e)+   results <- forM entries $ \e -> matchTypedAndGo opts pats e (dir </> e)     let (matches, others) = unzip results     return (DL.concat matches, DL.concat others) -matchTypedAndGo :: [TypedPattern]+globDir' _ [] dir =+   -- We can only get here from matchTypedAndGo getting a [Dir _]: it means the+   -- original pattern had a trailing PathSeparator. Reproduce it here.+   return (DL.singleton (dir ++ [pathSeparator]), DL.empty)++matchTypedAndGo :: MatchOptions+                -> [TypedPattern]                 -> FilePath -> FilePath                 -> IO (DList FilePath, DList FilePath)  -- (Any p) is always the last element-matchTypedAndGo [Any p] path absPath =-   if match p path+matchTypedAndGo opts [Any p] path absPath =+   if matchWith opts p path       then return (DL.singleton absPath, DL.empty)-      else doesDirectoryExist absPath >>= didn'tMatch absPath+      else doesDirectoryExist absPath >>= didn'tMatch path absPath -matchTypedAndGo (Dir p:ps) path absPath = do+matchTypedAndGo opts (Dir n p:ps) path absPath = do    isDir <- doesDirectoryExist absPath-   if isDir && match p path-      then globDir' ps absPath-      else didn'tMatch absPath isDir+   if isDir && matchWith opts p path+      then globDir' opts ps (absPath ++ replicate n pathSeparator)+      else didn'tMatch path absPath isDir -matchTypedAndGo (AnyDir p:ps) path absPath = do-   isDir <- doesDirectoryExist absPath-   let m = match (unseparate ps)+matchTypedAndGo opts (AnyDir n p:ps) path absPath = do+   if path `elem` [".",".."]+      then didn'tMatch path absPath True+      else do+         isDir <- doesDirectoryExist absPath+         let m = matchWith opts (unseparate ps)+             unconditionalMatch =+                null (unPattern p) && not (isExtSeparator $ head path)+             p' = Pattern (unPattern p ++ [AnyNonPathSeparator]) -   case null (unPattern p) || match p path of-        True | isDir  -> fmap (partitionDL (any m . pathParts))-                              (getRecursiveContents absPath)-        True | m path -> return (DL.singleton absPath, DL.empty)-        _             -> didn'tMatch absPath isDir+         case unconditionalMatch || matchWith opts p' path of+              True | isDir  -> do+                 contents <- getRecursiveContents+                                (absPath ++ replicate n pathSeparator)+                 return $+                    -- foo**/ should match foo/ and nothing below it+                    -- relies on head contents == absPath+                    if null ps+                       then (DL.singleton $ DL.head contents, DL.tail contents)+                       else partitionDL (any m . pathParts) contents -matchTypedAndGo _ _ _ = error "Glob.matchTypedAndGo :: internal error"+              True | m path -> return (DL.singleton absPath, DL.empty)+              _             -> didn'tMatch path absPath isDir -didn'tMatch :: FilePath -> Bool -> IO (DList FilePath, DList FilePath)-didn'tMatch absPath isDir = (fmap $ (,) DL.empty) $+matchTypedAndGo _ _ _ _ = error "Glob.matchTypedAndGo :: internal error"++-- To be called when a pattern didn't match a path: given the path and whether+-- it was a directory, return all paths which didn't match (i.e. for a file,+-- just the file, and for a directory, everything inside it).+didn'tMatch :: FilePath -> FilePath -> Bool+            -> IO (DList FilePath, DList FilePath)+didn'tMatch path absPath isDir = (fmap $ (,) DL.empty) $    if isDir-      then getRecursiveContents absPath+      then if path `elem` [".",".."]+              then return DL.empty+              else getRecursiveContents absPath       else return$ DL.singleton absPath  separate :: Pattern -> [TypedPattern]-separate = go [] . unPattern+separate = go DL.empty . unPattern  where-   go [] []                              = []-   go gr []                              = [Any    $ f gr]-   -- ./foo should not be split into [. , foo], it's just foo-   go gr (ExtSeparator:PathSeparator:ps) = go gr ps-   go gr (             PathSeparator:ps) = (   Dir $ f gr) : go [] ps-   go gr (              AnyDirectory:ps) = (AnyDir $ f gr) : go [] ps-   go gr (                         p:ps) = go (p:gr) ps+   go gr [] | null (DL.toList gr) = []+   go gr []                       = [Any (pat gr)]+   go gr (PathSeparator:ps)       = slash gr Dir ps+   go gr ( AnyDirectory:ps)       = slash gr AnyDir ps+   go gr (            p:ps)       = go (gr `DL.snoc` p) ps -   f = Pattern . reverse+   pat = Pattern . DL.toList +   slash gr f ps = let (n,ps') = first length . span isSlash $ ps+                    in f (n+1) (pat gr) : go DL.empty ps'++   isSlash PathSeparator = True+   isSlash _             = False+ unseparate :: [TypedPattern] -> Pattern unseparate = Pattern . foldr f []  where-   f (AnyDir p) ts = unPattern p ++ AnyDirectory  : ts-   f (   Dir p) ts = unPattern p ++ PathSeparator : ts-   f (Any    p) ts = unPattern p ++ ts+   f (AnyDir n p) ts = u p ++ AnyDirectory  : replicate n PathSeparator ++ ts+   f (   Dir n p) ts = u p ++ PathSeparator : replicate n PathSeparator ++ ts+   f (Any      p) ts = u p ++ ts++   u = unPattern++-- |Factors out the directory component of a 'Pattern'. Useful in conjunction+-- with 'globDir'.+--+-- Preserves the number of path separators: @commonDirectory (compile+-- \"foo\/\/\/bar\")@ becomes @(\"foo\/\/\/\", compile \"bar\")@.+commonDirectory :: Pattern -> (FilePath, Pattern)+commonDirectory = second unseparate . splitP . separate+ where+   splitP pt@(Dir n p:ps) =+      case fromConst DL.empty (unPattern p) of+           Just d  -> first ((d ++ replicate n pathSeparator) </>) (splitP ps)+           Nothing -> ("", pt)++   splitP pt = ("", pt)++   fromConst d []                   = Just (DL.toList d)+   fromConst d (Literal c      :xs) = fromConst (d `DL.snoc` c) xs+   fromConst d (ExtSeparator   :xs) = fromConst (d `DL.snoc` extSeparator) xs+   fromConst d (LongLiteral _ s:xs) = fromConst (d `DL.append`DL.fromList s) xs+   fromConst _ _                    = Nothing

@@ -1,48 +1,91 @@ -- File created: 2008-10-10 13:29:03 -module System.FilePath.Glob.Match (match) where+module System.FilePath.Glob.Match (match, matchWith) where  import Control.Exception (assert)-import Data.Char         (isDigit)+import Data.Char         (isDigit, toLower, toUpper) import Data.Monoid       (mappend) import System.FilePath   (isPathSeparator, isExtSeparator) -import System.FilePath.Glob.Base+import System.FilePath.Glob.Base  ( Pattern(..), Token(..)+                                  , MatchOptions(..), matchDefault+                                  , tokToLower+                                  ) import System.FilePath.Glob.Utils (dropLeadingZeroes, inRange, pathParts)  -- |Matches the given 'Pattern' against the given 'FilePath', returning 'True' -- if the pattern matches and 'False' otherwise. match :: Pattern -> FilePath -> Bool-match = begMatch . unPattern+match = matchWith matchDefault +-- |Like 'match', but applies the given 'MatchOptions' instead of the defaults.+matchWith :: MatchOptions -> Pattern -> FilePath -> Bool+matchWith opts p f = begMatch opts (lcPat $ unPattern p) (lcPath f)+ where+   lcPath = if ignoreCase opts then map    toLower else id+   lcPat  = if ignoreCase opts then map tokToLower else id+ -- begMatch takes care of some things at the beginning of a pattern or after /: --    - . needs to be matched explicitly---    - ./foo is equivalent to foo-begMatch, match' :: [Token] -> FilePath -> Bool-begMatch _ "." = False-begMatch _ ".." = False-begMatch (ExtSeparator:PathSeparator:pat) s                  = begMatch pat s-begMatch pat (x:y:s) | isExtSeparator x && isPathSeparator y = begMatch pat s-begMatch pat s =-   if not (null s) && isExtSeparator (head s)+--    - ./foo is equivalent to foo (for any number of /)+--+-- .*/foo still needs to match ./foo though, and it won't match plain foo;+-- special case that one+--+-- and .**/foo should /not/ match ../foo; more special casing+--+-- (All of the above is modulo options, of course)+begMatch, match' :: MatchOptions -> [Token] -> FilePath -> Bool+begMatch _ (ExtSeparator:AnyDirectory:_) (x:y:_)+   | isExtSeparator x && isExtSeparator y = False++begMatch opts (ExtSeparator:PathSeparator:pat) s | ignoreDotSlash opts =+   begMatch opts (dropWhile isSlash pat) s+ where+   isSlash PathSeparator = True+   isSlash _             = False++begMatch opts pat (x:y:s)+   | dotSlash && dotStarSlash        = match' opts pat' s+   | ignoreDotSlash opts && dotSlash = begMatch opts pat s+ where+   dotSlash = isExtSeparator x && isPathSeparator y+   (dotStarSlash, pat') =+      case pat of+        ExtSeparator:AnyNonPathSeparator:PathSeparator:rest -> (True, rest)+        _                                                   -> (False, pat)++begMatch opts pat s =+   if not (null s) && isExtSeparator (head s) && not (matchDotsImplicitly opts)       then case pat of-                ExtSeparator:pat' -> match' pat' (tail s)+                ExtSeparator:pat' -> match' opts pat' (tail s)                 _                 -> False-      else match' pat s+      else match' opts pat s -match' []                        s  = null s-match' (AnyNonPathSeparator:s)   "" = null s-match' _                         "" = False-match' (Literal l       :xs) (c:cs) =                 l == c  && match'   xs cs-match' ( ExtSeparator   :xs) (c:cs) =       isExtSeparator c  && match'   xs cs-match' (PathSeparator   :xs) (c:cs) =      isPathSeparator c  && begMatch xs cs-match' (NonPathSeparator:xs) (c:cs) = not (isPathSeparator c) && match'   xs cs-match' (CharRange b rng :xs) (c:cs) =-   not (isPathSeparator c) &&-   any (either (== c) (`inRange` c)) rng == b &&-   match' xs cs+match' _ []                        s  = null s+match' _ (AnyNonPathSeparator:s)   "" = null s+match' _ _                         "" = False+match' o (Literal l       :xs) (c:cs) =           l == c  && match' o xs cs+match' o ( ExtSeparator   :xs) (c:cs) = isExtSeparator c  && match' o xs cs+match' o (NonPathSeparator:xs) (c:cs) =+   not (isPathSeparator c) && match' o xs cs -match' (OpenRange lo hi :xs) path =+match' o (PathSeparator   :xs) (c:cs) =+   isPathSeparator c && begMatch o xs (dropWhile isPathSeparator cs)++match' o (CharRange b rng :xs) (c:cs) =+   let rangeMatch r =+          either (== c) (`inRange` c) r ||+             -- See comment near Base.tokToLower for an explanation of why we+             -- do this+             if ignoreCase o+                then either (== toUpper c) (`inRange` toUpper c) r+                else False+    in not (isPathSeparator c) &&+       any rangeMatch rng == b &&+       match' o xs cs++match' o (OpenRange lo hi :xs) path =    let       (lzNum,cs) = span isDigit path       num        = dropLeadingZeroes lzNum@@ -59,24 +102,24 @@             -- We want to try matching x against each of 123, 12, and 1.             -- 12 and 1 are in numChoices already, but we need to add (num,"")             -- manually.-            any (\(n,rest) -> inOpenRange lo hi n && match' xs (rest ++ cs))+            any (\(n,rest) -> inOpenRange lo hi n && match' o xs (rest ++ cs))                 ((num,"") : numChoices) -match' again@(AnyNonPathSeparator:xs) path@(c:cs) =-   match' xs path || (if isPathSeparator c then False else match' again cs)+match' o again@(AnyNonPathSeparator:xs) path@(c:cs) =+   match' o xs path || (if isPathSeparator c then False else match' o again cs) -match' again@(AnyDirectory:xs) path =-   let parts   = pathParts path-       matches = any (match' xs) parts || any (match' again) (tail parts)-    in if null xs+match' o again@(AnyDirectory:xs) path =+   let parts   = pathParts (dropWhile isPathSeparator path)+       matches = any (match' o xs) parts || any (match' o again) (tail parts)+    in if null xs && not (matchDotsImplicitly o)           --  **/ shouldn't match foo/.bar, so check that remaining bits don't           -- start with .           then all (not.isExtSeparator.head) (init parts) && matches           else matches -match' (LongLiteral len s:xs) path =+match' o (LongLiteral len s:xs) path =    let (pre,cs) = splitAt len path-    in pre == s && match' xs cs+    in pre == s && match' o xs cs  -- Does the actual open range matching: finds whether the third parameter -- is between the first two or not.

@@ -1,138 +0,0 @@--- File created: 2008-10-10 13:29:17--module System.FilePath.Glob.Optimize (optimize) where--import Data.List       (find, sortBy)-import System.FilePath (isPathSeparator, isExtSeparator)--import System.FilePath.Glob.Base-import System.FilePath.Glob.Utils-   ( isLeft, fromLeft-   , increasingSeq-   , addToRange, overlap)--optimize :: Pattern -> Pattern-optimize = liftP (fin . go . pre)- where-   -- ./ at beginning -> nothing-   pre (ExtSeparator:PathSeparator:xs) = pre xs-   pre                             xs  = xs--   fin [] = []--   -- Literals to LongLiteral-   -- Has to be done here: we can't backtrack in go, but some cases might-   -- result in consecutive Literals being generated.-   -- E.g. "a[b]".-   fin (x:y:xs) | isLiteral x && isLiteral y =-      let (ls,rest) = span isLiteral xs-       in fin $ LongLiteral (length ls + 2)-                      (foldr (\(Literal a) -> (a:)) [] (x:y:ls))-                : rest--   -- concatenate LongLiterals-   -- Has to be done here because LongLiterals are generated above.-   ---   -- So one could say that we have one pass (go) which flattens everything as-   -- much as it can and one pass (fin) which concatenates what it can.-   fin (LongLiteral l1 s1 : LongLiteral l2 s2 : xs) =-      fin $ LongLiteral (l1+l2) (s1++s2) : xs--   fin (LongLiteral l s : Literal c : xs) =-      fin $ LongLiteral (l+1) (s++[c]) : xs--   fin (x:xs) = x : fin xs--   go [] = []-   go (x@(CharRange _ _) : xs) =-      case optimizeCharRange x of-           x'@(CharRange _ _) -> x' : go xs-           x'                 -> go (x':xs)--   -- /./ -> /-   go (PathSeparator:ExtSeparator:xs@(PathSeparator:_)) = go xs--   -- <a-a> -> a-   go (OpenRange (Just a) (Just b):xs)-      | a == b = LongLiteral (length a) a : go xs--   -- <a-b> -> [a-b]-   -- a and b are guaranteed non-null-   go (OpenRange (Just [a]) (Just [b]):xs)-      | b > a = go $ CharRange True [Right (a,b)] : xs--   go (x:xs) =-      case find ($ x) compressors of-           Just c  -> x : go (dropWhile c xs)-           Nothing -> x : go xs--   compressors = [isStar, isSlash, isStarSlash, isAnyNumber]--   isLiteral   (Literal _)                 = True-   isLiteral   _                           = False-   isStar      AnyNonPathSeparator         = True-   isStar      _                           = False-   isSlash     PathSeparator               = True-   isSlash     _                           = False-   isStarSlash AnyDirectory                = True-   isStarSlash _                           = False-   isAnyNumber (OpenRange Nothing Nothing) = True-   isAnyNumber _                           = False--optimizeCharRange :: Token -> Token-optimizeCharRange (CharRange b_ rs) = fin b_ . go . sortCharRange $ rs- where-   fin True [Left  c] | not (isPathSeparator c || isExtSeparator c) = Literal c-   fin True [Right r] | r == (minBound,maxBound) = NonPathSeparator-   fin b x = CharRange b x--   go [] = []--   go (x@(Left c) : xs) =-      case xs of-           [] -> [x]-           y@(Left d) : ys-              -- [aaaaa] -> [a]-              | c == d      -> go$ Left c : ys-              | d == succ c ->-                 let (ls,rest)        = span isLeft xs -- start from y-                     (catable,others) = increasingSeq (map fromLeft ls)-                     range            = (c, head catable)--                  in -- three (or more) Lefts make a Right-                     if null catable || null (tail catable)-                        then x : y : go ys-                        -- [abcd] -> [a-d]-                        else go$ Right range : map Left others ++ rest--              | otherwise -> x : go xs--           Right r : ys ->-              case addToRange r c of-                   -- [da-c] -> [a-d]-                   Just r' -> go$ Right r' : ys-                   Nothing -> x : go xs--   go (x@(Right r) : xs) =-      case xs of-           [] -> [x]-           Left c : ys ->-              case addToRange r c of-                   -- [a-cd] -> [a-d]-                   Just r' -> go$ Right r' : ys-                   Nothing -> x : go xs--           Right r' : ys ->-              case overlap r r' of-                   -- [a-cb-d] -> [a-d]-                   Just o  -> go$ Right o : ys-                   Nothing -> x : go xs-optimizeCharRange _ = error "Glob.optimizeCharRange :: internal error"--sortCharRange :: [Either Char (Char,Char)] -> [Either Char (Char,Char)]-sortCharRange = sortBy cmp- where-   cmp (Left   a)    (Left   b)    = compare a b-   cmp (Left   a)    (Right (b,_)) = compare a b-   cmp (Right (a,_)) (Left   b)    = compare a b-   cmp (Right (a,_)) (Right (b,_)) = compare a b

@@ -0,0 +1,57 @@+-- File created: 2009-01-17++-- |A number of primitives from which complete 'Pattern's may be constructed.+--+-- Using this together with the functions provided by the 'Monoid' instance of+-- 'Pattern' allows for direct manipulation of 'Pattern's beyond what can be+-- done with just the 'compile' family of functions. And of course you don't+-- have to go via 'String's if you use these.+module System.FilePath.Glob.Primitive+   ( literal+   , singleWildcard, wildcard, recursiveWildcard+   , charRange, numberRange+   ) where++import System.FilePath (isPathSeparator, isExtSeparator)++import System.FilePath.Glob.Base (Pattern(..), Token(..), optimize)++-- |A 'Pattern' which matches the given 'String' literally.+--+-- Handles any embedded path and extension separators.+literal :: String -> Pattern+literal = optimize . Pattern . map f+ where+   f c | isPathSeparator c = PathSeparator+       | isExtSeparator c  = ExtSeparator+       | otherwise         = Literal c++-- |Matches any single character except a path separator: corresponds to the+-- @?@ operator.+singleWildcard :: Pattern+singleWildcard = Pattern [NonPathSeparator]++-- |Matches any number of characters up to a path separator: corresponds to the+-- @*@ operator.+wildcard :: Pattern+wildcard = Pattern [AnyNonPathSeparator]++-- |Matches any number of characters including path separators: corresponds to+-- the @**/@ operator.+recursiveWildcard :: Pattern+recursiveWildcard = Pattern [AnyDirectory]++-- |Matches a single character if it is within the (inclusive) range in any+-- 'Right' or if it is equal to the character in any 'Left'. Corresponds to the+-- @[]@, @[^]@ and @[!]@ operators.+--+-- If the given 'Bool' is 'False', the result of the match is inverted: the+-- match succeeds if the character does /not/ match according to the above+-- rules.+charRange :: Bool -> [Either Char (Char,Char)] -> Pattern+charRange b rs = optimize $ Pattern [CharRange b rs]++-- |Matches a number in the given range, which may be open, half-open, or+-- closed. Corresponds to the @\<\>@ operator.+numberRange :: Maybe Integer -> Maybe Integer -> Pattern+numberRange a b = Pattern [OpenRange (fmap show a) (fmap show b)]

@@ -0,0 +1,42 @@+-- File created: 2009-01-30 14:54:14++module System.FilePath.Glob.Simplify (simplify) where++import System.FilePath.Glob.Base (Pattern(..), Token(..), liftP)++-- |Simplifies a 'Pattern' object: removes redundant @\"./\"@, for instance.+-- The resulting 'Pattern' matches the exact same input as the original one,+-- with some differences:+--+-- * The output of 'globDir' will differ: for example, globbing for @\"./\*\"@+--   gives @\"./foo\"@, but after simplification this'll be only @\"foo\"@.+--+-- * Decompiling the simplified 'Pattern' will obviously not give the original.+--+-- * The simplified 'Pattern' is a bit faster to match with and uses less+--   memory, since some redundant data is removed.+--+-- For the last of the above reasons, if you're performance-conscious and not+-- using 'globDir', you should always 'simplify' after calling 'compile'.+simplify :: Pattern -> Pattern+simplify = liftP (go . pre)+ where+   -- ./ at beginning -> nothing (any number of /'s)+   pre (ExtSeparator:PathSeparator:xs) = pre (dropWhile isSlash xs)+   pre                             xs  = xs++   go [] = []++   -- /./ -> /+   go (PathSeparator:ExtSeparator:xs@(PathSeparator:_)) = go xs++   go (x:xs) =+      if isSlash x+         then let (compressed,ys) = span isSlash xs+               in if null compressed+                     then x : go ys+                     else go (x : ys)+         else x : go xs++   isSlash PathSeparator = True+   isSlash _             = False

@@ -5,9 +5,12 @@ import System.Environment (getArgs) import Test.Framework +import qualified Tests.Compiler   as Compiler+import qualified Tests.Instances  as Instances import qualified Tests.Matcher    as Matcher import qualified Tests.Optimizer  as Optimizer import qualified Tests.Regression as Regression+import qualified Tests.Simplifier as Simplifier import qualified Tests.Utils      as Utils  main = do@@ -18,9 +21,12 @@       , args       ] -tests = concat+tests =    [ Regression.tests+   , Utils.tests+   , Compiler.tests    , Matcher.tests    , Optimizer.tests-   , Utils.tests+   , Simplifier.tests+   , Instances.tests    ]

@@ -1,24 +1,29 @@ -- File created: 2008-10-10 22:03:00 -module Tests.Base (PString(unPS), Path(unP), fromRight, isRight) where+module Tests.Base ( PString(unPS), Path(unP), COpts(unCOpts)+                  , fromRight, isRight+                  ) where +import System.FilePath (extSeparator, pathSeparators) import Test.QuickCheck -import System.FilePath (extSeparator, pathSeparators)+import System.FilePath.Glob.Base (CompOptions(..))  import Utils (fromRight, isRight) -newtype PString = PatString { unPS :: String } deriving Show-newtype Path    = Path      { unP  :: String } deriving Show+newtype PString = PatString { unPS    :: String } deriving Show+newtype Path    = Path      { unP     :: String } deriving Show+newtype COpts   = COpts     { unCOpts :: CompOptions } deriving Show -alpha = extSeparator : pathSeparators ++ "-^!" ++ ['a'..'z'] ++ ['0'..'9']+alpha0 = extSeparator : "-^!" ++ ['a'..'z'] ++ ['0'..'9']+alpha  = pathSeparators ++ alpha0  instance Arbitrary PString where    arbitrary = sized $ \size -> do       let xs =              (1, return "**/") :              map (\(a,b) -> (a*100,b))-             [ (40, plain)+             [ (40, plain alpha)              , (20, return "?")              , (20, charRange)              , (10, return "*")@@ -30,18 +35,23 @@  instance Arbitrary Path where    arbitrary = sized $ \size -> do-      s <- mapM (const plain) [1..size `mod` 16]+      s <- mapM (const $ plain alpha) [1..size `mod` 16]       return.Path $ concat s -plain = sized $ \size -> do-   s <- mapM (const $ elements alpha) [0..size `mod` 3]+instance Arbitrary COpts where+   arbitrary = do+      [a,b,c,d,e,f] <- vector 6+      return.COpts $ CompOptions a b c d e f False++plain from = sized $ \size -> do+   s <- mapM (const $ elements from) [0..size `mod` 3]    return s  charRange = do-   s <- plain+   s <- plain alpha0    if s `elem` ["^","!"]       then do-         s' <- plain+         s' <- plain alpha0          return$ "[" ++ s ++ s' ++ "]"       else          return$ "[" ++ s ++       "]"

@@ -0,0 +1,22 @@+-- File created: 2009-01-30 13:26:51++module Tests.Compiler (tests) where++import Test.Framework+import Test.Framework.Providers.QuickCheck++import System.FilePath.Glob.Base (tryCompileWith, compile, decompile)++import Tests.Base++tests = testGroup "Compiler"+   [ testProperty "compile-decompile-1" prop_compileDecompile1+   ]++-- compile . decompile should be the identity function+prop_compileDecompile1 o s =+   let opt   = unCOpts o+       epat1 = tryCompileWith opt (unPS s)+       pat1  = fromRight epat1+       pat2  = compile . decompile $ pat1+    in isRight epat1 && pat1 == pat2

@@ -0,0 +1,59 @@+-- File created: 2009-01-30 15:01:02++module Tests.Instances (tests) where++import Data.Monoid (mempty, mappend)+import Test.Framework+import Test.Framework.Providers.QuickCheck+import Test.QuickCheck ((==>))++import System.FilePath.Glob.Base (tryCompileWith)+import System.FilePath.Glob.Match+import System.FilePath.Glob.Simplify++import Tests.Base++tests = testGroup "Instances"+   [ testProperty "monoid-law-1" prop_monoidLaw1+   , testProperty "monoid-law-2" prop_monoidLaw2+   , testProperty "monoid-law-3" prop_monoidLaw3+   , testProperty "monoid-4"     prop_monoid4+   ]++-- The monoid laws: associativity...+prop_monoidLaw1 opt x y z =+   let o       = unCOpts opt+       es      = map (tryCompileWith o . unPS) [x,y,z]+       [a,b,c] = map fromRight es+    in all isRight es && mappend a (mappend b c) == mappend (mappend a b) c++-- ... left identity ...+prop_monoidLaw2 opt x =+   let o = unCOpts opt+       e = tryCompileWith o (unPS x)+       a = fromRight e+    in isRight e && mappend mempty a == a++-- ... and right identity.+prop_monoidLaw3 opt x =+   let o = unCOpts opt+       e = tryCompileWith o (unPS x)+       a = fromRight e+    in isRight e && mappend a mempty == a++-- mappending two Patterns should be equivalent to appending the original+-- strings they came from and compiling that+--+-- (notice: relies on the fact that our Arbitrary instance doesn't generate+-- unclosed [] or <>; we only check for **/)+prop_monoid4 opt x y =+   let o     = unCOpts opt+       es    = map (tryCompileWith o . unPS) [x,y]+       [a,b] = map fromRight es+       cat1  = mappend a b+       cat2  = tryCompileWith o (unPS x ++ unPS y)+       last2 = take 2 . reverse . unPS $ x+       head2 = take 2 . unPS $ y+    in     (last2 /= "**" && take 1 head2 /= "/")+        && (take 1 last2 /= "*" && take 2 head2 /= "*/")+       ==> all isRight es && isRight cat2 && cat1 == fromRight cat2

@@ -5,22 +5,26 @@ import Control.Monad (ap) import Test.Framework import Test.Framework.Providers.QuickCheck+import Test.QuickCheck ((==>)) -import System.FilePath.Glob.Compile+import System.FilePath (isExtSeparator, isPathSeparator)+import System.FilePath.Glob.Base import System.FilePath.Glob.Match  import Tests.Base -tests =-   [ testGroup "Matcher"-       [ testProperty "match-1" prop_match1-       ]+tests = testGroup "Matcher"+   [ testProperty "match-1" prop_match1+   , testProperty "match-2" prop_match2+   , testProperty "match-3" prop_match3    ]  -- ./foo should be equivalent to foo in both path and pattern-prop_match1 p s =-   let ep   = tryCompile (unPS p)-       ep'  = tryCompile ("./" ++ unPS p)+-- ... but not for the pattern if it starts with /+prop_match1 o p_ s =+   let p    = dropWhile isPathSeparator (unPS p_)+       ep   = tryCompileWith (unCOpts o) p+       ep'  = tryCompileWith (unCOpts o) ("./" ++ p)        pat  = fromRight ep        pat' = fromRight ep'        pth  = unP s@@ -28,9 +32,19 @@     in and [ isRight ep, isRight ep'            , ( all (uncurry (==)) . (zip`ap`tail) $                   [ match pat  pth-                  , match pat  pth' +                  , match pat  pth'                   , match pat' pth                   , match pat' pth'                   ]-             ) || null (unPS p)+             ) || null p            ]++-- [/] shouldn't match anything+prop_match2 = not . match (compile "[/]")  . take 1 . unP++-- [!/] is like ?+prop_match3 p_ =+   let p = unP p_+       ~(x:_) = p+    in not (null p || isPathSeparator x || isExtSeparator x)+       ==> match (compile "[!/]") [x]

@@ -5,28 +5,25 @@ import Test.Framework import Test.Framework.Providers.QuickCheck -import System.FilePath.Glob.Compile-import System.FilePath.Glob.Optimize+import System.FilePath.Glob.Base  (tokenize, optimize) import System.FilePath.Glob.Match  import Tests.Base -tests =-   [ testGroup "Optimizer"-       [ testProperty "optimize-1" prop_optimize1-       , testProperty "optimize-2" prop_optimize2-       ]+tests = testGroup "Optimizer"+   [ testProperty "optimize-1" prop_optimize1+   , testProperty "optimize-2" prop_optimize2    ]  -- Optimizing twice should give the same result as optimizing once-prop_optimize1 s =-   let pat = tokenize (unPS s)+prop_optimize1 o s =+   let pat = tokenize (unCOpts o) (unPS s)        xs = iterate optimize (fromRight pat)     in isRight pat && xs !! 1 == xs !! 2  -- Optimizing shouldn't affect whether a match succeeds-prop_optimize2 p s =-   let x   = tokenize (unPS p)+prop_optimize2 o p s =+   let x   = tokenize (unCOpts o) (unPS p)        pat = fromRight x        pth = unP s     in isRight x && match pat pth == match (optimize pat) pth

@@ -6,20 +6,38 @@ import Test.Framework.Providers.HUnit import Test.HUnit.Base -import System.FilePath.Glob.Compile+import System.FilePath.Glob.Base import System.FilePath.Glob.Match -tests =-   [ testGroup "Regression" $-        flip map testCases $ \t@(b,p,s) ->-            testCase (nameTest t) . assertBool "failed" $+tests = testGroup "Regression"+   [ testGroup "Matching/compiling" .+        flip map matchCases $ \t@(b,p,s) ->+            tc (nameMatchTest t) $                match (compile p) s == b+   , testGroup "Specific options" .+        flip map matchWithCases $ \t@(b,co,mo,p,s) ->+           tc (nameMatchTest (b,p,s)) $+              matchWith mo (compileWith co p) s == b+   , testGroup "Decompilation" .+        flip map decompileCases $ \(n,orig,s) ->+           tc n $ decompile (compile orig) == s    ]+ where+   tc n = testCase n . assert -nameTest (True ,p,s) = show p ++ " matches " ++ show s-nameTest (False,p,s) = show p ++ " doesn't match " ++ show s+nameMatchTest (True ,p,s) = show p ++ " matches " ++ show s+nameMatchTest (False,p,s) = show p ++ " doesn't match " ++ show s -testCases =+decompileCases =+   [ ("range-compression-1", "[*]",   "[*]")+   , ("range-compression-2", "[.]",   "[.]")+   , ("range-compression-3", "**[/]", "*[/]")+   , ("range-compression-4", "x[.]",  "x[.]")+   , ("range-compression-5", "[^~-]", "[^~-]")+   , ("range-compression-6", "[^!-]", "[^!-]")+   ]++matchCases =    [ (True , "*"          , "")    , (True , "**"         , "")    , (True , "asdf"       , "asdf")@@ -69,11 +87,46 @@    , (False, "[b-a]"      , "a")    , (False, "<4-3>"      , "3")    , (True , "[]-b]"      , "]")-   , (True , "[]-b]"      , "-")+   , (False, "[]-b]"      , "-")    , (True , "[]-b]"      , "b")-   , (False, "[]-b]"      , "a")+   , (True , "[]-b]"      , "a")+   , (True , "[]-]"       , "]")+   , (True , "[]-]"       , "-")+   , (True , "[#-[]"      , "&")    , (False, "[^x]"       , "/")    , (False, "[/]"        , "/")    , (True , "a[^x]"      , "a.")    , (True , "a[.]"       , "a.")+   , (False, ".//a"       , "/a")+   , (True,  ".//a"       , "a")+   , (True,  ".//a"       , "./a")+   , (True , ".*/a"       , "./a")+   , (True , ".*/a"       , "../a")+   , (True , ".*/a"       , ".foo/a")+   , (True , ".**/a"      , ".foo/a")+   , (False, ".**/a"      , "../a")+   , (False, ".**/a"      , "./a")+   , (False, ".**/a"      , "a")+   , (True , ".**/a"      , ".foo/a")+   , (True , "f**/a"      , "foo/a")+   , (True , "f**/"       , "f/")+   , (True , "f**/"       , "f///")+   , (True , "f**/x"      , "f///x")+   , (True , "f/"         , "f///")+   , (True , "f/x"        , "f///x")+   , (True , "[]"         , "[]")+   , (True , "[!]"        , "[!]")+   , (True , "[^]"        , "[^]")+   , (True , "[abc"       , "[abc")+   , (True , "<abc"       , "<abc")+   , (True , "<1-"        , "<1-")+   , (True , "[^-~]"      , "x")+   , (False, "[^-~]"      , "X")+   , (False, "[^^-~]"     , "x")+   , (False, "[^-]"       , "-")+   ]++matchWithCases =+   [ (True , compDefault, matchDefault { ignoreCase = True }, "[@-[]", "a")+   , (True , compPosix  , matchDefault                      , "a[/]b", "a[/]b")    ]

@@ -0,0 +1,30 @@+-- File created: 2009-01-24 13:02:48++module Tests.Simplifier (tests) where++import Test.Framework+import Test.Framework.Providers.QuickCheck++import System.FilePath.Glob.Base (tryCompileWith)+import System.FilePath.Glob.Match+import System.FilePath.Glob.Simplify++import Tests.Base++tests = testGroup "Simplifier"+   [ testProperty "simplify-1" prop_simplify1+   , testProperty "simplify-2" prop_simplify2+   ]++-- Simplifying twice should give the same result as simplifying once+prop_simplify1 o s =+   let pat = tryCompileWith (unCOpts o) (unPS s)+       xs = iterate simplify (fromRight pat)+    in isRight pat && xs !! 1 == xs !! 2++-- Simplifying shouldn't affect whether a match succeeds+prop_simplify2 p o s =+   let x   = tryCompileWith (unCOpts o) (unPS p)+       pat = fromRight x+       pth = unP s+    in isRight x && match pat pth == match (simplify pat) pth

@@ -11,12 +11,10 @@  import Utils -tests =-   [ testGroup "Utils"-      [ testProperty "overlapperLosesNoInfo" prop_overlapperLosesNoInfo-      , testProperty "increasingSeq"         prop_increasingSeq-      , testProperty "addToRange"            prop_addToRange-      ]+tests = testGroup "Utils"+   [ testProperty "overlapperLosesNoInfo" prop_overlapperLosesNoInfo+   , testProperty "increasingSeq"         prop_increasingSeq+   , testProperty "addToRange"            prop_addToRange    ]  validateRange (a,b) = if b > a then (a,b) else (b,a)