{-# LANGUAGE ConstraintKinds, RecordWildCards, ScopedTypeVariables #-}
module System.FilePattern(
FilePattern, (?==), match, substitute, arity,
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
(?==) :: 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
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
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
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
"."
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]