{-# LANGUAGE ViewPatterns, DeriveFunctor, BangPatterns, TupleSections, RecordWildCards #-}
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
data StepNext
=
StepOnly [String]
|
StepEverything
|
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
data Step a = Step
{forall a. Step a -> [(a, [String])]
stepDone :: [(a, [String])]
,forall a. Step a -> StepNext
stepNext :: StepNext
,forall a. Step a -> String -> Step a
stepApply :: String -> Step a
}
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
fastFoldMap :: Monoid m => (a -> m) -> [a] -> m
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
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
/= []]
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
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
}
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]
unroll :: a -> [Pat] -> Maybe ([Pat], (Parts -> Step a) -> Parts -> Step a)
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 [])]})
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]
:)))
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
})
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)
}
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 -> []
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)
}
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)
}
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)
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