filepattern-0.1.3/0000755000000000000000000000000007346545000012221 5ustar0000000000000000filepattern-0.1.3/CHANGES.txt0000644000000000000000000000072107346545000014032 0ustar0000000000000000Changelog for filepattern 0.1.3, released 2022-08-21 #5, remove invalid optimisation in the presence of symlinks 0.1.2, released 2020-02-26 Optimise matchMany for empty lists Remove support for GHC 7.4 to 7.8 Make Directory module reexport FilePattern 0.1.1, released 2019-02-12 Switch to https://github.com/ndmitchell/filepattern 0.1, released 2019-02-12 Substantial (almost total) rewrite Remove // patterns Split from shake-0.16 filepattern-0.1.3/LICENSE0000644000000000000000000000276407346545000013237 0ustar0000000000000000Copyright Neil Mitchell 2011-2022. 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. filepattern-0.1.3/README.md0000644000000000000000000000654307346545000013510 0ustar0000000000000000# 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) [![Build status](https://img.shields.io/github/workflow/status/ndmitchell/filepattern/ci/master.svg)](https://github.com/ndmitchell/filepattern/actions) A library for matching files using patterns such as `src/**/*.png` for all `.png` files recursively under the `src` directory. 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. More complete semantics are given in the documentation for the matching function [`?==`](https://hackage.haskell.org/package/filepattern/docs/System-FilePattern.html#v:-63--61--61-). ## Features * All matching is _O(n)_. Most functions precompute some information given only one argument. There are also functions to provide bulk matching of many patterns against many paths simultaneously, see [`step`](https://hackage.haskell.org/package/filepattern/docs/System-FilePattern.html#v:step) and [`matchMany`](https://hackage.haskell.org/package/filepattern/docs/System-FilePattern.html#v:matchMany). * You can obtain the parts that matched the `*` and `**` special forms using [`match`](https://hackage.haskell.org/package/filepattern/docs/System-FilePattern.html#v:match), and substitute them into other patterns using [`substitute`](https://hackage.haskell.org/package/filepattern/docs/System-FilePattern.html#v:substitute). * You can search for files using a minimal number of IO operations, using the [System.FilePattern.Directory module](https://hackage.haskell.org/package/filepattern-0.1.1/docs/System-FilePattern-Directory.html). ## Related work * Another Haskell file pattern matching library is [Glob](https://hackage.haskell.org/package/Glob), which aims to be closer to the [POSIX `glob()` function](http://man7.org/linux/man-pages/man7/glob.7.html), with forms such as `*`, `?`, `**/` (somewhat different to the `filepattern` equivalent) and `[:alpha:]`. A complete guide is [in the documentation](https://hackage.haskell.org/package/Glob/docs/System-FilePath-Glob.html#v:compile). Compared to `filepattern`, the `Glob` library is closer to a regular expression library - definitely more powerful, potentially harder to use. * The [`shake` library](https://shakebuild.com/) has contained a `FilePattern` type since the beginning. This library evolved from that code, with significant improvements. * The semantics are heavily inspired by [VS Code](https://code.visualstudio.com/docs/editor/codebasics#_advanced-search-options), [Git](https://git-scm.com/docs/gitignore) and the [NPM package Glob](https://www.npmjs.com/package/glob). filepattern-0.1.3/filepattern.cabal0000644000000000000000000000462607346545000015532 0ustar0000000000000000cabal-version: 1.18 build-type: Simple name: filepattern version: 0.1.3 license: BSD3 license-file: LICENSE category: Development, FilePath author: Neil Mitchell , Evan Rutledge Borden maintainer: Neil Mitchell copyright: Neil Mitchell 2011-2022 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)/. Most functions precompute some information given only one argument. . * See "System.FilePattern" and @?==@ simple matching and semantics. . * Use @match@ and @substitute@ to extract suitable strings from the @*@ and @**@ matches, and substitute them back into other patterns. . * Use @step@ and @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 . homepage: https://github.com/ndmitchell/filepattern#readme bug-reports: https://github.com/ndmitchell/filepattern/issues tested-with: GHC==9.0, GHC==8.10, GHC==8.8, GHC==8.6, GHC==8.4, GHC==8.2, GHC==8.0 extra-doc-files: CHANGES.txt README.md source-repository head type: git location: https://github.com/ndmitchell/filepattern.git library default-language: Haskell2010 hs-source-dirs: src build-depends: base == 4.*, directory, extra >= 1.6.2, filepath 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 filepattern-0.1.3/src/System/0000755000000000000000000000000007346545000014274 5ustar0000000000000000filepattern-0.1.3/src/System/FilePattern.hs0000644000000000000000000001102607346545000017045 0ustar0000000000000000{-# 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 '?==' for the semantics of -- 'FilePattern' values. Features: -- -- * All matching is /O(n)/. Most functions precompute some information given only one argument. -- -- * Use 'match' and 'substitute' to extract suitable -- strings from the @*@ and @**@ matches, and substitute them back into other patterns. -- -- * Use 'step' and '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 [] = const [] matchMany pats = \files -> if null files then [] else f spats $ makeTree $ map (second $ (\(Core.Path x) -> x) . parsePath) files where spats = step pats 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] filepattern-0.1.3/src/System/FilePattern/0000755000000000000000000000000007346545000016511 5ustar0000000000000000filepattern-0.1.3/src/System/FilePattern/Core.hs0000644000000000000000000001056307346545000017742 0ustar0000000000000000 -- | 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) filepattern-0.1.3/src/System/FilePattern/Directory.hs0000644000000000000000000001142207346545000021011 0ustar0000000000000000 -- | Optimised directory traversal using 'FilePattern' values. -- All results are guaranteed to be sorted. -- -- /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( FilePattern, 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 (the final argument). -- Typically the ignore pattens will end with @\/**@, e.g. @.git\/**@. -- -- > getDirectoryFilesIgnore "myproject/src" ["**/*.h","**/*.c"] [".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 = pure [] | not slow, StepOnly xs <- stepNext yes = g parts yes no xs | otherwise = do xs <- filter (not . all (== '.')) <$> getDirectoryContents (root ++ parts) g parts yes no xs g parts yes no xs = concatForM (sort xs) $ \x -> do let path = root ++ parts ++ x -- deliberately shadow since using yes/no from now on would be wrong yes <- pure $ stepApply yes x no <- pure $ stepApply no x isFile <- whenMaybe (stepDone yes /= [] && stepDone no == []) (doesFileExist path) case isFile of Just True -> pure [parts ++ x] _ | StepEverything <- stepNext no -> pure [] | StepOnly [] <- stepNext yes -> pure [] | otherwise -> do -- Here we used to assume that getDirectoryContents means something exists, -- doesFileExists is False, therefore this must be a directory. -- That's not true in the presence of symlinks. b <- doesDirectoryExist path if not b then pure [] else f (parts ++ x ++ "/") yes no filepattern-0.1.3/src/System/FilePattern/ListBy.hs0000644000000000000000000000242007346545000020251 0ustar0000000000000000 -- | 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 filepattern-0.1.3/src/System/FilePattern/Monads.hs0000644000000000000000000000125307346545000020267 0ustar0000000000000000{-# 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 filepattern-0.1.3/src/System/FilePattern/Step.hs0000644000000000000000000002076507346545000017772 0ustar0000000000000000{-# 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 = mconcatMap 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 {- HLINT ignore fastFoldMap -} 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 filepattern-0.1.3/src/System/FilePattern/Tree.hs0000644000000000000000000000076307346545000017752 0ustar0000000000000000 -- | 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] filepattern-0.1.3/src/System/FilePattern/Wildcard.hs0000644000000000000000000000411707346545000020601 0ustar0000000000000000{-# 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 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 pure $ [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 filepattern-0.1.3/test/0000755000000000000000000000000007346545000013200 5ustar0000000000000000filepattern-0.1.3/test/Test.hs0000644000000000000000000000670107346545000014457 0ustar0000000000000000{-# 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 >> pure True pure () 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] pure ans filepattern-0.1.3/test/Test/0000755000000000000000000000000007346545000014117 5ustar0000000000000000filepattern-0.1.3/test/Test/Cases.hs0000644000000000000000000001274607346545000015523 0ustar0000000000000000 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"] filepattern-0.1.3/test/Test/Util.hs0000644000000000000000000001026707346545000015376 0ustar0000000000000000{-# 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 f 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" #= ""] ++ 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 (pure $ 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]