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
type FilePattern = String
newtype Path = Path [String]
deriving (Int -> Path -> ShowS
[Path] -> ShowS
Path -> [Char]
(Int -> Path -> ShowS)
-> (Path -> [Char]) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> [Char]
show :: Path -> [Char]
$cshowList :: [Path] -> ShowS
showList :: [Path] -> ShowS
Show,Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq,Eq Path
Eq Path =>
(Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Path -> Path -> Ordering
compare :: Path -> Path -> Ordering
$c< :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
>= :: Path -> Path -> Bool
$cmax :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
min :: Path -> Path -> Path
Ord)
newtype Pattern = Pattern (Wildcard [Wildcard String])
deriving (Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> [Char]
(Int -> Pattern -> ShowS)
-> (Pattern -> [Char]) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pattern -> ShowS
showsPrec :: Int -> Pattern -> ShowS
$cshow :: Pattern -> [Char]
show :: Pattern -> [Char]
$cshowList :: [Pattern] -> ShowS
showList :: [Pattern] -> ShowS
Show,Pattern -> Pattern -> Bool
(Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool) -> Eq Pattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
/= :: Pattern -> Pattern -> Bool
Eq,Eq Pattern
Eq Pattern =>
(Pattern -> Pattern -> Ordering)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Pattern)
-> (Pattern -> Pattern -> Pattern)
-> Ord Pattern
Pattern -> Pattern -> Bool
Pattern -> Pattern -> Ordering
Pattern -> Pattern -> Pattern
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Pattern -> Pattern -> Ordering
compare :: Pattern -> Pattern -> Ordering
$c< :: Pattern -> Pattern -> Bool
< :: Pattern -> Pattern -> Bool
$c<= :: Pattern -> Pattern -> Bool
<= :: Pattern -> Pattern -> Bool
$c> :: Pattern -> Pattern -> Bool
> :: Pattern -> Pattern -> Bool
$c>= :: Pattern -> Pattern -> Bool
>= :: Pattern -> Pattern -> Bool
$cmax :: Pattern -> Pattern -> Pattern
max :: Pattern -> Pattern -> Pattern
$cmin :: Pattern -> Pattern -> Pattern
min :: Pattern -> Pattern -> Pattern
Ord)
parsePath :: FilePath -> Path
parsePath :: [Char] -> Path
parsePath = [[Char]] -> Path
Path ([[Char]] -> Path) -> ([Char] -> [[Char]]) -> [Char] -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [[a]]
split Char -> Bool
isPathSeparator
renderPath :: Path -> FilePattern
renderPath :: Path -> [Char]
renderPath (Path [[Char]]
x) = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" [[Char]]
x
parsePattern :: FilePattern -> Pattern
parsePattern :: [Char] -> Pattern
parsePattern = Wildcard [Wildcard [Char]] -> Pattern
Pattern (Wildcard [Wildcard [Char]] -> Pattern)
-> ([Char] -> Wildcard [Wildcard [Char]]) -> [Char] -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]] -> [Wildcard [Char]])
-> Wildcard [[Char]] -> Wildcard [Wildcard [Char]]
forall a b. (a -> b) -> Wildcard a -> Wildcard b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char] -> Wildcard [Char]) -> [[Char]] -> [Wildcard [Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> Wildcard [Char]) -> [[Char]] -> [Wildcard [Char]])
-> ([Char] -> Wildcard [Char]) -> [[Char]] -> [Wildcard [Char]]
forall a b. (a -> b) -> a -> b
$ Char -> [Char] -> Wildcard [Char]
forall a. Eq a => a -> [a] -> Wildcard [a]
f Char
'*') (Wildcard [[Char]] -> Wildcard [Wildcard [Char]])
-> ([Char] -> Wildcard [[Char]])
-> [Char]
-> Wildcard [Wildcard [Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> Wildcard [[Char]]
forall a. Eq a => a -> [a] -> Wildcard [a]
f [Char]
"**" ([[Char]] -> Wildcard [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> Wildcard [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [[a]]
split Char -> Bool
isPathSeparator
where
f :: Eq a => a -> [a] -> Wildcard [a]
f :: forall a. Eq a => a -> [a] -> Wildcard [a]
f a
x [a]
xs = case (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
split (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) [a]
xs of
[a]
pre:[[a]]
mid_post -> case [[a]] -> Maybe ([[a]], [a])
forall a. [a] -> Maybe ([a], a)
unsnoc [[a]]
mid_post of
Maybe ([[a]], [a])
Nothing -> [a] -> Wildcard [a]
forall a. a -> Wildcard a
Literal [a]
pre
Just ([[a]]
mid, [a]
post) -> [a] -> [[a]] -> [a] -> Wildcard [a]
forall a. a -> [a] -> a -> Wildcard a
Wildcard [a]
pre [[a]]
mid [a]
post
mkParts :: [String] -> String
mkParts :: [[Char]] -> [Char]
mkParts [[Char]]
xs | ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
xs = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
xs) Char
'/'
| Bool
otherwise = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" [[Char]]
xs
fromParts :: String -> [String]
fromParts :: [Char] -> [[Char]]
fromParts [Char]
xs | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPathSeparator [Char]
xs = Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
xs) []
| Bool
otherwise = (Char -> Bool) -> [Char] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [[a]]
split Char -> Bool
isPathSeparator [Char]
xs
match :: Pattern -> Path -> Maybe [String]
match :: Pattern -> Path -> Maybe [[Char]]
match (Pattern Wildcard [Wildcard [Char]]
w) (Path [[Char]]
x) = [Either [[Either [()] [Char]]] [[Char]]] -> [[Char]]
f ([Either [[Either [()] [Char]]] [[Char]]] -> [[Char]])
-> Maybe [Either [[Either [()] [Char]]] [[Char]]] -> Maybe [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Wildcard [Char] -> [Char] -> Maybe [Either [()] [Char]])
-> Wildcard [Wildcard [Char]]
-> [[Char]]
-> Maybe [Either [[Either [()] [Char]]] [[Char]]]
forall a b c.
(a -> b -> Maybe c)
-> Wildcard [a] -> [b] -> Maybe [Either [c] [b]]
wildcardMatch ((Char -> Char -> Maybe ())
-> Wildcard [Char] -> [Char] -> Maybe [Either [()] [Char]]
forall a b c.
(a -> b -> Maybe c)
-> Wildcard [a] -> [b] -> Maybe [Either [c] [b]]
wildcardMatch Char -> Char -> Maybe ()
forall a. Eq a => a -> a -> Maybe ()
equals) Wildcard [Wildcard [Char]]
w [[Char]]
x
where
f :: [Either [[Either [()] String]] [String]] -> [String]
f :: [Either [[Either [()] [Char]]] [[Char]]] -> [[Char]]
f (Left [[Either [()] [Char]]]
x:[Either [[Either [()] [Char]]] [[Char]]]
xs) = [Either [()] [Char]] -> [[Char]]
forall a b. [Either a b] -> [b]
rights ([[Either [()] [Char]]] -> [Either [()] [Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Either [()] [Char]]]
x) [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [Either [[Either [()] [Char]]] [[Char]]] -> [[Char]]
f [Either [[Either [()] [Char]]] [[Char]]]
xs
f (Right [[Char]]
x:[Either [[Either [()] [Char]]] [[Char]]]
xs) = [[Char]] -> [Char]
mkParts [[Char]]
x [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Either [[Either [()] [Char]]] [[Char]]] -> [[Char]]
f [Either [[Either [()] [Char]]] [[Char]]]
xs
f [] = []
substitute :: Pattern -> [String] -> Maybe Path
substitute :: Pattern -> [[Char]] -> Maybe Path
substitute (Pattern Wildcard [Wildcard [Char]]
w) [[Char]]
ps = do
let inner :: Wildcard [a] -> Next [a] [a]
inner Wildcard [a]
w = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> Next [a] [[a]] -> Next [a] [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next [a] [a]
-> ([a] -> Next [a] [a]) -> Wildcard [a] -> Next [a] [[a]]
forall (m :: * -> *) b a.
Applicative m =>
m b -> (a -> m b) -> Wildcard a -> m [b]
wildcardSubst Next [a] [a]
forall e. Next e e
getNext [a] -> Next [a] [a]
forall a. a -> Next [a] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wildcard [a]
w
outer :: Wildcard [Wildcard [Char]] -> Next [Char] [[Char]]
outer Wildcard [Wildcard [Char]]
w = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[Char]]] -> [[Char]])
-> Next [Char] [[[Char]]] -> Next [Char] [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next [Char] [[Char]]
-> ([Wildcard [Char]] -> Next [Char] [[Char]])
-> Wildcard [Wildcard [Char]]
-> Next [Char] [[[Char]]]
forall (m :: * -> *) b a.
Applicative m =>
m b -> (a -> m b) -> Wildcard a -> m [b]
wildcardSubst ([Char] -> [[Char]]
fromParts ([Char] -> [[Char]]) -> Next [Char] [Char] -> Next [Char] [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next [Char] [Char]
forall e. Next e e
getNext) ((Wildcard [Char] -> Next [Char] [Char])
-> [Wildcard [Char]] -> Next [Char] [[Char]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Wildcard [Char] -> Next [Char] [Char]
forall {a}. Wildcard [a] -> Next [a] [a]
inner) Wildcard [Wildcard [Char]]
w
(ps, v) <- [[Char]] -> Next [Char] [[Char]] -> Maybe ([[Char]], [[Char]])
forall e a. [e] -> Next e a -> Maybe ([e], a)
runNext [[Char]]
ps (Next [Char] [[Char]] -> Maybe ([[Char]], [[Char]]))
-> Next [Char] [[Char]] -> Maybe ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ Wildcard [Wildcard [Char]] -> Next [Char] [[Char]]
outer Wildcard [Wildcard [Char]]
w
if null ps then Just $ Path v else Nothing
arity :: Pattern -> Int
arity :: Pattern -> Int
arity (Pattern Wildcard [Wildcard [Char]]
x) = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Wildcard [Wildcard [Char]] -> Int
forall a. Wildcard a -> Int
wildcardArity Wildcard [Wildcard [Char]]
x Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Wildcard [Char] -> Int) -> [Wildcard [Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Wildcard [Char] -> Int
forall a. Wildcard a -> Int
wildcardArity ([[Wildcard [Char]]] -> [Wildcard [Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Wildcard [Char]]] -> [Wildcard [Char]])
-> [[Wildcard [Char]]] -> [Wildcard [Char]]
forall a b. (a -> b) -> a -> b
$ Wildcard [Wildcard [Char]] -> [[Wildcard [Char]]]
forall a. Wildcard a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Wildcard [Wildcard [Char]]
x)