{-# LANGUAGE DeriveFunctor, DeriveFoldable #-}

-- | The type of wildcards, which generalises to both patterns
--   inside a filename and along patterns. e.g.
--
-- > *xy* = Wildcard [] ["xy"] []
-- > **/xxx/yyy/** = Wildcard [] [[Literal "xxx", Literal "yyy"]] []
--
--   Some more examples focusing on the first type of pattern:
--
-- > xyz = Literal "xyz"
-- > x*y*z = Wildcard "x" ["y"] ["z"]
-- > x**z = Wildcard "x" [""] ["z"]
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 :: a -> a -> Maybe ()
equals a
x a
y = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing


-- | Representing either literals, or wildcards
data Wildcard a = Wildcard a [a] a -- ^ prefix [mid-parts] suffix
                | Literal a -- ^ literal match
    deriving (Int -> Wildcard a -> ShowS
[Wildcard a] -> ShowS
Wildcard a -> String
(Int -> Wildcard a -> ShowS)
-> (Wildcard a -> String)
-> ([Wildcard a] -> ShowS)
-> Show (Wildcard a)
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
(Wildcard a -> Wildcard a -> Bool)
-> (Wildcard a -> Wildcard a -> Bool) -> Eq (Wildcard a)
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,Eq (Wildcard a)
Eq (Wildcard a)
-> (Wildcard a -> Wildcard a -> Ordering)
-> (Wildcard a -> Wildcard a -> Bool)
-> (Wildcard a -> Wildcard a -> Bool)
-> (Wildcard a -> Wildcard a -> Bool)
-> (Wildcard a -> Wildcard a -> Bool)
-> (Wildcard a -> Wildcard a -> Wildcard a)
-> (Wildcard a -> Wildcard a -> Wildcard a)
-> Ord (Wildcard a)
Wildcard a -> Wildcard a -> Bool
Wildcard a -> Wildcard a -> Ordering
Wildcard a -> Wildcard a -> Wildcard a
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
$cp1Ord :: forall a. Ord a => Eq (Wildcard a)
Ord,a -> Wildcard b -> Wildcard a
(a -> b) -> Wildcard a -> Wildcard b
(forall a b. (a -> b) -> Wildcard a -> Wildcard b)
-> (forall a b. a -> Wildcard b -> Wildcard a) -> Functor Wildcard
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
<$ :: a -> Wildcard b -> Wildcard a
$c<$ :: forall a b. a -> Wildcard b -> Wildcard a
fmap :: (a -> b) -> Wildcard a -> Wildcard b
$cfmap :: forall a b. (a -> b) -> Wildcard a -> Wildcard b
Functor,Wildcard a -> Bool
(a -> m) -> Wildcard a -> m
(a -> b -> b) -> b -> Wildcard a -> b
(forall m. Monoid m => Wildcard m -> m)
-> (forall m a. Monoid m => (a -> m) -> Wildcard a -> m)
-> (forall m a. Monoid m => (a -> m) -> Wildcard a -> m)
-> (forall a b. (a -> b -> b) -> b -> Wildcard a -> b)
-> (forall a b. (a -> b -> b) -> b -> Wildcard a -> b)
-> (forall b a. (b -> a -> b) -> b -> Wildcard a -> b)
-> (forall b a. (b -> a -> b) -> b -> Wildcard a -> b)
-> (forall a. (a -> a -> a) -> Wildcard a -> a)
-> (forall a. (a -> a -> a) -> Wildcard a -> a)
-> (forall a. Wildcard a -> [a])
-> (forall a. Wildcard a -> Bool)
-> (forall a. Wildcard a -> Int)
-> (forall a. Eq a => a -> Wildcard a -> Bool)
-> (forall a. Ord a => Wildcard a -> a)
-> (forall a. Ord a => Wildcard a -> a)
-> (forall a. Num a => Wildcard a -> a)
-> (forall a. Num a => Wildcard a -> a)
-> Foldable Wildcard
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 :: Wildcard a -> a
$cproduct :: forall a. Num a => Wildcard a -> a
sum :: Wildcard a -> a
$csum :: forall a. Num a => Wildcard a -> a
minimum :: Wildcard a -> a
$cminimum :: forall a. Ord a => Wildcard a -> a
maximum :: Wildcard a -> a
$cmaximum :: forall a. Ord a => Wildcard a -> a
elem :: a -> Wildcard a -> Bool
$celem :: forall a. Eq a => a -> Wildcard a -> Bool
length :: Wildcard a -> Int
$clength :: forall a. Wildcard a -> Int
null :: Wildcard a -> Bool
$cnull :: forall a. Wildcard a -> Bool
toList :: Wildcard a -> [a]
$ctoList :: forall a. Wildcard a -> [a]
foldl1 :: (a -> a -> a) -> Wildcard a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Wildcard a -> a
foldr1 :: (a -> a -> a) -> Wildcard a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Wildcard a -> a
foldl' :: (b -> a -> b) -> b -> Wildcard a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Wildcard a -> b
foldl :: (b -> a -> b) -> b -> Wildcard a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Wildcard a -> b
foldr' :: (a -> b -> b) -> b -> Wildcard a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Wildcard a -> b
foldr :: (a -> b -> b) -> b -> Wildcard a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Wildcard a -> b
foldMap' :: (a -> m) -> Wildcard a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Wildcard a -> m
foldMap :: (a -> m) -> Wildcard a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Wildcard a -> m
fold :: Wildcard m -> m
$cfold :: forall m. Monoid m => Wildcard m -> m
F.Foldable)

-- | Given a wildcard, and a test string, return the matches.
--   Only return the first (all patterns left-most) valid star matching.
wildcardMatch :: (a -> b -> Maybe c) -> Wildcard [a] -> [b] -> Maybe [Either [c] [b]]
wildcardMatch :: (a -> b -> Maybe c)
-> Wildcard [a] -> [b] -> Maybe [Either [c] [b]]
wildcardMatch a -> b -> Maybe c
eq (Literal [a]
mid) [b]
x = (Either [c] [b] -> [Either [c] [b]] -> [Either [c] [b]]
forall a. a -> [a] -> [a]
:[]) (Either [c] [b] -> [Either [c] [b]])
-> ([c] -> Either [c] [b]) -> [c] -> [Either [c] [b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [c] -> Either [c] [b]
forall a b. a -> Either a b
Left ([c] -> [Either [c] [b]]) -> Maybe [c] -> Maybe [Either [c] [b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> b -> Maybe c) -> [a] -> [b] -> Maybe [c]
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) <- (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([c], [b])
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) <- (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([b], [c])
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
    [Either [c] [b]] -> Maybe [Either [c] [b]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either [c] [b]] -> Maybe [Either [c] [b]])
-> [Either [c] [b]] -> Maybe [Either [c] [b]]
forall a b. (a -> b) -> a -> b
$ [[c] -> Either [c] [b]
forall a b. a -> Either a b
Left [c]
pre] [Either [c] [b]] -> [Either [c] [b]] -> [Either [c] [b]]
forall a. [a] -> [a] -> [a]
++ [Either [c] [b]]
mid [Either [c] [b]] -> [Either [c] [b]] -> [Either [c] [b]]
forall a. [a] -> [a] -> [a]
++ [[c] -> Either [c] [b]
forall a b. a -> Either a b
Left [c]
post]
    where
        stripInfixes :: [[a]] -> [b] -> Maybe [Either [c] [b]]
stripInfixes [] [b]
x = [Either [c] [b]] -> Maybe [Either [c] [b]]
forall a. a -> Maybe a
Just [[b] -> Either [c] [b]
forall a b. b -> Either a b
Right [b]
x]
        stripInfixes ([a]
m:[[a]]
ms) [b]
y = do
            ([b]
a,[c]
b,[b]
x) <- (a -> b -> Maybe c) -> [a] -> [b] -> Maybe ([b], [c], [b])
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 -> [b] -> Either [c] [b]
forall a b. b -> Either a b
Right [b]
aEither [c] [b] -> [Either [c] [b]] -> [Either [c] [b]]
forall a. a -> [a] -> [a]
:[c] -> Either [c] [b]
forall a b. a -> Either a b
Left [c]
bEither [c] [b] -> [Either [c] [b]] -> [Either [c] [b]]
forall a. a -> [a] -> [a]
:[Either [c] [b]]
c) ([Either [c] [b]] -> [Either [c] [b]])
-> Maybe [Either [c] [b]] -> Maybe [Either [c] [b]]
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 :: m b -> (a -> m b) -> Wildcard a -> m [b]
wildcardSubst m b
gap a -> m b
lit (Literal a
x) = (b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[]) (b -> [b]) -> m b -> m [b]
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) = (:) (b -> [b] -> [b]) -> m b -> m ([b] -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    a -> m b
lit a
pre m ([b] -> [b]) -> m [b] -> m [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    ([[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[b]] -> [b]) -> m [[b]] -> m [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m [b]) -> [a] -> m [[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]) (b -> b -> [b]) -> m b -> m (b -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
gap m (b -> [b]) -> m b -> m [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> m b
lit a
v) ([a]
mid [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
post]))


wildcardArity :: Wildcard a -> Int
wildcardArity :: Wildcard a -> Int
wildcardArity (Literal a
_) = Int
0
wildcardArity (Wildcard a
_ [a]
xs a
_) = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1