filepattern-0.1.2/0000755000000000000000000000000013625557147012234 5ustar0000000000000000filepattern-0.1.2/Setup.hs0000644000000000000000000000005613625557147013671 0ustar0000000000000000import Distribution.Simple main = defaultMain filepattern-0.1.2/README.md0000644000000000000000000000702313472474730013511 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) [![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 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.2/LICENSE0000644000000000000000000000276413622312206013230 0ustar0000000000000000Copyright Neil Mitchell 2011-2020. 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.2/filepattern.cabal0000644000000000000000000000473413625557065015544 0ustar0000000000000000cabal-version: >= 1.18 build-type: Simple name: filepattern version: 0.1.2 license: BSD3 license-file: LICENSE category: Development, FilePath author: Neil Mitchell , Evan Rutledge Borden maintainer: Neil Mitchell copyright: Neil Mitchell 2011-2020 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==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3 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 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 filepattern-0.1.2/CHANGES.txt0000644000000000000000000000056613625557056014053 0ustar0000000000000000Changelog for filepattern 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.2/test/0000755000000000000000000000000013625557147013213 5ustar0000000000000000filepattern-0.1.2/test/Test.hs0000644000000000000000000000670713430650177014467 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 >> 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 filepattern-0.1.2/test/Test/0000755000000000000000000000000013625557147014132 5ustar0000000000000000filepattern-0.1.2/test/Test/Util.hs0000644000000000000000000001027113622303403015361 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 (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] filepattern-0.1.2/test/Test/Cases.hs0000644000000000000000000001274613430642675015531 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.2/src/0000755000000000000000000000000013625557147013023 5ustar0000000000000000filepattern-0.1.2/src/System/0000755000000000000000000000000013625557147014307 5ustar0000000000000000filepattern-0.1.2/src/System/FilePattern.hs0000644000000000000000000001102613624467651017057 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.2/src/System/FilePattern/0000755000000000000000000000000013625557147016524 5ustar0000000000000000filepattern-0.1.2/src/System/FilePattern/Wildcard.hs0000644000000000000000000000415413416063240020575 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 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 filepattern-0.1.2/src/System/FilePattern/Tree.hs0000644000000000000000000000076313417720760017755 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.2/src/System/FilePattern/Step.hs0000644000000000000000000002076513622303563017771 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.2/src/System/FilePattern/Monads.hs0000644000000000000000000000125313415756477020306 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.2/src/System/FilePattern/ListBy.hs0000644000000000000000000000242013404023070020236 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.2/src/System/FilePattern/Directory.hs0000644000000000000000000001132613463241034021010 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 = 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 filepattern-0.1.2/src/System/FilePattern/Core.hs0000644000000000000000000001056313416403717017744 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)