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