packages feed

filepattern (empty) → 0.1

raw patch · 16 files changed

+1191/−0 lines, 16 filesdep +QuickCheckdep +basedep +directorysetup-changed

Dependencies added: QuickCheck, base, directory, extra, filepath, filepattern, semigroups

Files

+ CHANGES.txt view
@@ -0,0 +1,6 @@+Changelog for filepattern++0.1, released 2019-02-12+    Substantial (almost total) rewrite+    Remove // patterns+    Split from shake-0.16
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Neil Mitchell 2011-2019.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Neil Mitchell nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,9 @@+# FilePattern [![Hackage version](https://img.shields.io/hackage/v/filepattern.svg?label=Hackage)](https://hackage.haskell.org/package/filepattern) [![Stackage version](https://www.stackage.org/package/filepattern/badge/nightly?label=Stackage)](https://www.stackage.org/package/filepattern) [![Linux Build Status](https://img.shields.io/travis/ndmitchell/filepattern/master.svg?label=Linux%20build)](https://travis-ci.org/ndmitchell/filepattern) [![Windows Build Status](https://img.shields.io/appveyor/ci/ndmitchell/filepattern/master.svg?label=Windows%20build)](https://ci.appveyor.com/project/ndmitchell/filepattern)++A file path matching library, loosely modelled on the semantics from:++* [VS Code](https://code.visualstudio.com/docs/editor/codebasics#_advanced-search-options).+* [Git](https://git-scm.com/docs/gitignore).+* [Glob](https://www.npmjs.com/package/glob).++Originally part of [Shake](http://shakebuild.com/), now split off as a separate project.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ filepattern.cabal view
@@ -0,0 +1,75 @@+cabal-version:      >= 1.18+build-type:         Simple+name:               filepattern+version:            0.1+license:            BSD3+license-file:       LICENSE+category:           Development, FilePath+author:             Neil Mitchell <ndmitchell@gmail.com>, Evan Rutledge Borden <evan@evan-borden.com>+maintainer:         Neil Mitchell <ndmitchell@gmail.com>+copyright:          Neil Mitchell 2011-2019+synopsis:           File path glob-like matching+description:+    A library for matching files using patterns such as @\"src\/**\/*.png\"@ for all @.png@ files+    recursively under the @src@ directory. Features:+    .+    * All matching is /O(n)/.+    .+    * See "System.FilePattern" and 'System.FilePattern.?==' simple matching and semantics.+    .+    * Use 'System.FilePattern.match' and 'System.FilePattern.substitute' to extract suitable+    strings from the @*@ and @**@ matches, and substitute them back into other patterns.+    .+    * Use 'System.FilePattern.step' and 'System.FilePattern.matchMany' to perform bulk matching+    of many patterns against many paths simultaneously.+    .+    * Use "System.FilePattern.Directory" to perform optimised directory traverals using patterns.+    .+    Originally taken from the <https://hackage.haskell.org/package/shake Shake library>.+bug-reports:        https://github.com/eborden/filepattern/issues+tested-with:        GHC==8.6.3, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+extra-doc-files:+    CHANGES.txt+    README.md++source-repository head+    type:     git+    location: https://github.com/eborden/filepattern.git++library+    default-language: Haskell2010+    hs-source-dirs: src+    build-depends:+        base == 4.*,+        directory,+        extra >= 1.6.2,+        filepath+    if impl(ghc < 8.0)+        build-depends: semigroups >= 0.18+    exposed-modules:+        System.FilePattern+        System.FilePattern.Directory+    other-modules:+        System.FilePattern.Core+        System.FilePattern.ListBy+        System.FilePattern.Monads+        System.FilePattern.Step+        System.FilePattern.Tree+        System.FilePattern.Wildcard+++test-suite filepattern-test+    default-language: Haskell2010+    type: exitcode-stdio-1.0+    main-is: Test.hs+    hs-source-dirs: test+    build-depends:+        base == 4.*,+        directory,+        extra,+        filepattern,+        filepath,+        QuickCheck >= 2.0+    other-modules:+        Test.Cases+        Test.Util
+ src/System/FilePattern.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE ConstraintKinds, RecordWildCards, ScopedTypeVariables #-}++-- | A module for matching files using patterns such as @\"src\/**\/*.png\"@ for all @.png@ files+--  recursively under the @src@ directory. See 'System.FilePattern.?==' for the semantics of+--  'System.FilePattern.FilePattern' values. Features:+--+--  * All matching is /O(n)/.+--+--  * Use 'System.FilePattern.match' and 'System.FilePattern.substitute' to extract suitable+--  strings from the @*@ and @**@ matches, and substitute them back into other patterns.+--+--  * Use 'System.FilePattern.step' and 'System.FilePattern.matchMany' to perform bulk matching+--  of many patterns against many paths simultaneously.+--+--  * Use "System.FilePattern.Directory" to perform optimised directory traverals using patterns.+module System.FilePattern(+    FilePattern, (?==), match, substitute, arity,+    -- * Multiple patterns and paths+    step, step_, Step(..), StepNext(..), matchMany+    ) where++import Control.Exception.Extra+import Data.Maybe+import Data.Tuple.Extra+import Data.List.Extra+import System.FilePattern.Tree+import System.FilePattern.Core(FilePattern, parsePattern, parsePath, renderPath)+import qualified System.FilePattern.Core as Core+import System.FilePattern.Step+import Prelude+++---------------------------------------------------------------------+-- PATTERNS++-- | Match a 'FilePattern' against a 'FilePath'. There are two special forms:+--+-- * @*@ matches part of a path component, excluding any separators.+--+-- * @**@ as a path component matches an arbitrary number of path components.+--+--   Some examples:+--+-- * @test.c@ matches @test.c@ and nothing else.+--+-- * @*.c@ matches all @.c@ files in the current directory, so @file.c@ matches,+--   but @file.h@ and @dir\/file.c@ don't.+--+-- * @**/*.c@ matches all @.c@ files anywhere on the filesystem,+--   so @file.c@, @dir\/file.c@, @dir1\/dir2\/file.c@ and @\/path\/to\/file.c@ all match,+--   but @file.h@ and @dir\/file.h@ don't.+--+-- * @dir\/*\/*@ matches all files one level below @dir@, so @dir\/one\/file.c@ and+--   @dir\/two\/file.h@ match, but @file.c@, @one\/dir\/file.c@, @dir\/file.h@+--   and @dir\/one\/two\/file.c@ don't.+--+--   Patterns with constructs such as @foo\/..\/bar@ will never match+--   normalised 'FilePath' values, so are unlikely to be correct.+(?==) :: FilePattern -> FilePath -> Bool+(?==) w = isJust . match w+++-- | Like '?==', but returns 'Nothing' on if there is no match, otherwise 'Just' with the list+--   of fragments matching each wildcard. For example:+--+-- @+-- isJust ('match' p x) == (p '?==' x)+-- 'match' \"**\/*.c\" \"test.txt\" == Nothing+-- 'match' \"**\/*.c\" \"foo.c\" == Just [\"",\"foo\"]+-- 'match' \"**\/*.c\" \"bar\/baz\/foo.c\" == Just [\"bar\/baz/\",\"foo\"]+-- @+--+--   On Windows any @\\@ path separators will be replaced by @\/@.+match :: FilePattern -> FilePath -> Maybe [String]+match w = Core.match (parsePattern w) . parsePath+++---------------------------------------------------------------------+-- MULTIPATTERN COMPATIBLE SUBSTITUTIONS++-- | How many @*@ and @**@ elements are there.+--+-- @+-- 'arity' \"test.c\" == 0+-- 'arity' \"**\/*.c\" == 2+-- @+arity :: FilePattern -> Int+arity = Core.arity . parsePattern+++-- | Given a successful 'match', substitute it back in to a pattern with the same 'arity'.+--   Raises an error if the number of parts does not match the arity of the pattern.+--+-- @+-- p '?==' x ==> 'substitute' (fromJust $ 'match' p x) p == x+-- 'substitute' \"**\/*.c\" [\"dir\",\"file\"] == \"dir/file.c\"+-- @+substitute :: Partial => FilePattern -> [String] -> FilePath+substitute w xs = maybe (error msg) renderPath $ Core.substitute (parsePattern w) xs+    where+        msg = "Failed substitute, patterns of different arity. Pattern " ++ show w +++              " expects " ++ show (arity w) ++ " elements, but got " ++ show (length xs) +++              " namely " ++ show xs ++ "."+++-- | Efficiently match many 'FilePattern's against many 'FilePath's in a single operation.+--   Note that the returned matches are not guaranteed to be in any particular order.+--+-- > matchMany [(a, pat)] [(b, path)] == maybeToList (map (a,b,) (match pat path))+matchMany :: [(a, FilePattern)] -> [(b, FilePath)] -> [(a, b, [String])]+matchMany pats = f (step pats) . makeTree . map (second $ (\(Core.Path x) -> x) . parsePath)+    where+        f Step{..} (Tree bs xs) = concat $+            [(a, b, ps) | (a, ps) <- stepDone, b <- bs] :+            [f (stepApply x) t | (x, t) <- xs, case stepNext of StepOnly xs -> x `elem` xs; _ -> True]
+ src/System/FilePattern/Core.hs view
@@ -0,0 +1,128 @@++-- | The type of patterns and wildcards, and operations working on parsed versions.+module System.FilePattern.Core(+    FilePattern,+    Pattern(..), parsePattern,+    Path(..), parsePath, renderPath,+    mkParts,+    match, substitute,+    arity+    ) where++import Data.Functor+import Control.Applicative+import System.FilePattern.Wildcard+import System.FilePath (isPathSeparator)+import Data.Either.Extra+import Data.Traversable+import qualified Data.Foldable as F+import System.FilePattern.Monads+import Data.List.Extra+import Prelude+++-- | A type synonym for file patterns, containing @**@ and @*@. For the syntax+--   and semantics of 'FilePattern' see 'System.FilePattern.?=='.+--+--   Most 'FilePath' values lacking literal @.@ and @..@ components are suitable as 'FilePattern' values which match+--   only that specific file. On Windows @\\@ is treated as equivalent to @\/@.+--+--   You can write 'FilePattern' values as a literal string, or build them+--   up using the operators '<.>' and '</>' (but be aware that @\"\" '</>' \"foo\"@ produces @\"./foo\"@).+type FilePattern = String+++newtype Path = Path [String]+    deriving (Show,Eq,Ord)++newtype Pattern = Pattern (Wildcard [Wildcard String])+    deriving (Show,Eq,Ord)+++-- [Note: Split on ""]+--+-- For parsing patterns and paths, "" can either be [] or [""].+-- Assuming they are consistent, the only cases that are relevant are:+--+-- > match "" "" = Just []+-- > match "*" "" = if [] then Nothing else Just [""]+-- > match "**" "" = if [] then Just [] else Just [""]+--+-- We pick "" splits as [""] because that is slightly more permissive,+-- follows the builtin semantics of split, and matches the 'filepath'+-- library slightly better.++parsePath :: FilePath -> Path+parsePath = Path . split isPathSeparator++renderPath :: Path -> FilePattern+renderPath (Path x) = intercalate "/" x++parsePattern :: FilePattern -> Pattern+parsePattern = Pattern . fmap (map $ f '*') . f "**" . split isPathSeparator+    where+        f :: Eq a => a -> [a] -> Wildcard [a]+        f x xs = case split (== x) xs of+            pre:mid_post -> case unsnoc mid_post of+                Nothing -> Literal pre+                Just (mid, post) -> Wildcard pre mid post+++-- [Note: Conversion of parts to String]+--+-- The match of * is String, but the match for ** is really [String].+-- To simplify the API, since everything else is String encoding [String],+-- we want to convert that [String] to String. We considered 3 solutions.+--+-- 1) Since we know the elements of [String] don't contain /, a natural+-- solution is to insert / characters between items with intercalate, but that+-- doesn't work because [] and [""] end up with the same representation, but+-- are very different, e.g.+--+-- > match "**/a" "a"  = Just []+-- > match "**/a" "/a" = Just [""]+--+-- 2) We can join with "/" after every component, so ["a","b"] becomes+-- "a/b/". But that causes / characters to appear from nowhere, e.g.+--+-- > match "**" "a" = Just ["a/"]+--+-- 3) Logically, the only sensible encoding for [] must be "". Because [""]+-- can't be "" (would clash), it must be "/". Therefore we follow solution 2 normally,+-- but switch to solution 1 iff all the components are empty.+-- We implement this scheme with mkParts/fromParts.+--+-- Even after all that, we still have weird corner cases like:+--+-- > match "**" "/" = Just ["//"]+--+-- But the only realistic path it applies to is /, which should be pretty rare.+++mkParts :: [String] -> String+mkParts xs | all null xs = replicate (length xs) '/'+           | otherwise = intercalate "/" xs++fromParts :: String -> [String]+fromParts xs | all isPathSeparator xs = replicate (length xs) []+             | otherwise = split isPathSeparator xs++match :: Pattern -> Path -> Maybe [String]+match (Pattern w) (Path x) = f <$> wildcardMatch (wildcardMatch equals) w x+    where+        f :: [Either [[Either [()] String]] [String]] -> [String]+        f (Left x:xs) = rights (concat x) ++ f xs+        f (Right x:xs) = mkParts x : f xs+        f [] = []+++substitute :: Pattern -> [String] -> Maybe Path+substitute (Pattern w) ps = do+    let inner w = concat <$> wildcardSubst getNext pure w+        outer w = concat <$> wildcardSubst (fromParts <$> getNext) (traverse inner) w+    (ps, v) <- runNext ps $ outer w+    if null ps then Just $ Path v else Nothing+++arity :: Pattern -> Int+arity (Pattern x) = sum $ wildcardArity x : map wildcardArity (concat $ F.toList x)
+ src/System/FilePattern/Directory.hs view
@@ -0,0 +1,97 @@++-- | Optimised directory traversal using 'FilePattern' values.+--+--   /Case Sensitivity/: these traversals are optimised to reduce the number of IO operations+--   performed. In particular, if the relevant subdirectories can be determined in+--   advance it will use 'doesDirectoryExist' rather than 'getDirectoryContents'.+--   However, on case-insensitive file systems, if there is a directory @foo@,+--   then @doesDirectoryExist \"FOO\"@ will report @True@, but @FOO@ won't be a result+--   returned by 'getDirectoryContents', which may result in different search results+--   depending on whether a certain optimisations kick in.+--+--   If these optimisation differences are absolutely unacceptable use 'getDirectoryFilesIgnoreSlow'.+--   However, normally these differences are not a problem.+module System.FilePattern.Directory(+    getDirectoryFiles,+    getDirectoryFilesIgnore,+    getDirectoryFilesIgnoreSlow+    ) where++import Control.Monad.Extra+import Data.Functor+import Data.List+import System.Directory+import System.FilePath+import System.FilePattern.Core+import System.FilePattern.Step+import Prelude+++-- | Get the files below a certain root that match any of the 'FilePattern' values. Only matches+--   files, not directories. Avoids traversing into directories that it can detect won't have+--   any matches in.+--+-- > getDirectoryFiles "myproject/src" ["**/*.h","**/*.c"]+--+--   If there are certain directories/files that should not be explored, use 'getDirectoryFilesIgnore'.+--+--   /Warning/: on case-insensitive file systems certain optimisations can cause surprising results.+--   See the top of the module for details.+getDirectoryFiles :: FilePath -> [FilePattern] -> IO [FilePath]+getDirectoryFiles dir match = operation False dir match []++++-- | Get the files below a certain root matching any of the first set of 'FilePattern' values,+--   but don't return any files which match any ignore pattern. Typically the ignore pattens will+--   end with @\/**@, e.g. @.git\/**@.+--+--   /Warning/: on case-insensitive file systems certain optimisations can cause surprising results.+--   See the top of the module for details.+getDirectoryFilesIgnore :: FilePath -> [FilePattern] -> [FilePattern] -> IO [FilePath]+getDirectoryFilesIgnore = operation False+++-- | Like 'getDirectoryFilesIgnore' but that the optimisations that may change behaviour on a+--   case-insensitive file system. Note that this function will never return more results+--   then 'getDirectoryFilesIgnore', and may return less. However, it will obey invariants+--   such as:+--+-- > getDirectoryFilesIgnoreSlow root [x] [] ++ getDirectoryFilesIgnoreSlow root [y] []+-- >     == getDirectoryFilesIgnoreSlow root [x,y] []+--+--   In contrast 'getDirectoryFilesIgnore' only guarantees that invariant on+--   case-sensitive file systems.+getDirectoryFilesIgnoreSlow :: FilePath -> [FilePattern] -> [FilePattern] -> IO [FilePath]+getDirectoryFilesIgnoreSlow = operation True+++operation :: Bool -> FilePath -> [FilePattern] -> [FilePattern] -> IO [FilePath]+operation slow rootBad yes no = f [] (step_ yes) (step_ no)+    where+        -- normalise out Windows vs other behaviour around "", make sure we end with /+        root = if rootBad == "" then "./" else addTrailingPathSeparator rootBad++        -- parts is a series of path components joined with trailing / characters+        f parts yes no+            | StepEverything <- stepNext no = return []+            | not slow, StepOnly xs <- stepNext yes = g parts yes no xs False+            | otherwise = do+                xs <- filter (not . all (== '.')) <$> getDirectoryContents (root ++ parts)+                g parts yes no xs True++        -- doesExist means that one of doesFileExist or doesDirectoryExist is true+        g parts yes no xs doesExist =+            concatForM (sort xs) $ \x -> do+                let path = root ++ parts ++ x+                -- deliberately shadow since using yes/no from now on would be wrong+                yes <- return $ stepApply yes x+                no <- return $ stepApply no x+                isFile <- if stepDone yes /= [] && stepDone no == [] then Just <$> doesFileExist path else return Nothing+                case isFile of+                    Just True -> return [parts ++ x]+                    _ | StepEverything <- stepNext no -> return []+                      | StepOnly [] <- stepNext yes -> return []+                      | otherwise -> do+                        b <- if doesExist && isFile == Just False then return True else doesDirectoryExist path+                        if not b then return [] else f (parts ++ x ++ "/") yes no
+ src/System/FilePattern/ListBy.hs view
@@ -0,0 +1,30 @@++-- | Operations on lists, generated to an arbitrary generating equality+module System.FilePattern.ListBy(+    eqListBy, stripPrefixBy, stripSuffixBy, stripInfixBy+    ) where++import Control.Applicative+import Data.Tuple.Extra+++eqListBy :: (a -> b -> Maybe c) -> [a] -> [b] -> Maybe [c]+eqListBy _ [] [] = Just []+eqListBy eq (a:as) (b:bs) = liftA2 (:) (eq a b) (eqListBy eq as bs)+eqListBy _ _ _ = Nothing+++stripPrefixBy :: (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([c], [b])+stripPrefixBy eq [] bs = Just ([], bs)+stripPrefixBy eq _  [] = Nothing+stripPrefixBy eq (a:as) (b:bs) = do c <- eq a b; first (c:) <$> stripPrefixBy eq as bs++stripSuffixBy :: (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([b], [c])+stripSuffixBy eq [] bs = Just (bs, []) -- shortcut, but equal to the equation below+stripSuffixBy eq _  [] = Nothing       -- shortcut, but equal to the equation below+stripSuffixBy eq as bs = (\(c,b) -> (reverse b, reverse c)) <$> stripPrefixBy eq (reverse as) (reverse bs)++stripInfixBy :: (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([b], [c], [b])+stripInfixBy eq needle haystack | Just (ans, rest) <- stripPrefixBy eq needle haystack = Just ([], ans, rest)+stripInfixBy eq needle [] = Nothing+stripInfixBy eq needle (x:xs) = (\(a,b,c) -> (x:a,b,c)) <$> stripInfixBy eq needle xs
+ src/System/FilePattern/Monads.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE DeriveFunctor #-}++-- | Some useful Monads+module System.FilePattern.Monads(+    Next, runNext, getNext+    ) where++import Control.Applicative+import Prelude++-- | Next is a monad which has a series of elements, and can pull off the next one+newtype Next e a = Next ([e] -> Maybe ([e], a))+    deriving Functor++instance Applicative (Next e) where+    pure a = Next $ \es -> Just (es, a)+    Next f <*> Next x = Next $ \es -> do+        (es, f) <- f es+        (es, x) <- x es+        Just (es, f x)++getNext :: Next e e+getNext = Next $ \x -> case x of+    e:es -> Just (es, e)+    _ -> Nothing++runNext :: [e] -> Next e a -> Maybe ([e], a)+runNext ps (Next f) = f ps
+ src/System/FilePattern/Step.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE ViewPatterns, DeriveFunctor, BangPatterns, TupleSections, RecordWildCards #-}++-- | Applying a set of paths vs a set of patterns efficiently+module System.FilePattern.Step(+    step, step_, Step(..), StepNext(..)+    ) where++import System.FilePattern.Core+import System.FilePattern.Tree+import System.FilePattern.Wildcard++import Control.Monad.Extra+import Data.List.Extra+import Data.Semigroup+import Data.Tuple.Extra+import Data.Functor+import Data.Either+import qualified Data.List.NonEmpty as NE+import Prelude+++-- | What we know about the next step values.+data StepNext+    =+      -- | All components not listed will result in dull 'Step' values from 'stepApply',+      --   with 'stepNext' being @'StepOnly' []@ and 'stepDone' being @[]@. The field is a set - their order+      --   is irrelevant but there will be no duplicates in values arising from 'step'.+      StepOnly [String]+    | -- | All calls to 'stepApply' will return 'stepNext' being 'StepEverything' with a non-empty 'stepDone'.+      StepEverything+    | -- | We have no additional information about the output from 'stepApply'.+      StepUnknown+      deriving (Eq,Ord,Show)+++mergeStepNext :: [StepNext] -> StepNext+mergeStepNext = f id+    where+        f rest [] = StepOnly $ rest []+        f rest (StepUnknown:xs) = if StepEverything `elem` xs then StepEverything else StepUnknown+        f rest (StepEverything:xs) = StepEverything+        f rest (StepOnly x:xs) = f (rest . (x ++)) xs++normaliseStepNext :: StepNext -> StepNext+normaliseStepNext (StepOnly xs) = StepOnly $ nubOrd xs+normaliseStepNext x = x+++instance Semigroup StepNext where+    a <> b = sconcat $ NE.fromList [a,b]+    sconcat = normaliseStepNext . mergeStepNext . NE.toList++instance Monoid StepNext where+    mempty = StepOnly []+    mappend = (<>)+    mconcat = maybe mempty sconcat . NE.nonEmpty -- important: use the fast sconcat+++-- | The result of 'step', used to process successive path components of a set of 'FilePath's.+data Step a = Step+    {stepDone :: [(a, [String])]+        -- ^ The files that match at this step. Includes the list that would have been produced by 'System.FilePattern.match',+        --   along with the values passed to 'step'. These results are not necessarily in order.+    ,stepNext :: StepNext+        -- ^ Information about the results of calling 'stepApply'. See 'StepNext' for details.+    ,stepApply :: String -> Step a+        -- ^ Apply one component from a 'FilePath' to get a new 'Step'.+    }+    deriving Functor++mergeStep :: (StepNext -> StepNext) -> [Step a] -> Step a+mergeStep f [] = mempty+mergeStep f [x] = x+mergeStep f xs = Step+    {stepDone = concatMap stepDone xs+    ,stepNext = f $ mergeStepNext $ map stepNext xs+    ,stepApply = \x -> mergeStep f $ map (`stepApply` x) xs+    }++instance Semigroup (Step a) where+    a <> b = sconcat $ NE.fromList [a,b]+    sconcat (NE.toList -> ss)+        | [s] <- ss = s+        | otherwise = Step+            {stepDone = concatMap stepDone ss+            ,stepNext = mconcat $ map stepNext ss+            ,stepApply = \x -> fastFoldMap (`stepApply` x) ss+            }++instance Monoid (Step a) where+    mempty = Step [] mempty $ const mempty+    mappend = (<>)+    mconcat = maybe mempty sconcat . NE.nonEmpty -- important: use the fast sconcat++fastFoldMap :: Monoid m => (a -> m) -> [a] -> m+fastFoldMap f = mconcat . map f -- important: use the fast mconcat+++-- Invariant: No two adjacent Lits+-- Invariant: No empty Lits+data Pat = Lits [Wildcard String]+         | StarStar+         | End+           deriving (Show,Eq,Ord)++toPat :: Pattern -> [Pat]+toPat (Pattern (Literal xs)) = [Lits xs]+toPat (Pattern (Wildcard pre mid post)) = intercalate [StarStar] $ map lit $ pre : mid ++ [post]+    where lit xs = [Lits xs | xs /= []]+++-- | Efficient matching of a set of 'FilePattern's against a set of 'FilePath's.+--   First call 'step' passing in all the 'FilePattern's, with a tag for each one.+--   Next call the methods of 'Step', providing the components of the 'FilePath's in turn.+--+--   Useful for efficient bulk searching, particularly directory scanning, where you can+--   avoid descending into directories which cannot match.+step :: [(a, FilePattern)] -> Step a+step = restore . ($ id) . f [] . makeTree . map (second $ toPat . parsePattern)+    where+        f :: [Pat] -> Tree Pat a -> (Parts -> Step [a])+        f seen (Tree ends nxts) = \parts -> mergeStep id $ map ($ parts) $ sEnds ++ sNxts+            where+                sEnds = case unroll ends (seen ++ [End]) of+                    _ | null ends -> []+                    Just ([], c) -> [c (error "step invariant violated (1)")]+                    _ -> error $ "step invariant violated (2), " ++ show seen++                sNxts = flip map nxts $ \(p,ps) ->+                    let seen2 = seen ++ [p] in+                    case unroll (error "step invariant violated (3)") seen2 of+                        Nothing -> f seen2 ps+                        Just (nxt, c) -> c (f [] $ retree nxt ps)++        retree [] t = t+        retree (p:ps) t = Tree [] [(p, retree ps t)]++        restore :: Step [a] -> Step a -- and restore the stepNext invariant+        restore Step{..} = Step+            {stepDone = [(a, b) | (as,b) <- stepDone, a <- as]+            ,stepNext = normaliseStepNext stepNext+            ,stepApply = restore . stepApply+            }++-- | Like 'step' but using @()@ as the tag for each 'FilePattern'.+step_ :: [FilePattern] -> Step ()+step_ = step . map ((),)+++match1 :: Wildcard String -> String -> Maybe [String]+match1 w x = rights <$> wildcardMatch equals w x+++type Parts = [String] -> [String]++-- Given a prefix of the pattern, if you can deal with it, return+-- the rest of the pattern in the prefix you didn't match, and something that given+-- a matcher for the rest of the pattern, returns a matcher for the whole pattern.+unroll :: a -> [Pat] -> Maybe ([Pat], (Parts -> Step a) -> Parts -> Step a)+-- normal path, dispatch on what you find next+unroll val [End] = Just ([], \_ parts -> mempty{stepDone = [(val, parts [])]})++-- two stars in a row, the first will match nothing, the second everything+unroll val [StarStar,StarStar] = Just ([StarStar], \cont parts -> cont (parts . ([]:)))++-- if you have literals next, match them+unroll val [Lits (l:ls)] = Just ([Lits ls | ls /= []], \cont parts -> Step+    {stepDone = []+    ,stepNext = case l of Literal v -> StepOnly [v]; Wildcard{} -> StepUnknown+    ,stepApply = \s -> case match1 l s of+        Just xs -> cont (parts . (xs++))+        Nothing -> mempty+    })++-- if anything else is allowed, just quickly allow it+unroll val [StarStar,End] = Just ([], \_ parts -> g parts [])+    where+        g parts rseen = Step+            {stepDone = [(val, parts [mkParts $ reverse rseen])]+            ,stepNext = StepEverything+            ,stepApply = \s -> g parts (s:rseen)+            }++-- if you have a specific tail prefix, find it+unroll val [StarStar,Lits (reverse &&& length -> (rls,nls)),End] = Just ([], \_ parts -> g parts 0 [])+    where+        g parts !nseen rseen = Step+            {stepDone = case zipWithM match1 rls rseen of+                _ | nseen < nls -> [] -- fast path+                Just xss -> [(val, parts $ mkParts (reverse $ drop nls rseen) : concat (reverse xss))]+                Nothing -> []+            ,stepNext = StepUnknown+            ,stepApply = \s -> g parts (nseen+1) (s:rseen)+            }++-- we know the next literal, and it doesn't have any constraints immediately after+unroll val [StarStar,Lits [l],StarStar] = Just ([StarStar], \cont parts -> g cont parts [])+    where+        g cont parts rseen = Step+            {stepDone = []+            ,stepNext = StepUnknown+            ,stepApply = \s -> case match1 l s of+                Just xs -> cont (parts . (++) (mkParts (reverse rseen) : xs))+                Nothing -> g cont parts (s:rseen)+            }++-- the hard case, a floating substring, accumulate at least N, then star testing in reverse+unroll val [StarStar,Lits (reverse &&& length -> (rls,nls)),StarStar] = Just ([StarStar], \cont parts -> g cont parts 0 [])+    where+        g cont parts !nseen rseen = Step+            {stepDone = []+            ,stepNext = StepUnknown+            ,stepApply = \s -> case zipWithM match1 rls (s:rseen) of+                _ | nseen+1 < nls -> g cont parts (nseen+1) (s:rseen) -- not enough accumulated yet+                Nothing -> g cont parts (nseen+1) (s:rseen)+                Just xss -> cont (parts . (++) (mkParts (reverse $ drop nls $ s:rseen) : concat (reverse xss)))+            }++unroll _ _ = Nothing
+ src/System/FilePattern/Tree.hs view
@@ -0,0 +1,19 @@++-- | Build up shared prefix trees+module System.FilePattern.Tree(+    Tree(..), makeTree+    ) where++import Data.List.Extra+import Prelude+++data Tree k v = Tree [v] [(k, Tree k v)]++makeTree :: Ord k => [(v, [k])] -> Tree k v+makeTree = f . sortOn snd+    where+        f xs = Tree (map fst empty) [(fst $ head gs, f $ map snd gs) | gs <- groups]+            where+                (empty, nonEmpty) = span (null . snd) xs+                groups = groupOn fst [(x, (a,xs)) | (a,x:xs) <- nonEmpty]
+ src/System/FilePattern/Wildcard.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE DeriveFunctor, DeriveFoldable #-}++-- | The type of wildcards, which generalises to both patterns+--   inside a filename and along patterns. e.g.+--+-- > *xy* = Wildcard [] ["xy"] []+-- > **/xxx/yyy/** = Wildcard [] [[Literal "xxx", Literal "yyy"]] []+--+--   Some more examples focusing on the first type of pattern:+--+-- > xyz = Literal "xyz"+-- > x*y*z = Wildcard "x" ["y"] ["z"]+-- > x**z = Wildcard "x" [""] ["z"]+module System.FilePattern.Wildcard(+    Wildcard(..),+    wildcardMatch,+    wildcardSubst,+    wildcardArity,+    equals+    ) where++import Data.Functor+import Data.List.Extra+import Control.Applicative+import Control.Monad.Extra+import System.FilePattern.ListBy+import Data.Traversable+import qualified Data.Foldable as F+import Prelude+++equals :: Eq a => a -> a -> Maybe ()+equals x y = if x == y then Just () else Nothing+++-- | Representing either literals, or wildcards+data Wildcard a = Wildcard a [a] a -- ^ prefix [mid-parts] suffix+                | Literal a -- ^ literal match+    deriving (Show,Eq,Ord,Functor,F.Foldable)++-- | Given a wildcard, and a test string, return the matches.+--   Only return the first (all patterns left-most) valid star matching.+wildcardMatch :: (a -> b -> Maybe c) -> Wildcard [a] -> [b] -> Maybe [Either [c] [b]]+wildcardMatch eq (Literal mid) x = (:[]) . Left <$> eqListBy eq mid x+wildcardMatch eq (Wildcard pre mid post) x = do+    (pre, x) <- stripPrefixBy eq pre x+    (x, post) <- stripSuffixBy eq post x+    mid <- stripInfixes mid x+    return $ [Left pre] ++ mid ++ [Left post]+    where+        stripInfixes [] x = Just [Right x]+        stripInfixes (m:ms) y = do+            (a,b,x) <- stripInfixBy eq m y+            (\c -> Right a:Left b:c) <$> stripInfixes ms x+++wildcardSubst :: Applicative m => m b -> (a -> m b) -> Wildcard a -> m [b]+wildcardSubst gap lit (Literal x) = (:[]) <$> lit x+wildcardSubst gap lit (Wildcard pre mid post) = (:) <$>+    lit pre <*>+    (concat <$> traverse (\v -> (\a b -> [a,b]) <$> gap <*> lit v) (mid ++ [post]))+++wildcardArity :: Wildcard a -> Int+wildcardArity (Literal _) = 0+wildcardArity (Wildcard _ xs _) = length xs + 1
+ test/Test.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE RecordWildCards, TupleSections #-}++module Main(main) where++import Control.Monad.Extra+import Data.List.Extra+import Data.Functor+import Data.Tuple.Extra+import qualified Test.Util as T+import Data.Maybe+import System.FilePattern as FilePattern+import System.FilePath(isPathSeparator)+import System.IO.Unsafe+import Test.QuickCheck+import Test.Cases+import Prelude+++---------------------------------------------------------------------+-- TEST UTILITIES++newtype ArbPattern = ArbPattern FilePattern deriving (Show,Eq)+newtype ArbPath    = ArbPath    FilePath    deriving (Show,Eq)++-- Since / and * are the only "interesting" elements, just add ab to round out the set++instance Arbitrary ArbPattern where+    arbitrary = fmap (ArbPattern . concat) $ listOf $ elements $ "**" : map (:[]) "\\/*ab."+    shrink (ArbPattern x) = map ArbPattern $ shrinkList (\x -> ['/' | x == '\\']) x++instance Arbitrary ArbPath where+    arbitrary = fmap ArbPath $ listOf $ elements "\\/ab."+    shrink (ArbPath x) = map ArbPath $ shrinkList (\x -> ['/' | x == '\\']) x+++runStepSimple :: FilePattern -> FilePath -> Maybe [String]+runStepSimple pat path = f (step_ [pat]) $ split isPathSeparator path+    where+        f Step{..} [] = snd <$> listToMaybe stepDone+        f Step{..} (x:xs) = f (stepApply x) xs++runStepComplex :: FilePattern -> FilePath -> Maybe [String]+runStepComplex pat path = fmap thd3 $ listToMaybe $ matchMany [((), pat)] [((), path)]+++---------------------------------------------------------------------+-- DRIVER++main :: IO ()+main = do+    putStrLn "Testing..."+    testCases+    T.TestData{..} <- T.unsafeTestData+    putStrLn $ "Passed " ++ show testDataCases ++ " specific cases"+    -- when False $ dot $ testWalk s+    testProperties $ testDataPats ++ testDataPaths+    putStrLn "SUCCESS (all tests completed)"+++testProperties :: [String] -> IO ()+testProperties xs = do+    resOne <- fmap (catMaybes . concat) $ forM (zipFrom 1 xs) $ \(ix,x) -> forM (zipFrom 1 xs) $ \(iy,y) -> fmap (ix,iy,) <$> prop x y+    let resMany = matchMany (zipFrom 1 xs) (zipFrom 1 xs)+    T.assertBool (sort resOne == sort resMany) "matchMany" []+    putStrLn $ "Passed " ++ show (length xs ^ 2) ++ " properties on specific cases"+    Success{} <- quickCheckWithResult stdArgs{maxSuccess=10000} $ \(ArbPattern p) (ArbPath x) ->+        (if p ?== x then label "match" else property) $ unsafePerformIO $ prop p x >> return True+    return ()+    where+        prop :: FilePattern -> FilePath -> IO (Maybe [String])+        prop pat file = do+            let ans = match pat file+            let fields = ["Pattern" T.#= pat, "File" T.#= file, "Match" T.#= ans]+            whenJust ans $ \ans -> T.assertBool (length ans == arity pat) "arity" fields+            let res = pat ?== file in T.assertBool (res == isJust ans) "?==" $ fields ++ ["?==" T.#= res]+            let res = runStepSimple  pat file in T.assertBool (res == ans) "step (simple)" $ fields ++ ["step" T.#= res]+            let res = runStepComplex pat file in T.assertBool (res == ans) "step (complex)" $ fields ++ ["step" T.#= res]+            let norm = (\x -> if null x then [""] else x) . filter (/= ".") . split isPathSeparator+            when (isJust ans) $ let res = substitute pat (fromJust $ FilePattern.match pat file) in+                T.assertBool (norm res == norm file) "substitute" $ fields ++ ["Match" T.#= FilePattern.match pat file, "Got" T.#= res, "Input (norm)" T.#= norm file, "Got (norm)" T.#= norm res]+            return ans
+ test/Test/Cases.hs view
@@ -0,0 +1,167 @@++module Test.Cases(testCases) where++import Test.Util+import System.FilePath((</>))+import System.Info.Extra+++testCases :: IO ()+testCases = testMatch >> testArity >> testSubstitute >> testStepNext >> testDirectory+++testArity :: IO ()+testArity = do+    arity "" 0+    arity "a*b" 1+    arity "a//b" 0+    arity "a/**/b" 1+    arity "/a/b/cccc_" 0+    arity "a///b" 0+    arity "foo/**/*" 2+    arity "//*a.txt" 1+    arity "foo//a*.txt" 1+    arity "**/*a.txt" 2+    arity "foo/**/a*.txt" 2+    arity "//*a.txt" 1+    arity "foo//a*.*txt" 2+    arity "foo/**/a*.*txt" 3+++testSubstitute :: IO ()+testSubstitute = do+    substitute "**/*a*.txt" ["","test","da"] "testada.txt"+    substitute "**/*a.txt" ["foo/bar","test"] "foo/bar/testa.txt"+    -- error if the number of replacements is wrong+    substituteErr "nothing" ["test"] ["substitute","nothing","expects 0","got 1","test"]+    substituteErr "*/*" ["test"] ["substitute","*/*","expects 2","got 1","test"]+++testMatch :: IO ()+testMatch = do+    matchN "//*.c" "foo/bar/baz.c"+    matchY "**/*.c" "foo/bar/baz.c" ["foo/bar","baz"]+    matchY ("**" </> "*.c") ("foo/bar" </> "baz.c") ["foo/bar","baz"]+    matchY "*.c" "baz.c" ["baz"]+    matchN "//*.c" "baz.c"+    matchY "**/*.c" "baz.c" ["","baz"]+    matchY "**/*a.txt" "foo/bar/testa.txt" ["foo/bar","test"]+    matchN "**/*.c" "baz.txt"+    matchY "**/*a.txt" "testa.txt" ["","test"]+    matchY "**/a.txt" "a.txt" [""]+    matchY "a/**/b" "a/b" [""]+    matchY "a/**/b" "a/x/b" ["x"]+    matchY "a/**/b" "a/x/y/b" ["x/y"]+    matchY "a/**/**/b" "a/x/y/b" ["","x/y"]+    matchY "**/*a*.txt" "testada.txt" ["","test","da"]+    matchY "test.c" "test.c" []+    matchN "*.c" "foor/bar.c"+    matchN "*/*.c" "foo/bar/baz.c"+    matchN "foo//bar" "foobar"+    matchN "foo/**/bar" "foobar"+    matchN "foo//bar" "foobar/bar"+    matchN "foo/**/bar" "foobar/bar"+    matchN "foo//bar" "foo/foobar"+    matchN "foo/**/bar" "foo/foobar"+    matchN "foo//bar" "foo/bar"+    matchY "foo/**/bar" "foo/bar" [""]+    matchY "foo/bar" ("foo" </> "bar") []+    matchY ("foo" </> "bar") "foo/bar" []+    matchY ("foo" </> "bar") ("foo" </> "bar") []+    matchY "**/*.c" ("bar" </> "baz" </> "foo.c") ["bar/baz","foo"]+    matchY "**/*" "/bar" ["/","bar"]+    matchN "/bob//foo" "/bob/this/test/foo"+    matchY "/bob/**/foo" "/bob/this/test/foo" ["this/test"]+    matchN "/bob//foo" "bob/this/test/foo"+    matchN "/bob/**/foo" "bob/this/test/foo"+    matchN "bob//foo/" "bob/this/test/foo/"+    matchY "bob/**/foo/" "bob/this/test/foo/" ["this/test"]+    matchY "bob/**/foo/" "bob/foo/" [""]+    matchY "bob/**/foo/" "bob//foo/" ["/"]+    matchN "bob//foo/" "bob/this/test/foo"+    matchN "bob/**/foo/" "bob/this/test/foo"+    matchY ("**" </> "*a*.txt") "testada.txt" ["","test","da"]+    matchN "a//" "a"+    matchY "a/**" "a" [""]+    matchY "a/**" "a/" ["/"]+    matchN "/a//" "/a"+    matchY "a/**" "a" [""]+    matchY "/a/**" "/a" [""]+    matchN "///a//" "/a"+    matchY "**/a/**" "/a" ["/",""]+    matchN "///" ""+    matchY "/**" "/" ["/"]+    matchY "**/" "a/" ["a"]+    matchY "**/**" "" ["","/"]+    matchY "x/**/y" "x/y" [""]+    matchY "x/**/" "x/" [""]+    matchY "x/**/" "x/foo/" ["foo"]+    matchN "x///" "x"+    matchN "x/**/" "x"+    matchY "x/**/" "x/foo/bar/" ["foo/bar"]+    matchN "x///" "x/foo/bar"+    matchN "x/**/" "x/foo/bar"+    matchY "x/**/*/y" "x/z/y" ["","z"]+    matchY "" "" []+    matchN "" "y"+    matchN "" "/"++    matchY "*/*" "x/y" ["x","y"]+    matchN "*/*" "x"+    matchY "**/*" "x" ["","x"]+    matchY "**/*" "" ["",""]+    matchY "*/**" "x" ["x",""]+    matchY "*/**/*" "x/y" ["x","","y"]+    matchN "*//*" ""+    matchN "*/**/*" ""+    matchN "*//*" "x"+    matchN "*/**/*" "x"+    matchN "*//*//*" "x/y"+    matchN "*/**/*/**/*" "x/y"+    matchY "**/*/" "/" ["",""]+    matchY "*/**/**/" "/" ["","",""]+    matchN "b*b*b*//" "bb"+    matchN "b*b*b*/**" "bb"++    matchY "**" "/" ["//"] -- UGLY corner case+    matchY "**/x" "/x" ["/"]+    matchY "**" "x/" ["x/"]+    let s = if isWindows then '/' else '\\'+    matchY "**" "\\\\drive" [s:s:"drive"]+    matchY "**" "C:\\drive" ["C:"++s:"drive"]+    matchY "**" "C:drive" ["C:drive"]++    matchN "./file" "file"+    matchN "/file" "file"+    matchN "foo/./bar" "foo/bar"+    matchY "foo/./bar" "foo/./bar" []+    matchN "foo/./bar" "foo/bar"+    matchY "**z" "xyz" ["","xy"]+    matchY "**/a/b*" "a/a/a/a/bc" ["a/a/a","c"]+    matchY "**/a/b/**" "a/a/a/a/b/c" ["a/a/a","c"]+++testStepNext :: IO ()+testStepNext = do+    stepNext ["*.xml"] [] StepUnknown+    stepNext ["*.xml"] ["foo"] $ StepOnly []+    stepNext ["**/*.xml"] [] StepUnknown+    stepNext ["**/*.xml"] ["foo"] StepUnknown+    stepNext ["foo/bar/*.xml"] [] $ StepOnly ["foo"]+    stepNext ["foo/bar/*.xml"] ["oof"] $ StepOnly []+    stepNext ["foo/bar/*.xml"] ["foo"] $ StepOnly ["bar"]+    stepNext ["a","b/c"] [] $ StepOnly ["a","b"]+    stepNext ["a","b/c"] ["b"] $ StepOnly ["c"]+    stepNext ["*/x"] [] StepUnknown+    stepNext ["*/x"] ["foo"] $ StepOnly ["x"]+    stepNext ["*/**"] ["bar"] StepEverything+++testDirectory :: IO ()+testDirectory = do+    getDirectory ["**/*.c"] [] ["baz/test.c","baz/zoo.c","foo/bar.c","foo/foo/foo.c","zoo.c"] ["extra/test.h","foo.c/bob.h"]+    -- Currently no way to test what it can access, sadly+    -- should only look inside: foo+    getDirectory ["foo/*.c"] [] ["foo/bar.c","foo/baz.c"] ["foo.c","foo/bar/baz.c","test/foo.c"]+    -- should only look inside: . foo zoo+    getDirectory ["foo/*.c","**/*.h"] [".git/**","**/no.*"] ["foo/bar.c","foo/baz.h","zoo/test.h"] ["foo/no.c",".git/foo.h","zoo/test.c"]
+ test/Test/Util.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE RecordWildCards, ConstraintKinds #-}++module Test.Util(+    assertBool, (#=),+    matchY, matchN,+    arity,+    substitute, substituteErr,+    stepNext,+    getDirectory,+    TestData(..), unsafeTestData,+    FP.StepNext(..)+    ) where++import Control.Exception.Extra+import Control.Monad.Extra+import Data.List.Extra+import Data.IORef.Extra+import System.Directory+import System.FilePath+import System.FilePattern(FilePattern)+import qualified System.FilePattern as FP+import qualified System.FilePattern.Directory as FP+import System.IO.Extra+import System.IO.Unsafe+++---------------------------------------------------------------------+-- COLLECT TEST DATA++data TestData = TestData+    {testDataCases :: {-# UNPACK #-} !Int+    ,testDataPats :: [FilePattern]+    ,testDataPaths :: [FilePath]+    }++{-# NOINLINE testData #-}+testData :: IORef TestData+testData = unsafePerformIO $ newIORef $ TestData 0 [] []++addTestData :: [FilePattern] -> [FilePath] -> IO ()+addTestData pats paths = atomicModifyIORef' testData $ \t -> (f t, ())+    where f TestData{..} = TestData (testDataCases+1) (reverse pats ++ testDataPats) (reverse paths ++ testDataPaths)++unsafeTestData :: IO TestData+unsafeTestData = atomicModifyIORef' testData $ \t -> (TestData 0 [] [], f t)+    where f TestData{..} = TestData testDataCases (nubSort $ reverse testDataPats) (nubSort $ reverse testDataPaths)+++---------------------------------------------------------------------+-- TEST UTILITIES++assertBool :: Partial => Bool -> String -> [String] -> IO ()+assertBool b msg fields = unless b $ error $ unlines $+    ("ASSERTION FAILED: " ++ msg) : fields++assertException :: (Show a, Partial) => IO a -> [String] -> String -> [String] -> IO ()+assertException a parts msg fields = do+    res <- try_ $ evaluate . length . show =<< a+    case res of+        Left e -> assertBool (all (`isInfixOf` show e) parts) msg $ ["Expected" #= parts, "Got" #= e] ++ fields+        Right _ -> assertBool False msg $ ["Expected" #= parts, "Got" #= "<No exception>"] ++ fields++(#=) :: Show a => String -> a -> String+(#=) a b = a ++ ": " ++ show b+++---------------------------------------------------------------------+-- TEST WRAPPERS++match :: Partial => FilePattern -> FilePath -> Maybe [String] -> IO ()+match pat path want = do+    addTestData [pat] [path]+    let got = FP.match pat path+    assertBool (want == got) "match" ["Pattern" #= pat, "Path" #= path, "Expected" #= want, "Got" #= got]++matchY :: Partial => FilePattern -> FilePath -> [String] -> IO ()+matchY pat path xs = match pat path $ Just xs++matchN :: Partial => FilePattern -> FilePath -> IO ()+matchN pat path = match pat path Nothing+++arity :: Partial => FilePattern -> Int -> IO ()+arity pat want = do+    addTestData [pat] []+    let got = FP.arity pat+    assertBool (want == got) "arity" ["Pattern" #= pat, "Expected" #= want, "Got" #= got]+++substitute :: Partial => FilePattern -> [String] -> FilePath -> IO ()+substitute pat parts want = do+    addTestData [pat] [want]+    let got = FP.substitute pat parts+    assertBool (want == got) "substitute" ["Pattern" #= pat, "Parts" #= parts, "Expected" #= want, "Got" #= got]++substituteErr :: Partial => FilePattern -> [String] -> [String] -> IO ()+substituteErr pat parts want = do+    addTestData [pat] []+    assertException (return $ FP.substitute pat parts) want "substitute" ["Pattern" #= pat, "Parts" #= parts]+++stepNext :: [FilePattern] -> [String] -> FP.StepNext -> IO ()+stepNext pat path want = do+    addTestData pat []+    let got = f (FP.step_ pat) path+    assertBool (want == got) "stepNext" ["Pattern" #= pat, "Path" #= path, "Expected" #= want, "Got" #= got]+    where+        f FP.Step{..} [] = stepNext+        f FP.Step{..} (x:xs) = f (stepApply x) xs+++getDirectory :: [FilePattern] -> [FilePattern] -> [FilePath] -> [FilePath] -> IO ()+getDirectory match ignore want avoid =+    withTempDir $ \root -> do+        forM_ (want ++ avoid) $ \x -> do+            createDirectoryIfMissing True $ root </> takeDirectory x+            writeFile (root </> x) ""+        got <- FP.getDirectoryFilesIgnore root match ignore+        assertBool (want == got) "getDirectory" ["Root" #= root, "Match" #= match, "Ignore" #= ignore, "Want" #= want, "Got" #= got, "Avoid" #= avoid]