{-# LANGUAGE DeriveFunctor, DeriveFoldable #-}
module System.FilePattern.Wildcard(
Wildcard(..),
wildcardMatch,
wildcardSubst,
wildcardArity,
equals
) where
import Data.Functor
import Data.List.Extra
import Control.Applicative
import System.FilePattern.ListBy
import Data.Traversable
import qualified Data.Foldable as F
import Prelude
equals :: Eq a => a -> a -> Maybe ()
equals :: forall a. Eq a => a -> a -> Maybe ()
equals a
x a
y = if a
x forall a. Eq a => a -> a -> Bool
== a
y then forall a. a -> Maybe a
Just () else forall a. Maybe a
Nothing
data Wildcard a = Wildcard a [a] a
| Literal a
deriving (Int -> Wildcard a -> ShowS
forall a. Show a => Int -> Wildcard a -> ShowS
forall a. Show a => [Wildcard a] -> ShowS
forall a. Show a => Wildcard a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wildcard a] -> ShowS
$cshowList :: forall a. Show a => [Wildcard a] -> ShowS
show :: Wildcard a -> String
$cshow :: forall a. Show a => Wildcard a -> String
showsPrec :: Int -> Wildcard a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Wildcard a -> ShowS
Show,Wildcard a -> Wildcard a -> Bool
forall a. Eq a => Wildcard a -> Wildcard a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wildcard a -> Wildcard a -> Bool
$c/= :: forall a. Eq a => Wildcard a -> Wildcard a -> Bool
== :: Wildcard a -> Wildcard a -> Bool
$c== :: forall a. Eq a => Wildcard a -> Wildcard a -> Bool
Eq,Wildcard a -> Wildcard a -> Bool
Wildcard a -> Wildcard a -> Ordering
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
forall {a}. Ord a => Eq (Wildcard a)
forall a. Ord a => Wildcard a -> Wildcard a -> Bool
forall a. Ord a => Wildcard a -> Wildcard a -> Ordering
forall a. Ord a => Wildcard a -> Wildcard a -> Wildcard a
min :: Wildcard a -> Wildcard a -> Wildcard a
$cmin :: forall a. Ord a => Wildcard a -> Wildcard a -> Wildcard a
max :: Wildcard a -> Wildcard a -> Wildcard a
$cmax :: forall a. Ord a => Wildcard a -> Wildcard a -> Wildcard a
>= :: Wildcard a -> Wildcard a -> Bool
$c>= :: forall a. Ord a => Wildcard a -> Wildcard a -> Bool
> :: Wildcard a -> Wildcard a -> Bool
$c> :: forall a. Ord a => Wildcard a -> Wildcard a -> Bool
<= :: Wildcard a -> Wildcard a -> Bool
$c<= :: forall a. Ord a => Wildcard a -> Wildcard a -> Bool
< :: Wildcard a -> Wildcard a -> Bool
$c< :: forall a. Ord a => Wildcard a -> Wildcard a -> Bool
compare :: Wildcard a -> Wildcard a -> Ordering
$ccompare :: forall a. Ord a => Wildcard a -> Wildcard a -> Ordering
Ord,forall a b. a -> Wildcard b -> Wildcard a
forall a b. (a -> b) -> Wildcard a -> Wildcard b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Wildcard b -> Wildcard a
$c<$ :: forall a b. a -> Wildcard b -> Wildcard a
fmap :: forall a b. (a -> b) -> Wildcard a -> Wildcard b
$cfmap :: forall a b. (a -> b) -> Wildcard a -> Wildcard b
Functor,forall a. Eq a => a -> Wildcard a -> Bool
forall a. Num a => Wildcard a -> a
forall a. Ord a => Wildcard a -> a
forall m. Monoid m => Wildcard m -> m
forall a. Wildcard a -> Bool
forall a. Wildcard a -> Int
forall a. Wildcard a -> [a]
forall a. (a -> a -> a) -> Wildcard a -> a
forall m a. Monoid m => (a -> m) -> Wildcard a -> m
forall b a. (b -> a -> b) -> b -> Wildcard a -> b
forall a b. (a -> b -> b) -> b -> Wildcard a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Wildcard a -> a
$cproduct :: forall a. Num a => Wildcard a -> a
sum :: forall a. Num a => Wildcard a -> a
$csum :: forall a. Num a => Wildcard a -> a
minimum :: forall a. Ord a => Wildcard a -> a
$cminimum :: forall a. Ord a => Wildcard a -> a
maximum :: forall a. Ord a => Wildcard a -> a
$cmaximum :: forall a. Ord a => Wildcard a -> a
elem :: forall a. Eq a => a -> Wildcard a -> Bool
$celem :: forall a. Eq a => a -> Wildcard a -> Bool
length :: forall a. Wildcard a -> Int
$clength :: forall a. Wildcard a -> Int
null :: forall a. Wildcard a -> Bool
$cnull :: forall a. Wildcard a -> Bool
toList :: forall a. Wildcard a -> [a]
$ctoList :: forall a. Wildcard a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Wildcard a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Wildcard a -> a
foldr1 :: forall a. (a -> a -> a) -> Wildcard a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Wildcard a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Wildcard a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Wildcard a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Wildcard a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Wildcard a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Wildcard a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Wildcard a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Wildcard a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Wildcard a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Wildcard a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Wildcard a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Wildcard a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Wildcard a -> m
fold :: forall m. Monoid m => Wildcard m -> m
$cfold :: forall m. Monoid m => Wildcard m -> m
F.Foldable)
wildcardMatch :: (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 a -> b -> Maybe c
eq (Literal [a]
mid) [b]
x = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c. (a -> b -> Maybe c) -> [a] -> [b] -> Maybe [c]
eqListBy a -> b -> Maybe c
eq [a]
mid [b]
x
wildcardMatch a -> b -> Maybe c
eq (Wildcard [a]
pre [[a]]
mid [a]
post) [b]
x = do
([c]
pre, [b]
x) <- forall a b c. (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([c], [b])
stripPrefixBy a -> b -> Maybe c
eq [a]
pre [b]
x
([b]
x, [c]
post) <- forall a b c. (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([b], [c])
stripSuffixBy a -> b -> Maybe c
eq [a]
post [b]
x
[Either [c] [b]]
mid <- [[a]] -> [b] -> Maybe [Either [c] [b]]
stripInfixes [[a]]
mid [b]
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [forall a b. a -> Either a b
Left [c]
pre] forall a. [a] -> [a] -> [a]
++ [Either [c] [b]]
mid forall a. [a] -> [a] -> [a]
++ [forall a b. a -> Either a b
Left [c]
post]
where
stripInfixes :: [[a]] -> [b] -> Maybe [Either [c] [b]]
stripInfixes [] [b]
x = forall a. a -> Maybe a
Just [forall a b. b -> Either a b
Right [b]
x]
stripInfixes ([a]
m:[[a]]
ms) [b]
y = do
([b]
a,[c]
b,[b]
x) <- forall a b c.
(a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([b], [c], [b])
stripInfixBy a -> b -> Maybe c
eq [a]
m [b]
y
(\[Either [c] [b]]
c -> forall a b. b -> Either a b
Right [b]
aforall a. a -> [a] -> [a]
:forall a b. a -> Either a b
Left [c]
bforall a. a -> [a] -> [a]
:[Either [c] [b]]
c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[a]] -> [b] -> Maybe [Either [c] [b]]
stripInfixes [[a]]
ms [b]
x
wildcardSubst :: Applicative m => m b -> (a -> m b) -> Wildcard a -> m [b]
wildcardSubst :: forall (m :: * -> *) b a.
Applicative m =>
m b -> (a -> m b) -> Wildcard a -> m [b]
wildcardSubst m b
gap a -> m b
lit (Literal a
x) = (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
lit a
x
wildcardSubst m b
gap a -> m b
lit (Wildcard a
pre [a]
mid a
post) = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
a -> m b
lit a
pre forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\a
v -> (\b
a b
b -> [b
a,b
b]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
gap forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> m b
lit a
v) ([a]
mid forall a. [a] -> [a] -> [a]
++ [a
post]))
wildcardArity :: Wildcard a -> Int
wildcardArity :: forall a. Wildcard a -> Int
wildcardArity (Literal a
_) = Int
0
wildcardArity (Wildcard a
_ [a]
xs a
_) = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Num a => a -> a -> a
+ Int
1