{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StepNext -> StepNext -> Bool
$c/= :: StepNext -> StepNext -> Bool
== :: StepNext -> StepNext -> Bool
$c== :: StepNext -> StepNext -> Bool
Eq,Eq 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
min :: StepNext -> StepNext -> StepNext
$cmin :: StepNext -> StepNext -> StepNext
max :: StepNext -> StepNext -> StepNext
$cmax :: StepNext -> StepNext -> StepNext
>= :: StepNext -> StepNext -> Bool
$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
compare :: StepNext -> StepNext -> Ordering
$ccompare :: StepNext -> StepNext -> Ordering
Ord,Int -> StepNext -> ShowS
[StepNext] -> ShowS
StepNext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StepNext] -> ShowS
$cshowList :: [StepNext] -> ShowS
show :: StepNext -> String
$cshow :: StepNext -> String
showsPrec :: Int -> StepNext -> ShowS
$cshowsPrec :: Int -> StepNext -> ShowS
Show)


mergeStepNext :: [StepNext] -> StepNext
mergeStepNext :: [StepNext] -> StepNext
mergeStepNext = ([String] -> [String]) -> [StepNext] -> StepNext
f forall a. a -> a
id
    where
        f :: ([String] -> [String]) -> [StepNext] -> StepNext
f [String] -> [String]
rest [] = [String] -> StepNext
StepOnly forall a b. (a -> b) -> a -> b
$ [String] -> [String]
rest []
        f [String] -> [String]
rest (StepNext
StepUnknown:[StepNext]
xs) = if StepNext
StepEverything 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String]
x forall a. [a] -> [a] -> [a]
++)) [StepNext]
xs

normaliseStepNext :: StepNext -> StepNext
normaliseStepNext :: StepNext -> StepNext
normaliseStepNext (StepOnly [String]
xs) = [String] -> StepNext
StepOnly forall a b. (a -> b) -> a -> b
$ 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 = forall a. Semigroup a => NonEmpty a -> a
sconcat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> NonEmpty a
NE.fromList [StepNext
a,StepNext
b]
    sconcat :: NonEmpty StepNext -> StepNext
sconcat = StepNext -> StepNext
normaliseStepNext forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StepNext] -> StepNext
mergeStepNext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList

instance Monoid StepNext where
    mempty :: StepNext
mempty = [String] -> StepNext
StepOnly []
    mappend :: StepNext -> StepNext -> StepNext
mappend = forall a. Semigroup a => a -> a -> a
(<>)
    mconcat :: [StepNext] -> StepNext
mconcat = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. Semigroup a => NonEmpty a -> a
sconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> 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
<$ :: forall a b. a -> Step b -> Step a
$c<$ :: forall a b. a -> Step b -> Step a
fmap :: forall a b. (a -> b) -> Step a -> Step b
$cfmap :: forall a b. (a -> b) -> Step a -> Step b
Functor

mergeStep :: (StepNext -> StepNext) -> [Step a] -> Step a
mergeStep :: forall a. (StepNext -> StepNext) -> [Step a] -> Step a
mergeStep StepNext -> StepNext
f [] = 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Step a -> [(a, [String])]
stepDone [Step a]
xs
    ,stepNext :: StepNext
stepNext = StepNext -> StepNext
f forall a b. (a -> b) -> a -> b
$ [StepNext] -> StepNext
mergeStepNext forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Step a -> StepNext
stepNext [Step a]
xs
    ,stepApply :: String -> Step a
stepApply = \String
x -> forall a. (StepNext -> StepNext) -> [Step a] -> Step a
mergeStep StepNext -> StepNext
f forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (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 = forall a. Semigroup a => NonEmpty a -> a
sconcat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> NonEmpty a
NE.fromList [Step a
a,Step a
b]
    sconcat :: NonEmpty (Step a) -> Step a
sconcat (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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Step a -> [(a, [String])]
stepDone [Step a]
ss
            ,stepNext :: StepNext
stepNext = forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap forall a. Step a -> StepNext
stepNext [Step a]
ss
            ,stepApply :: String -> Step a
stepApply = \String
x -> forall b a. Monoid b => (a -> b) -> [a] -> b
fastFoldMap (forall a. Step a -> String -> Step a
`stepApply` String
x) [Step a]
ss
            }

instance Monoid (Step a) where
    mempty :: Step a
mempty = forall a.
[(a, [String])] -> StepNext -> (String -> Step a) -> Step a
Step [] forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. Monoid a => a
mempty
    mappend :: Step a -> Step a -> Step a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
    mconcat :: [Step a] -> Step a
mconcat = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. Semigroup a => NonEmpty a -> a
sconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pat] -> ShowS
$cshowList :: [Pat] -> ShowS
show :: Pat -> String
$cshow :: Pat -> String
showsPrec :: Int -> Pat -> ShowS
$cshowsPrec :: Int -> Pat -> ShowS
Show,Pat -> Pat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pat -> Pat -> Bool
$c/= :: Pat -> Pat -> Bool
== :: Pat -> Pat -> Bool
$c== :: Pat -> Pat -> Bool
Eq,Eq 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
min :: Pat -> Pat -> Pat
$cmin :: Pat -> Pat -> Pat
max :: Pat -> Pat -> Pat
$cmax :: Pat -> Pat -> Pat
>= :: Pat -> Pat -> Bool
$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
compare :: Pat -> Pat -> Ordering
$ccompare :: Pat -> Pat -> Ordering
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)) = forall a. [a] -> [[a]] -> [a]
intercalate [Pat
StarStar] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Wildcard String] -> [Pat]
lit forall a b. (a -> b) -> a -> b
$ [Wildcard String]
pre forall a. a -> [a] -> [a]
: [[Wildcard String]]
mid 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 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 = forall a. Step [a] -> Step a
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Pat] -> Tree Pat a -> ([String] -> [String]) -> Step [a]
f [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Ord k => [(v, [k])] -> Tree k v
makeTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall b b' a. (b -> b') -> (a, b) -> (a, b')
second forall a b. (a -> b) -> a -> b
$ Pattern -> [Pat]
toPat 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 -> forall a. (StepNext -> StepNext) -> [Step a] -> Step a
mergeStep forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ [String] -> [String]
parts) forall a b. (a -> b) -> a -> b
$ [([String] -> [String]) -> Step [a]]
sEnds forall a. [a] -> [a] -> [a]
++ [([String] -> [String]) -> Step [a]]
sNxts
            where
                sEnds :: [([String] -> [String]) -> Step [a]]
sEnds = case forall a.
a
-> [Pat]
-> Maybe
     ([Pat],
      (([String] -> [String]) -> Step a)
      -> ([String] -> [String]) -> Step a)
unroll [a]
ends ([Pat]
seen forall a. [a] -> [a] -> [a]
++ [Pat
End]) of
                    Maybe
  ([Pat],
   (([String] -> [String]) -> Step [a])
   -> ([String] -> [String]) -> Step [a])
_ | 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 (forall a. HasCallStack => String -> a
error String
"step invariant violated (1)")]
                    Maybe
  ([Pat],
   (([String] -> [String]) -> Step [a])
   -> ([String] -> [String]) -> Step [a])
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"step invariant violated (2), " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Pat]
seen

                sNxts :: [([String] -> [String]) -> Step [a]]
sNxts = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [(Pat, Tree Pat a)]
nxts forall a b. (a -> b) -> a -> b
$ \(Pat
p,Tree Pat a
ps) ->
                    let seen2 :: [Pat]
seen2 = [Pat]
seen forall a. [a] -> [a] -> [a]
++ [Pat
p] in
                    case forall a.
a
-> [Pat]
-> Maybe
     ([Pat],
      (([String] -> [String]) -> Step a)
      -> ([String] -> [String]) -> Step a)
unroll (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 -> 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 (forall a. [Pat] -> Tree Pat a -> ([String] -> [String]) -> Step [a]
f [] forall a b. (a -> b) -> a -> b
$ 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 = 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 :: String -> Step [a]
stepNext :: StepNext
stepDone :: [([a], [String])]
stepApply :: forall a. Step a -> String -> Step a
stepNext :: forall a. Step a -> StepNext
stepDone :: forall a. Step a -> [(a, [String])]
..} = 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 = forall a. Step [a] -> Step a
restore 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_ = forall a. [(a, String)] -> Step a
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. [Either a b] -> [b]
rights forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c.
(a -> b -> Maybe c)
-> Wildcard [a] -> [b] -> Maybe [Either [c] [b]]
wildcardMatch 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] = forall a. a -> Maybe a
Just ([], \([String] -> [String]) -> Step a
_ [String] -> [String]
parts -> forall a. Monoid a => a
mempty{stepDone :: [(a, [String])]
stepDone = [(a
val, [String] -> [String]
parts [])]})

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

-- if you have literals next, match them
unroll a
val [Lits (Wildcard String
l:[Wildcard String]
ls)] = forall a. a -> Maybe a
Just ([[Wildcard String] -> Pat
Lits [Wildcard String]
ls | [Wildcard String]
ls 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String]
xsforall a. [a] -> [a] -> [a]
++))
        Maybe [String]
Nothing -> forall a. Monoid a => a
mempty
    })

-- if anything else is allowed, just quickly allow it
unroll a
val [Pat
StarStar,Pat
End] = 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 forall a b. (a -> b) -> a -> b
$ 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
sforall a. a -> [a] -> [a]
:[String]
rseen)
            }

-- if you have a specific tail prefix, find it
unroll a
val [Pat
StarStar,Lits (forall a. [a] -> [a]
reverse forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& forall (t :: * -> *) a. Foldable t => t a -> Int
length -> ([Wildcard String]
rls,Int
nls)),Pat
End] = 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 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 forall a. Ord a => a -> a -> Bool
< Int
nls -> [] -- fast path
                Just [[String]]
xss -> [(a
val, [String] -> [String]
parts forall a b. (a -> b) -> a -> b
$ [String] -> String
mkParts (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
nls [String]
rseen) forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (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
nseenforall a. Num a => a -> a -> a
+Int
1) (String
sforall 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] = forall a. a -> Maybe a
Just ([Pat
StarStar], \([String] -> [String]) -> Step a
cont [String] -> [String]
parts -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) ([String] -> String
mkParts (forall a. [a] -> [a]
reverse [String]
rseen) 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
sforall 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 (forall a. [a] -> [a]
reverse forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& forall (t :: * -> *) a. Foldable t => t a -> Int
length -> ([Wildcard String]
rls,Int
nls)),Pat
StarStar] = forall a. a -> Maybe a
Just ([Pat
StarStar], \([String] -> [String]) -> Step a
cont [String] -> [String]
parts -> 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 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
sforall a. a -> [a] -> [a]
:[String]
rseen) of
                Maybe [[String]]
_ | Int
nseenforall a. Num a => a -> a -> a
+Int
1 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
nseenforall a. Num a => a -> a -> a
+Int
1) (String
sforall 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
nseenforall a. Num a => a -> a -> a
+Int
1) (String
sforall a. a -> [a] -> [a]
:[String]
rseen)
                Just [[String]]
xss -> ([String] -> c) -> Step a
cont ([String] -> c
parts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) ([String] -> String
mkParts (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
nls forall a b. (a -> b) -> a -> b
$ String
sforall a. a -> [a] -> [a]
:[String]
rseen) forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. [a] -> [a]
reverse [[String]]
xss)))
            }

unroll a
_ [Pat]
_ = forall a. Maybe a
Nothing