    {-# LANGUAGE ViewPatterns, DeriveFunctor, BangPatterns, TupleSections, RecordWildCards #-}

    -- | Applying a set of paths vs a set of patterns efficiently
    module System.FilePattern.Step(
        step, step_, Step(..), StepNext(..)
        ) where

    import System.FilePattern.Core
    import System.FilePattern.Tree
    import System.FilePattern.Wildcard

    import Control.Monad.Extra
    import Data.List.Extra
    import Data.Semigroup
    import Data.Tuple.Extra
    import Data.Functor
    import Data.Either
    import qualified Data.List.NonEmpty as NE
    import Prelude

    -- | What we know about the next step values.
    data StepNext
        =
          -- | All components not listed will result in dull 'Step' values from 'stepApply',
          --   with 'stepNext' being @'StepOnly' []@ and 'stepDone' being @[]@. The field is a set - their order
          --   is irrelevant but there will be no duplicates in values arising from 'step'.
          StepOnly [String]
        | -- | All calls to 'stepApply' will return 'stepNext' being 'StepEverything' with a non-empty 'stepDone'.
          StepEverything
        | -- | We have no additional information about the output from 'stepApply'.
          StepUnknown
          deriving (StepNext -> StepNext -> Bool
    (StepNext -> StepNext -> Bool)
    -> (StepNext -> StepNext -> Bool) -> Eq StepNext
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: StepNext -> StepNext -> Bool
    == :: StepNext -> StepNext -> Bool
    $c/= :: StepNext -> StepNext -> Bool
    /= :: StepNext -> StepNext -> Bool
    Eq,Eq StepNext
    Eq StepNext =>
    (StepNext -> StepNext -> Ordering)
    -> (StepNext -> StepNext -> Bool)
    -> (StepNext -> StepNext -> Bool)
    -> (StepNext -> StepNext -> Bool)
    -> (StepNext -> StepNext -> Bool)
    -> (StepNext -> StepNext -> StepNext)
    -> (StepNext -> StepNext -> StepNext)
    -> Ord StepNext
    StepNext -> StepNext -> Bool
    StepNext -> StepNext -> Ordering
    StepNext -> StepNext -> StepNext
    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 :: StepNext -> StepNext -> Ordering
    compare :: StepNext -> StepNext -> Ordering
    $c< :: StepNext -> StepNext -> Bool
    < :: StepNext -> StepNext -> Bool
    $c<= :: StepNext -> StepNext -> Bool
    <= :: StepNext -> StepNext -> Bool
    $c> :: StepNext -> StepNext -> Bool
    > :: StepNext -> StepNext -> Bool
    $c>= :: StepNext -> StepNext -> Bool
    >= :: StepNext -> StepNext -> Bool
    $cmax :: StepNext -> StepNext -> StepNext
    max :: StepNext -> StepNext -> StepNext
    $cmin :: StepNext -> StepNext -> StepNext
    min :: StepNext -> StepNext -> StepNext
    Ord,Int -> StepNext -> ShowS
    [StepNext] -> ShowS
    StepNext -> String
    (Int -> StepNext -> ShowS)
    -> (StepNext -> String) -> ([StepNext] -> ShowS) -> Show StepNext
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> StepNext -> ShowS
    showsPrec :: Int -> StepNext -> ShowS
    $cshow :: StepNext -> String
    show :: StepNext -> String
    $cshowList :: [StepNext] -> ShowS
    showList :: [StepNext] -> ShowS
    Show)

    mergeStepNext :: [StepNext] -> StepNext
    mergeStepNext :: [StepNext] -> StepNext
    mergeStepNext = ([String] -> [String]) -> [StepNext] -> StepNext
    f [String] -> [String]
    forall a. a -> a
    id
        where
            f :: ([String] -> [String]) -> [StepNext] -> StepNext
    f [String] -> [String]
    rest [] = [String] -> StepNext
    StepOnly ([String] -> StepNext) -> [String] -> StepNext
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    rest []
            f [String] -> [String]
    rest (StepNext
    StepUnknown:[StepNext]
    xs) = if StepNext
    StepEverything StepNext -> [StepNext] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [StepNext]
    xs then StepNext
    StepEverything else StepNext
    StepUnknown
            f [String] -> [String]
    rest (StepNext
    StepEverything:[StepNext]
    xs) = StepNext
    StepEverything
            f [String] -> [String]
    rest (StepOnly [String]
    x:[StepNext]
    xs) = ([String] -> [String]) -> [StepNext] -> StepNext
    f ([String] -> [String]
    rest ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([String]
    x [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++)) [StepNext]
    xs

    normaliseStepNext :: StepNext -> StepNext
    normaliseStepNext :: StepNext -> StepNext
    normaliseStepNext (StepOnly [String]
    xs) = [String] -> StepNext
    StepOnly ([String] -> StepNext) -> [String] -> StepNext
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    forall a. Ord a => [a] -> [a]
    nubOrd [String]
    xs
    normaliseStepNext StepNext
    x = StepNext
    x

    instance Semigroup StepNext where
        StepNext
    a <> :: StepNext -> StepNext -> StepNext
    <> StepNext
    b = NonEmpty StepNext -> StepNext
    forall a. Semigroup a => NonEmpty a -> a
    sconcat (NonEmpty StepNext -> StepNext) -> NonEmpty StepNext -> StepNext
    forall a b. (a -> b) -> a -> b
    $ [StepNext] -> NonEmpty StepNext
    forall a. HasCallStack => [a] -> NonEmpty a
    NE.fromList [StepNext
    a,StepNext
    b]
        sconcat :: NonEmpty StepNext -> StepNext
    sconcat = StepNext -> StepNext
    normaliseStepNext (StepNext -> StepNext)
    -> (NonEmpty StepNext -> StepNext) -> NonEmpty StepNext -> StepNext
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [StepNext] -> StepNext
    mergeStepNext ([StepNext] -> StepNext)
    -> (NonEmpty StepNext -> [StepNext])
    -> NonEmpty StepNext
    -> StepNext
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty StepNext -> [StepNext]
    forall a. NonEmpty a -> [a]
    NE.toList

    instance Monoid StepNext where
        mempty :: StepNext
    mempty = [String] -> StepNext
    StepOnly []
        mappend :: StepNext -> StepNext -> StepNext
    mappend = StepNext -> StepNext -> StepNext
    forall a. Semigroup a => a -> a -> a
    (<>)
        mconcat :: [StepNext] -> StepNext
    mconcat = StepNext
    -> (NonEmpty StepNext -> StepNext)
    -> Maybe (NonEmpty StepNext)
    -> StepNext
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe StepNext
    forall a. Monoid a => a
    mempty NonEmpty StepNext -> StepNext
    forall a. Semigroup a => NonEmpty a -> a
    sconcat (Maybe (NonEmpty StepNext) -> StepNext)
    -> ([StepNext] -> Maybe (NonEmpty StepNext))
    -> [StepNext]
    -> StepNext
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [StepNext] -> Maybe (NonEmpty StepNext)
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty -- important: use the fast sconcat

    -- | The result of 'step', used to process successive path components of a set of 'FilePath's.
    data Step a = Step
        {forall a. Step a -> [(a, [String])]
    stepDone :: [(a, [String])]
            -- ^ The files that match at this step. Includes the list that would have been produced by 'System.FilePattern.match',
            --   along with the values passed to 'step'. These results are not necessarily in order.
        ,forall a. Step a -> StepNext
    stepNext :: StepNext
            -- ^ Information about the results of calling 'stepApply'. See 'StepNext' for details.
        ,forall a. Step a -> String -> Step a
    stepApply :: String -> Step a
            -- ^ Apply one component from a 'FilePath' to get a new 'Step'.
        }
        deriving (forall a b. (a -> b) -> Step a -> Step b)
    -> (forall a b. a -> Step b -> Step a) -> Functor Step
    forall a b. a -> Step b -> Step a
    forall a b. (a -> b) -> Step a -> Step 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) -> Step a -> Step b
    fmap :: forall a b. (a -> b) -> Step a -> Step b
    $c<$ :: forall a b. a -> Step b -> Step a
    <$ :: forall a b. a -> Step b -> Step a
    Functor

    mergeStep :: (StepNext -> StepNext) -> [Step a] -> Step a
    mergeStep :: forall a. (StepNext -> StepNext) -> [Step a] -> Step a
    mergeStep StepNext -> StepNext
    f [] = Step a
    forall a. Monoid a => a
    mempty
    mergeStep StepNext -> StepNext
    f [Step a
    x] = Step a
    x
    mergeStep StepNext -> StepNext
    f [Step a]
    xs = Step
        {stepDone :: [(a, [String])]
    stepDone = (Step a -> [(a, [String])]) -> [Step a] -> [(a, [String])]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Step a -> [(a, [String])]
    forall a. Step a -> [(a, [String])]
    stepDone [Step a]
    xs
        ,stepNext :: StepNext
    stepNext = StepNext -> StepNext
    f (StepNext -> StepNext) -> StepNext -> StepNext
    forall a b. (a -> b) -> a -> b
    $ [StepNext] -> StepNext
    mergeStepNext ([StepNext] -> StepNext) -> [StepNext] -> StepNext
    forall a b. (a -> b) -> a -> b
    $ (Step a -> StepNext) -> [Step a] -> [StepNext]
    forall a b. (a -> b) -> [a] -> [b]
    map Step a -> StepNext
    forall a. Step a -> StepNext
    stepNext [Step a]
    xs
        ,stepApply :: String -> Step a
    stepApply = \String
    x -> (StepNext -> StepNext) -> [Step a] -> Step a
    forall a. (StepNext -> StepNext) -> [Step a] -> Step a
    mergeStep StepNext -> StepNext
    f ([Step a] -> Step a) -> [Step a] -> Step a
    forall a b. (a -> b) -> a -> b
    $ (Step a -> Step a) -> [Step a] -> [Step a]
    forall a b. (a -> b) -> [a] -> [b]
    map (Step a -> String -> Step a
    forall a. Step a -> String -> Step a
    `stepApply` String
    x) [Step a]
    xs
        }

    instance Semigroup (Step a) where
        Step a
    a <> :: Step a -> Step a -> Step a
    <> Step a
    b = NonEmpty (Step a) -> Step a
    forall a. Semigroup a => NonEmpty a -> a
    sconcat (NonEmpty (Step a) -> Step a) -> NonEmpty (Step a) -> Step a
    forall a b. (a -> b) -> a -> b
    $ [Step a] -> NonEmpty (Step a)
    forall a. HasCallStack => [a] -> NonEmpty a
    NE.fromList [Step a
    a,Step a
    b]
        sconcat :: NonEmpty (Step a) -> Step a
    sconcat (NonEmpty (Step a) -> [Step a]
    forall a. NonEmpty a -> [a]
    NE.toList -> [Step a]
    ss)
            | [Step a
    s] <- [Step a]
    ss = Step a
    s
            | Bool
    otherwise = Step
                {stepDone :: [(a, [String])]
    stepDone = (Step a -> [(a, [String])]) -> [Step a] -> [(a, [String])]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Step a -> [(a, [String])]
    forall a. Step a -> [(a, [String])]
    stepDone [Step a]
    ss
                ,stepNext :: StepNext
    stepNext = (Step a -> StepNext) -> [Step a] -> StepNext
    forall b a. Monoid b => (a -> b) -> [a] -> b
    mconcatMap Step a -> StepNext
    forall a. Step a -> StepNext
    stepNext [Step a]
    ss
                ,stepApply :: String -> Step a
    stepApply = \String
    x -> (Step a -> Step a) -> [Step a] -> Step a
    forall b a. Monoid b => (a -> b) -> [a] -> b
    fastFoldMap (Step a -> String -> Step a
    forall a. Step a -> String -> Step a
    `stepApply` String
    x) [Step a]
    ss
                }

    instance Monoid (Step a) where
        mempty :: Step a
    mempty = [(a, [String])] -> StepNext -> (String -> Step a) -> Step a
    forall a.
    [(a, [String])] -> StepNext -> (String -> Step a) -> Step a
    Step [] StepNext
    forall a. Monoid a => a
    mempty ((String -> Step a) -> Step a) -> (String -> Step a) -> Step a
    forall a b. (a -> b) -> a -> b
    $ Step a -> String -> Step a
    forall a b. a -> b -> a
    const Step a
    forall a. Monoid a => a
    mempty
        mappend :: Step a -> Step a -> Step a
    mappend = Step a -> Step a -> Step a
    forall a. Semigroup a => a -> a -> a
    (<>)
        mconcat :: [Step a] -> Step a
    mconcat = Step a
    -> (NonEmpty (Step a) -> Step a)
    -> Maybe (NonEmpty (Step a))
    -> Step a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Step a
    forall a. Monoid a => a
    mempty NonEmpty (Step a) -> Step a
    forall a. Semigroup a => NonEmpty a -> a
    sconcat (Maybe (NonEmpty (Step a)) -> Step a)
    -> ([Step a] -> Maybe (NonEmpty (Step a))) -> [Step a] -> Step a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Step a] -> Maybe (NonEmpty (Step a))
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty -- important: use the fast sconcat

    fastFoldMap :: Monoid m => (a -> m) -> [a] -> m
    {- HLINT ignore fastFoldMap -}
    fastFoldMap :: forall b a. Monoid b => (a -> b) -> [a] -> b
    fastFoldMap a -> m
    f = [m] -> m
    forall a. Monoid a => [a] -> a
    mconcat ([m] -> m) -> ([a] -> [m]) -> [a] -> m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> m) -> [a] -> [m]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> m
    f -- important: use the fast mconcat

    -- Invariant: No two adjacent Lits
    -- Invariant: No empty Lits
    data Pat = Lits [Wildcard String]
             | StarStar
             | End
               deriving (Int -> Pat -> ShowS
    [Pat] -> ShowS
    Pat -> String
    (Int -> Pat -> ShowS)
    -> (Pat -> String) -> ([Pat] -> ShowS) -> Show Pat
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Pat -> ShowS
    showsPrec :: Int -> Pat -> ShowS
    $cshow :: Pat -> String
    show :: Pat -> String
    $cshowList :: [Pat] -> ShowS
    showList :: [Pat] -> ShowS
    Show,Pat -> Pat -> Bool
    (Pat -> Pat -> Bool) -> (Pat -> Pat -> Bool) -> Eq Pat
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Pat -> Pat -> Bool
    == :: Pat -> Pat -> Bool
    $c/= :: Pat -> Pat -> Bool
    /= :: Pat -> Pat -> Bool
    Eq,Eq Pat
    Eq Pat =>
    (Pat -> Pat -> Ordering)
    -> (Pat -> Pat -> Bool)
    -> (Pat -> Pat -> Bool)
    -> (Pat -> Pat -> Bool)
    -> (Pat -> Pat -> Bool)
    -> (Pat -> Pat -> Pat)
    -> (Pat -> Pat -> Pat)
    -> Ord Pat
    Pat -> Pat -> Bool
    Pat -> Pat -> Ordering
    Pat -> Pat -> Pat
    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 :: Pat -> Pat -> Ordering
    compare :: Pat -> Pat -> Ordering
    $c< :: Pat -> Pat -> Bool
    < :: Pat -> Pat -> Bool
    $c<= :: Pat -> Pat -> Bool
    <= :: Pat -> Pat -> Bool
    $c> :: Pat -> Pat -> Bool
    > :: Pat -> Pat -> Bool
    $c>= :: Pat -> Pat -> Bool
    >= :: Pat -> Pat -> Bool
    $cmax :: Pat -> Pat -> Pat
    max :: Pat -> Pat -> Pat
    $cmin :: Pat -> Pat -> Pat
    min :: Pat -> Pat -> Pat
    Ord)

    toPat :: Pattern -> [Pat]
    toPat :: Pattern -> [Pat]
    toPat (Pattern (Literal [Wildcard String]
    xs)) = [[Wildcard String] -> Pat
    Lits [Wildcard String]
    xs]
    toPat (Pattern (Wildcard [Wildcard String]
    pre [[Wildcard String]]
    mid [Wildcard String]
    post)) = [Pat] -> [[Pat]] -> [Pat]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Pat
    StarStar] ([[Pat]] -> [Pat]) -> [[Pat]] -> [Pat]
    forall a b. (a -> b) -> a -> b
    $ ([Wildcard String] -> [Pat]) -> [[Wildcard String]] -> [[Pat]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Wildcard String] -> [Pat]
    lit ([[Wildcard String]] -> [[Pat]]) -> [[Wildcard String]] -> [[Pat]]
    forall a b. (a -> b) -> a -> b
    $ [Wildcard String]
    pre [Wildcard String] -> [[Wildcard String]] -> [[Wildcard String]]
    forall a. a -> [a] -> [a]
    : [[Wildcard String]]
    mid [[Wildcard String]] -> [[Wildcard String]] -> [[Wildcard String]]
    forall a. [a] -> [a] -> [a]
    ++ [[Wildcard String]
    post]
        where lit :: [Wildcard String] -> [Pat]
    lit [Wildcard String]
    xs = [[Wildcard String] -> Pat
    Lits [Wildcard String]
    xs | [Wildcard String]
    xs [Wildcard String] -> [Wildcard String] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []]

    -- | Efficient matching of a set of 'FilePattern's against a set of 'FilePath's.
    --   First call 'step' passing in all the 'FilePattern's, with a tag for each one.
    --   Next call the methods of 'Step', providing the components of the 'FilePath's in turn.
    --
    --   Useful for efficient bulk searching, particularly directory scanning, where you can
    --   avoid descending into directories which cannot match.
    step :: [(a, FilePattern)] -> Step a
    step :: forall a. [(a, String)] -> Step a
    step = Step [a] -> Step a
    forall a. Step [a] -> Step a
    restore (Step [a] -> Step a)
    -> ([(a, String)] -> Step [a]) -> [(a, String)] -> Step a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((([String] -> [String]) -> Step [a])
    -> ([String] -> [String]) -> Step [a]
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    forall a. a -> a
    id) ((([String] -> [String]) -> Step [a]) -> Step [a])
    -> ([(a, String)] -> ([String] -> [String]) -> Step [a])
    -> [(a, String)]
    -> Step [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Pat] -> Tree Pat a -> ([String] -> [String]) -> Step [a]
    forall a. [Pat] -> Tree Pat a -> ([String] -> [String]) -> Step [a]
    f [] (Tree Pat a -> ([String] -> [String]) -> Step [a])
    -> ([(a, String)] -> Tree Pat a)
    -> [(a, String)]
    -> ([String] -> [String])
    -> Step [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(a, [Pat])] -> Tree Pat a
    forall k v. Ord k => [(v, [k])] -> Tree k v
    makeTree ([(a, [Pat])] -> Tree Pat a)
    -> ([(a, String)] -> [(a, [Pat])]) -> [(a, String)] -> Tree Pat a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a, String) -> (a, [Pat])) -> [(a, String)] -> [(a, [Pat])]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> [Pat]) -> (a, String) -> (a, [Pat])
    forall b b' a. (b -> b') -> (a, b) -> (a, b')
    second ((String -> [Pat]) -> (a, String) -> (a, [Pat]))
    -> (String -> [Pat]) -> (a, String) -> (a, [Pat])
    forall a b. (a -> b) -> a -> b
    $ Pattern -> [Pat]
    toPat (Pattern -> [Pat]) -> (String -> Pattern) -> String -> [Pat]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Pattern
    parsePattern)
        where
            f :: [Pat] -> Tree Pat a -> (Parts -> Step [a])
            f :: forall a. [Pat] -> Tree Pat a -> ([String] -> [String]) -> Step [a]
    f [Pat]
    seen (Tree [a]
    ends [(Pat, Tree Pat a)]
    nxts) = \[String] -> [String]
    parts -> (StepNext -> StepNext) -> [Step [a]] -> Step [a]
    forall a. (StepNext -> StepNext) -> [Step a] -> Step a
    mergeStep StepNext -> StepNext
    forall a. a -> a
    id ([Step [a]] -> Step [a]) -> [Step [a]] -> Step [a]
    forall a b. (a -> b) -> a -> b
    $ ((([String] -> [String]) -> Step [a]) -> Step [a])
    -> [([String] -> [String]) -> Step [a]] -> [Step [a]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((([String] -> [String]) -> Step [a])
    -> ([String] -> [String]) -> Step [a]
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    parts) ([([String] -> [String]) -> Step [a]] -> [Step [a]])
    -> [([String] -> [String]) -> Step [a]] -> [Step [a]]
    forall a b. (a -> b) -> a -> b
    $ [([String] -> [String]) -> Step [a]]
    sEnds [([String] -> [String]) -> Step [a]]
    -> [([String] -> [String]) -> Step [a]]
    -> [([String] -> [String]) -> Step [a]]
    forall a. [a] -> [a] -> [a]
    ++ [([String] -> [String]) -> Step [a]]
    sNxts
                where
                    sEnds :: [([String] -> [String]) -> Step [a]]
    sEnds = case [a]
    -> [Pat]
    -> Maybe
         ([Pat],
          (([String] -> [String]) -> Step [a])
          -> ([String] -> [String]) -> Step [a])
    forall a.
    a
    -> [Pat]
    -> Maybe
         ([Pat],
          (([String] -> [String]) -> Step a)
          -> ([String] -> [String]) -> Step a)
    unroll [a]
    ends ([Pat]
    seen [Pat] -> [Pat] -> [Pat]
    forall a. [a] -> [a] -> [a]
    ++ [Pat
    End]) of
                        Maybe
      ([Pat],
       (([String] -> [String]) -> Step [a])
       -> ([String] -> [String]) -> Step [a])
    _ | [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    ends -> []
                        Just ([], (([String] -> [String]) -> Step [a])
    -> ([String] -> [String]) -> Step [a]
    c) -> [(([String] -> [String]) -> Step [a])
    -> ([String] -> [String]) -> Step [a]
    c (String -> ([String] -> [String]) -> Step [a]
    forall a. HasCallStack => String -> a
    error String
    "step invariant violated (1)")]
                        Maybe
      ([Pat],
       (([String] -> [String]) -> Step [a])
       -> ([String] -> [String]) -> Step [a])
    _ -> String -> [([String] -> [String]) -> Step [a]]
    forall a. HasCallStack => String -> a
    error (String -> [([String] -> [String]) -> Step [a]])
    -> String -> [([String] -> [String]) -> Step [a]]
    forall a b. (a -> b) -> a -> b
    $ String
    "step invariant violated (2), " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Pat] -> String
    forall a. Show a => a -> String
    show [Pat]
    seen

                    sNxts :: [([String] -> [String]) -> Step [a]]
    sNxts = (((Pat, Tree Pat a) -> ([String] -> [String]) -> Step [a])
     -> [(Pat, Tree Pat a)] -> [([String] -> [String]) -> Step [a]])
    -> [(Pat, Tree Pat a)]
    -> ((Pat, Tree Pat a) -> ([String] -> [String]) -> Step [a])
    -> [([String] -> [String]) -> Step [a]]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((Pat, Tree Pat a) -> ([String] -> [String]) -> Step [a])
    -> [(Pat, Tree Pat a)] -> [([String] -> [String]) -> Step [a]]
    forall a b. (a -> b) -> [a] -> [b]
    map [(Pat, Tree Pat a)]
    nxts (((Pat, Tree Pat a) -> ([String] -> [String]) -> Step [a])
     -> [([String] -> [String]) -> Step [a]])
    -> ((Pat, Tree Pat a) -> ([String] -> [String]) -> Step [a])
    -> [([String] -> [String]) -> Step [a]]
    forall a b. (a -> b) -> a -> b
    $ \(Pat
    p,Tree Pat a
    ps) ->
                        let seen2 :: [Pat]
    seen2 = [Pat]
    seen [Pat] -> [Pat] -> [Pat]
    forall a. [a] -> [a] -> [a]
    ++ [Pat
    p] in
                        case [a]
    -> [Pat]
    -> Maybe
         ([Pat],
          (([String] -> [String]) -> Step [a])
          -> ([String] -> [String]) -> Step [a])
    forall a.
    a
    -> [Pat]
    -> Maybe
         ([Pat],
          (([String] -> [String]) -> Step a)
          -> ([String] -> [String]) -> Step a)
    unroll (String -> [a]
    forall a. HasCallStack => String -> a
    error String
    "step invariant violated (3)") [Pat]
    seen2 of
                            Maybe
      ([Pat],
       (([String] -> [String]) -> Step [a])
       -> ([String] -> [String]) -> Step [a])
    Nothing -> [Pat] -> Tree Pat a -> ([String] -> [String]) -> Step [a]
    forall a. [Pat] -> Tree Pat a -> ([String] -> [String]) -> Step [a]
    f [Pat]
    seen2 Tree Pat a
    ps
                            Just ([Pat]
    nxt, (([String] -> [String]) -> Step [a])
    -> ([String] -> [String]) -> Step [a]
    c) -> (([String] -> [String]) -> Step [a])
    -> ([String] -> [String]) -> Step [a]
    c ([Pat] -> Tree Pat a -> ([String] -> [String]) -> Step [a]
    forall a. [Pat] -> Tree Pat a -> ([String] -> [String]) -> Step [a]
    f [] (Tree Pat a -> ([String] -> [String]) -> Step [a])
    -> Tree Pat a -> ([String] -> [String]) -> Step [a]
    forall a b. (a -> b) -> a -> b
    $ [Pat] -> Tree Pat a -> Tree Pat a
    forall {k} {v}. [k] -> Tree k v -> Tree k v
    retree [Pat]
    nxt Tree Pat a
    ps)

            retree :: [k] -> Tree k v -> Tree k v
    retree [] Tree k v
    t = Tree k v
    t
            retree (k
    p:[k]
    ps) Tree k v
    t = [v] -> [(k, Tree k v)] -> Tree k v
    forall k v. [v] -> [(k, Tree k v)] -> Tree k v
    Tree [] [(k
    p, [k] -> Tree k v -> Tree k v
    retree [k]
    ps Tree k v
    t)]

            restore :: Step [a] -> Step a -- and restore the stepNext invariant
            restore :: forall a. Step [a] -> Step a
    restore Step{[([a], [String])]
    StepNext
    String -> Step [a]
    stepApply :: forall a. Step a -> String -> Step a
    stepNext :: forall a. Step a -> StepNext
    stepDone :: forall a. Step a -> [(a, [String])]
    stepDone :: [([a], [String])]
    stepNext :: StepNext
    stepApply :: String -> Step [a]
    ..} = Step
                {stepDone :: [(a, [String])]
    stepDone = [(a
    a, [String]
    b) | ([a]
    as,[String]
    b) <- [([a], [String])]
    stepDone, a
    a <- [a]
    as]
                ,stepNext :: StepNext
    stepNext = StepNext -> StepNext
    normaliseStepNext StepNext
    stepNext
                ,stepApply :: String -> Step a
    stepApply = Step [a] -> Step a
    forall a. Step [a] -> Step a
    restore (Step [a] -> Step a) -> (String -> Step [a]) -> String -> Step a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Step [a]
    stepApply
                }

    -- | Like 'step' but using @()@ as the tag for each 'FilePattern'.
    step_ :: [FilePattern] -> Step ()
    step_ :: [String] -> Step ()
    step_ = [((), String)] -> Step ()
    forall a. [(a, String)] -> Step a
    step ([((), String)] -> Step ())
    -> ([String] -> [((), String)]) -> [String] -> Step ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> ((), String)) -> [String] -> [((), String)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((),)

    match1 :: Wildcard String -> String -> Maybe [String]
    match1 :: Wildcard String -> String -> Maybe [String]
    match1 Wildcard String
    w String
    x = [Either [()] String] -> [String]
    forall a b. [Either a b] -> [b]
    rights ([Either [()] String] -> [String])
    -> Maybe [Either [()] String] -> Maybe [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Char -> Char -> Maybe ())
    -> Wildcard String -> String -> Maybe [Either [()] String]
    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 String
    w String
    x

    type Parts = [String] -> [String]

    -- Given a prefix of the pattern, if you can deal with it, return
    -- the rest of the pattern in the prefix you didn't match, and something that given
    -- a matcher for the rest of the pattern, returns a matcher for the whole pattern.
    unroll :: a -> [Pat] -> Maybe ([Pat], (Parts -> Step a) -> Parts -> Step a)
    -- normal path, dispatch on what you find next
    unroll :: forall a.
    a
    -> [Pat]
    -> Maybe
         ([Pat],
          (([String] -> [String]) -> Step a)
          -> ([String] -> [String]) -> Step a)
    unroll a
    val [Pat
    End] = ([Pat],
     (([String] -> [String]) -> Step a)
     -> ([String] -> [String]) -> Step a)
    -> Maybe
         ([Pat],
          (([String] -> [String]) -> Step a)
          -> ([String] -> [String]) -> Step a)
    forall a. a -> Maybe a
    Just ([], \([String] -> [String]) -> Step a
    _ [String] -> [String]
    parts -> Step a
    forall a. Monoid a => a
    mempty{stepDone = [(val, parts [])]})

    -- two stars in a row, the first will match nothing, the second everything
    unroll a
    val [Pat
    StarStar,Pat
    StarStar] = ([Pat],
     (([String] -> [String]) -> Step a)
     -> ([String] -> [String]) -> Step a)
    -> Maybe
         ([Pat],
          (([String] -> [String]) -> Step a)
          -> ([String] -> [String]) -> Step a)
    forall a. a -> Maybe a
    Just ([Pat
    StarStar], \([String] -> [String]) -> Step a
    cont [String] -> [String]
    parts -> ([String] -> [String]) -> Step a
    cont ([String] -> [String]
    parts ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([]String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :)))

    -- if you have literals next, match them
    unroll a
    val [Lits (Wildcard String
    l:[Wildcard String]
    ls)] = ([Pat],
     (([String] -> [String]) -> Step a)
     -> ([String] -> [String]) -> Step a)
    -> Maybe
         ([Pat],
          (([String] -> [String]) -> Step a)
          -> ([String] -> [String]) -> Step a)
    forall a. a -> Maybe a
    Just ([[Wildcard String] -> Pat
    Lits [Wildcard String]
    ls | [Wildcard String]
    ls [Wildcard String] -> [Wildcard String] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []], \([String] -> [String]) -> Step a
    cont [String] -> [String]
    parts -> Step
        {stepDone :: [(a, [String])]
    stepDone = []
        ,stepNext :: StepNext
    stepNext = case Wildcard String
    l of Literal String
    v -> [String] -> StepNext
    StepOnly [String
    v]; Wildcard{} -> StepNext
    StepUnknown
        ,stepApply :: String -> Step a
    stepApply = \String
    s -> case Wildcard String -> String -> Maybe [String]
    match1 Wildcard String
    l String
    s of
            Just [String]
    xs -> ([String] -> [String]) -> Step a
    cont ([String] -> [String]
    parts ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([String]
    xs[String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++))
            Maybe [String]
    Nothing -> Step a
    forall a. Monoid a => a
    mempty
        })

    -- if anything else is allowed, just quickly allow it
    unroll a
    val [Pat
    StarStar,Pat
    End] = ([Pat],
     (([String] -> [String]) -> Step a)
     -> ([String] -> [String]) -> Step a)
    -> Maybe
         ([Pat],
          (([String] -> [String]) -> Step a)
          -> ([String] -> [String]) -> Step a)
    forall a. a -> Maybe a
    Just ([], \([String] -> [String]) -> Step a
    _ [String] -> [String]
    parts -> ([String] -> [String]) -> [String] -> Step a
    g [String] -> [String]
    parts [])
        where
            g :: ([String] -> [String]) -> [String] -> Step a
    g [String] -> [String]
    parts [String]
    rseen = Step
                {stepDone :: [(a, [String])]
    stepDone = [(a
    val, [String] -> [String]
    parts [[String] -> String
    mkParts ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    rseen])]
                ,stepNext :: StepNext
    stepNext = StepNext
    StepEverything
                ,stepApply :: String -> Step a
    stepApply = \String
    s -> ([String] -> [String]) -> [String] -> Step a
    g [String] -> [String]
    parts (String
    sString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    rseen)
                }

    -- if you have a specific tail prefix, find it
    unroll a
    val [Pat
    StarStar,Lits ([Wildcard String] -> [Wildcard String]
    forall a. [a] -> [a]
    reverse ([Wildcard String] -> [Wildcard String])
    -> ([Wildcard String] -> Int)
    -> [Wildcard String]
    -> ([Wildcard String], Int)
    forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
    &&& [Wildcard String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length -> ([Wildcard String]
    rls,Int
    nls)),Pat
    End] = ([Pat],
     (([String] -> [String]) -> Step a)
     -> ([String] -> [String]) -> Step a)
    -> Maybe
         ([Pat],
          (([String] -> [String]) -> Step a)
          -> ([String] -> [String]) -> Step a)
    forall a. a -> Maybe a
    Just ([], \([String] -> [String]) -> Step a
    _ [String] -> [String]
    parts -> ([String] -> [String]) -> Int -> [String] -> Step a
    g [String] -> [String]
    parts Int
    0 [])
        where
            g :: ([String] -> [String]) -> Int -> [String] -> Step a
    g [String] -> [String]
    parts !Int
    nseen [String]
    rseen = Step
                {stepDone :: [(a, [String])]
    stepDone = case (Wildcard String -> String -> Maybe [String])
    -> [Wildcard String] -> [String] -> Maybe [[String]]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Wildcard String -> String -> Maybe [String]
    match1 [Wildcard String]
    rls [String]
    rseen of
                    Maybe [[String]]
    _ | Int
    nseen Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    nls -> [] -- fast path
                    Just [[String]]
    xss -> [(a
    val, [String] -> [String]
    parts ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    mkParts ([String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    drop Int
    nls [String]
    rseen) String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[String]] -> [[String]]
    forall a. [a] -> [a]
    reverse [[String]]
    xss))]
                    Maybe [[String]]
    Nothing -> []
                ,stepNext :: StepNext
    stepNext = StepNext
    StepUnknown
                ,stepApply :: String -> Step a
    stepApply = \String
    s -> ([String] -> [String]) -> Int -> [String] -> Step a
    g [String] -> [String]
    parts (Int
    nseenInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (String
    sString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    rseen)
                }

    -- we know the next literal, and it doesn't have any constraints immediately after
    unroll a
    val [Pat
    StarStar,Lits [Wildcard String
    l],Pat
    StarStar] = ([Pat],
     (([String] -> [String]) -> Step a)
     -> ([String] -> [String]) -> Step a)
    -> Maybe
         ([Pat],
          (([String] -> [String]) -> Step a)
          -> ([String] -> [String]) -> Step a)
    forall a. a -> Maybe a
    Just ([Pat
    StarStar], \([String] -> [String]) -> Step a
    cont [String] -> [String]
    parts -> (([String] -> [String]) -> Step a)
    -> ([String] -> [String]) -> [String] -> Step a
    forall {c} {a}.
    (([String] -> c) -> Step a)
    -> ([String] -> c) -> [String] -> Step a
    g ([String] -> [String]) -> Step a
    cont [String] -> [String]
    parts [])
        where
            g :: (([String] -> c) -> Step a)
    -> ([String] -> c) -> [String] -> Step a
    g ([String] -> c) -> Step a
    cont [String] -> c
    parts [String]
    rseen = Step
                {stepDone :: [(a, [String])]
    stepDone = []
                ,stepNext :: StepNext
    stepNext = StepNext
    StepUnknown
                ,stepApply :: String -> Step a
    stepApply = \String
    s -> case Wildcard String -> String -> Maybe [String]
    match1 Wildcard String
    l String
    s of
                    Just [String]
    xs -> ([String] -> c) -> Step a
    cont ([String] -> c
    parts ([String] -> c) -> ([String] -> [String]) -> [String] -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    (++) ([String] -> String
    mkParts ([String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    rseen) String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    xs))
                    Maybe [String]
    Nothing -> (([String] -> c) -> Step a)
    -> ([String] -> c) -> [String] -> Step a
    g ([String] -> c) -> Step a
    cont [String] -> c
    parts (String
    sString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    rseen)
                }

    -- the hard case, a floating substring, accumulate at least N, then star testing in reverse
    unroll a
    val [Pat
    StarStar,Lits ([Wildcard String] -> [Wildcard String]
    forall a. [a] -> [a]
    reverse ([Wildcard String] -> [Wildcard String])
    -> ([Wildcard String] -> Int)
    -> [Wildcard String]
    -> ([Wildcard String], Int)
    forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
    &&& [Wildcard String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length -> ([Wildcard String]
    rls,Int
    nls)),Pat
    StarStar] = ([Pat],
     (([String] -> [String]) -> Step a)
     -> ([String] -> [String]) -> Step a)
    -> Maybe
         ([Pat],
          (([String] -> [String]) -> Step a)
          -> ([String] -> [String]) -> Step a)
    forall a. a -> Maybe a
    Just ([Pat
    StarStar], \([String] -> [String]) -> Step a
    cont [String] -> [String]
    parts -> (([String] -> [String]) -> Step a)
    -> ([String] -> [String]) -> Int -> [String] -> Step a
    forall {c} {a}.
    (([String] -> c) -> Step a)
    -> ([String] -> c) -> Int -> [String] -> Step a
    g ([String] -> [String]) -> Step a
    cont [String] -> [String]
    parts Int
    0 [])
        where
            g :: (([String] -> c) -> Step a)
    -> ([String] -> c) -> Int -> [String] -> Step a
    g ([String] -> c) -> Step a
    cont [String] -> c
    parts !Int
    nseen [String]
    rseen = Step
                {stepDone :: [(a, [String])]
    stepDone = []
                ,stepNext :: StepNext
    stepNext = StepNext
    StepUnknown
                ,stepApply :: String -> Step a
    stepApply = \String
    s -> case (Wildcard String -> String -> Maybe [String])
    -> [Wildcard String] -> [String] -> Maybe [[String]]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Wildcard String -> String -> Maybe [String]
    match1 [Wildcard String]
    rls (String
    sString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    rseen) of
                    Maybe [[String]]
    _ | Int
    nseenInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    nls -> (([String] -> c) -> Step a)
    -> ([String] -> c) -> Int -> [String] -> Step a
    g ([String] -> c) -> Step a
    cont [String] -> c
    parts (Int
    nseenInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (String
    sString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    rseen) -- not enough accumulated yet
                    Maybe [[String]]
    Nothing -> (([String] -> c) -> Step a)
    -> ([String] -> c) -> Int -> [String] -> Step a
    g ([String] -> c) -> Step a
    cont [String] -> c
    parts (Int
    nseenInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (String
    sString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    rseen)
                    Just [[String]]
    xss -> ([String] -> c) -> Step a
    cont ([String] -> c
    parts ([String] -> c) -> ([String] -> [String]) -> [String] -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    (++) ([String] -> String
    mkParts ([String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    drop Int
    nls ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ String
    sString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    rseen) String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[String]] -> [[String]]
    forall a. [a] -> [a]
    reverse [[String]]
    xss)))
                }

    unroll a
    _ [Pat]
    _ = Maybe
      ([Pat],
       (([String] -> [String]) -> Step a)
       -> ([String] -> [String]) -> Step a)
    forall a. Maybe a
    Nothing