    {-# 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 :: forall a. Eq a => 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
    $cshowsPrec :: forall a. Show a => Int -> Wildcard a -> ShowS
    showsPrec :: Int -> Wildcard a -> ShowS
    $cshow :: forall a. Show a => Wildcard a -> String
    show :: Wildcard a -> String
    $cshowList :: forall a. Show a => [Wildcard a] -> ShowS
    showList :: [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
    $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
    /= :: 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
    $ccompare :: forall a. Ord a => Wildcard a -> Wildcard a -> Ordering
    compare :: Wildcard a -> Wildcard a -> Ordering
    $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
    >= :: Wildcard a -> Wildcard a -> Bool
    $cmax :: forall a. Ord a => Wildcard a -> Wildcard a -> Wildcard a
    max :: Wildcard a -> Wildcard a -> Wildcard a
    $cmin :: forall a. Ord a => Wildcard a -> Wildcard a -> Wildcard a
    min :: Wildcard a -> Wildcard a -> Wildcard a
    Ord,(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
    $cfmap :: forall a b. (a -> b) -> Wildcard a -> Wildcard b
    fmap :: forall a b. (a -> b) -> Wildcard a -> Wildcard b
    $c<$ :: forall a b. a -> Wildcard b -> Wildcard a
    <$ :: forall a b. a -> Wildcard b -> Wildcard a
    Functor,(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
    $cfold :: forall m. Monoid m => Wildcard m -> m
    fold :: forall m. Monoid m => Wildcard m -> 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
    foldMap' :: forall m a. Monoid m => (a -> m) -> Wildcard a -> m
    $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
    foldr' :: forall a b. (a -> b -> 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
    foldl' :: forall b a. (b -> a -> b) -> b -> Wildcard a -> b
    $cfoldr1 :: forall a. (a -> a -> a) -> Wildcard a -> a
    foldr1 :: forall a. (a -> a -> a) -> Wildcard a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> Wildcard a -> a
    foldl1 :: forall a. (a -> a -> a) -> Wildcard a -> a
    $ctoList :: forall a. Wildcard a -> [a]
    toList :: forall a. Wildcard a -> [a]
    $cnull :: forall a. Wildcard a -> Bool
    null :: forall a. Wildcard a -> Bool
    $clength :: forall a. Wildcard a -> Int
    length :: forall a. Wildcard a -> Int
    $celem :: forall a. Eq a => a -> Wildcard a -> Bool
    elem :: forall a. Eq a => a -> Wildcard a -> Bool
    $cmaximum :: forall a. Ord a => Wildcard a -> a
    maximum :: forall a. Ord a => Wildcard a -> a
    $cminimum :: forall a. Ord a => Wildcard a -> a
    minimum :: forall a. Ord a => Wildcard a -> a
    $csum :: forall a. Num a => Wildcard a -> a
    sum :: forall a. Num a => Wildcard a -> a
    $cproduct :: forall a. Num a => Wildcard a -> a
    product :: forall a. Num a => Wildcard a -> a
    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 :: 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 = (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
        (pre, 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
        (x, post) <- stripSuffixBy eq post x
        mid <- stripInfixes mid x
        pure $ [Left pre] ++ mid ++ [Left 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
                (a,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) <$> stripInfixes ms 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) = (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 a b. m (a -> b) -> m a -> 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)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [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 a b. m (a -> b) -> m a -> 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 :: forall a. Wildcard a -> Int
    wildcardArity (Literal a
    _) = Int
    0
    wildcardArity (Wildcard a
    _ [a]
    xs a
    _) = [a] -> Int
    forall 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