{-# 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
?== :: FilePattern -> FilePattern -> Bool
(?==) FilePattern
w = Maybe [FilePattern] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [FilePattern] -> Bool)
-> (FilePattern -> Maybe [FilePattern]) -> FilePattern -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePattern -> FilePattern -> Maybe [FilePattern]
match FilePattern
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 :: FilePattern -> FilePattern -> Maybe [FilePattern]
match FilePattern
w = Pattern -> Path -> Maybe [FilePattern]
Core.match (FilePattern -> Pattern
parsePattern FilePattern
w) (Path -> Maybe [FilePattern])
-> (FilePattern -> Path) -> FilePattern -> Maybe [FilePattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePattern -> Path
parsePath


---------------------------------------------------------------------
-- MULTIPATTERN COMPATIBLE SUBSTITUTIONS

-- | How many @*@ and @**@ elements are there.
--
-- @
-- 'arity' \"test.c\" == 0
-- 'arity' \"**\/*.c\" == 2
-- @
arity :: FilePattern -> Int
arity :: FilePattern -> Int
arity = Pattern -> Int
Core.arity (Pattern -> Int) -> (FilePattern -> Pattern) -> FilePattern -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePattern -> Pattern
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 :: FilePattern -> [FilePattern] -> FilePattern
substitute FilePattern
w [FilePattern]
xs = FilePattern -> (Path -> FilePattern) -> Maybe Path -> FilePattern
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePattern -> FilePattern
forall a. HasCallStack => FilePattern -> a
error FilePattern
msg) Path -> FilePattern
renderPath (Maybe Path -> FilePattern) -> Maybe Path -> FilePattern
forall a b. (a -> b) -> a -> b
$ Pattern -> [FilePattern] -> Maybe Path
Core.substitute (FilePattern -> Pattern
parsePattern FilePattern
w) [FilePattern]
xs
    where
        msg :: FilePattern
msg = FilePattern
"Failed substitute, patterns of different arity. Pattern " FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ FilePattern -> FilePattern
forall a. Show a => a -> FilePattern
show FilePattern
w FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++
              FilePattern
" expects " FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ Int -> FilePattern
forall a. Show a => a -> FilePattern
show (FilePattern -> Int
arity FilePattern
w) FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ FilePattern
" elements, but got " FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ Int -> FilePattern
forall a. Show a => a -> FilePattern
show ([FilePattern] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePattern]
xs) FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++
              FilePattern
" namely " FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ [FilePattern] -> FilePattern
forall a. Show a => a -> FilePattern
show [FilePattern]
xs FilePattern -> FilePattern -> FilePattern
forall a. [a] -> [a] -> [a]
++ FilePattern
"."


-- | 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 :: [(a, FilePattern)] -> [(b, FilePattern)] -> [(a, b, [FilePattern])]
matchMany [] = [(a, b, [FilePattern])]
-> [(b, FilePattern)] -> [(a, b, [FilePattern])]
forall a b. a -> b -> a
const []
matchMany [(a, FilePattern)]
pats = \[(b, FilePattern)]
files -> if [(b, FilePattern)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(b, FilePattern)]
files then [] else Step a -> Tree FilePattern b -> [(a, b, [FilePattern])]
forall a b. Step a -> Tree FilePattern b -> [(a, b, [FilePattern])]
f Step a
spats (Tree FilePattern b -> [(a, b, [FilePattern])])
-> Tree FilePattern b -> [(a, b, [FilePattern])]
forall a b. (a -> b) -> a -> b
$ [(b, [FilePattern])] -> Tree FilePattern b
forall k v. Ord k => [(v, [k])] -> Tree k v
makeTree ([(b, [FilePattern])] -> Tree FilePattern b)
-> [(b, [FilePattern])] -> Tree FilePattern b
forall a b. (a -> b) -> a -> b
$ ((b, FilePattern) -> (b, [FilePattern]))
-> [(b, FilePattern)] -> [(b, [FilePattern])]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePattern -> [FilePattern])
-> (b, FilePattern) -> (b, [FilePattern])
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second ((FilePattern -> [FilePattern])
 -> (b, FilePattern) -> (b, [FilePattern]))
-> (FilePattern -> [FilePattern])
-> (b, FilePattern)
-> (b, [FilePattern])
forall a b. (a -> b) -> a -> b
$ (\(Core.Path [FilePattern]
x) -> [FilePattern]
x) (Path -> [FilePattern])
-> (FilePattern -> Path) -> FilePattern -> [FilePattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePattern -> Path
parsePath) [(b, FilePattern)]
files
    where
        spats :: Step a
spats = [(a, FilePattern)] -> Step a
forall a. [(a, FilePattern)] -> Step a
step [(a, FilePattern)]
pats

        f :: Step a -> Tree FilePattern b -> [(a, b, [FilePattern])]
f Step{[(a, [FilePattern])]
StepNext
FilePattern -> Step a
stepApply :: forall a. Step a -> FilePattern -> Step a
stepNext :: forall a. Step a -> StepNext
stepDone :: forall a. Step a -> [(a, [FilePattern])]
stepApply :: FilePattern -> Step a
stepNext :: StepNext
stepDone :: [(a, [FilePattern])]
..} (Tree [b]
bs [(FilePattern, Tree FilePattern b)]
xs) = [[(a, b, [FilePattern])]] -> [(a, b, [FilePattern])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(a, b, [FilePattern])]] -> [(a, b, [FilePattern])])
-> [[(a, b, [FilePattern])]] -> [(a, b, [FilePattern])]
forall a b. (a -> b) -> a -> b
$
            [(a
a, b
b, [FilePattern]
ps) | (a
a, [FilePattern]
ps) <- [(a, [FilePattern])]
stepDone, b
b <- [b]
bs] [(a, b, [FilePattern])]
-> [[(a, b, [FilePattern])]] -> [[(a, b, [FilePattern])]]
forall a. a -> [a] -> [a]
:
            [Step a -> Tree FilePattern b -> [(a, b, [FilePattern])]
f (FilePattern -> Step a
stepApply FilePattern
x) Tree FilePattern b
t | (FilePattern
x, Tree FilePattern b
t) <- [(FilePattern, Tree FilePattern b)]
xs, case StepNext
stepNext of StepOnly [FilePattern]
xs -> FilePattern
x FilePattern -> [FilePattern] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePattern]
xs; StepNext
_ -> Bool
True]