    -- | The type of patterns and wildcards, and operations working on parsed versions.
    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

    -- | A type synonym for file patterns, containing @**@ and @*@. For the syntax
    --   and semantics of 'FilePattern' see 'System.FilePattern.?=='.
    --
    --   Most 'FilePath' values lacking literal @.@ and @..@ components are suitable as 'FilePattern' values which match
    --   only that specific file. On Windows @\\@ is treated as equivalent to @\/@.
    --
    --   You can write 'FilePattern' values as a literal string, or build them
    --   up using the operators '<.>' and '</>' (but be aware that @\"\" '</>' \"foo\"@ produces @\"./foo\"@).
    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)

    -- [Note: Split on ""]
    --
    -- For parsing patterns and paths, "" can either be [] or [""].
    -- Assuming they are consistent, the only cases that are relevant are:
    --
    -- > match "" "" = Just []
    -- > match "*" "" = if [] then Nothing else Just [""]
    -- > match "**" "" = if [] then Just [] else Just [""]
    --
    -- We pick "" splits as [""] because that is slightly more permissive,
    -- follows the builtin semantics of split, and matches the 'filepath'
    -- library slightly better.

    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

    -- [Note: Conversion of parts to String]
    --
    -- The match of * is String, but the match for ** is really [String].
    -- To simplify the API, since everything else is String encoding [String],
    -- we want to convert that [String] to String. We considered 3 solutions.
    --
    -- 1) Since we know the elements of [String] don't contain /, a natural
    -- solution is to insert / characters between items with intercalate, but that
    -- doesn't work because [] and [""] end up with the same representation, but
    -- are very different, e.g.
    --
    -- > match "**/a" "a"  = Just []
    -- > match "**/a" "/a" = Just [""]
    --
    -- 2) We can join with "/" after every component, so ["a","b"] becomes
    -- "a/b/". But that causes / characters to appear from nowhere, e.g.
    --
    -- > match "**" "a" = Just ["a/"]
    --
    -- 3) Logically, the only sensible encoding for [] must be "". Because [""]
    -- can't be "" (would clash), it must be "/". Therefore we follow solution 2 normally,
    -- but switch to solution 1 iff all the components are empty.
    -- We implement this scheme with mkParts/fromParts.
    --
    -- Even after all that, we still have weird corner cases like:
    --
    -- > match "**" "/" = Just ["//"]
    --
    -- But the only realistic path it applies to is /, which should be pretty rare.

    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)