#include "inline.hs"
module Streamly.Internal.Data.Parser.ParserD
(
Parser (..)
, ParseError (..)
, Step (..)
, Initial (..)
, rmapM
, fromFold
, fromPure
, fromEffect
, die
, dieM
, peek
, eof
, satisfy
, maybe
, either
, takeBetween
, takeEQ
, takeGE
, lookAhead
, takeWhile
, takeWhile1
, sliceSepByP
, sliceBeginWith
, wordBy
, groupBy
, groupByRolling
, eqBy
, span
, spanBy
, spanByRolling
, serialWith
, split_
, teeWith
, teeWithFst
, teeWithMin
, deintercalate
, alt
, shortest
, longest
, sequence
, concatMap
, count
, countBetween
, many
, some
, manyTill
, choice
)
where
import Control.Exception (assert)
import Control.Monad.Catch (MonadCatch, MonadThrow(..))
import Fusion.Plugin.Types (Fuse(..))
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
import qualified Streamly.Internal.Data.Fold.Type as FL
import Prelude hiding
(any, all, take, takeWhile, sequence, concatMap, maybe, either, span)
import Streamly.Internal.Data.Parser.ParserD.Tee
import Streamly.Internal.Data.Parser.ParserD.Type
{-# INLINE fromFold #-}
fromFold :: Monad m => Fold m a b -> Parser m a b
fromFold :: Fold m a b -> Parser m a b
fromFold (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) = (s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m b
fextract
where
initial :: m (Initial s b)
initial = do
Step s b
res <- m (Step s b)
finitial
Initial s b -> m (Initial s b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Initial s b -> m (Initial s b)) -> Initial s b -> m (Initial s b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s1 -> s -> Initial s b
forall s b. s -> Initial s b
IPartial s
s1
FL.Done b
b -> b -> Initial s b
forall s b. b -> Initial s b
IDone b
b
step :: s -> a -> m (Step s b)
step s
s a
a = do
Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s1 -> Int -> s -> Step s b
forall s b. Int -> s -> Step s b
Partial Int
0 s
s1
FL.Done b
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Done Int
0 b
b
{-# INLINABLE peek #-}
peek :: MonadThrow m => Parser m a a
peek :: Parser m a a
peek = (() -> a -> m (Step () a))
-> m (Initial () a) -> (() -> m a) -> Parser m a a
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser () -> a -> m (Step () a)
forall (m :: * -> *) b s. Monad m => () -> b -> m (Step s b)
step m (Initial () a)
forall b. m (Initial () b)
initial () -> m a
forall (m :: * -> *) a. MonadThrow m => () -> m a
extract
where
initial :: m (Initial () b)
initial = Initial () b -> m (Initial () b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial () b -> m (Initial () b))
-> Initial () b -> m (Initial () b)
forall a b. (a -> b) -> a -> b
$ () -> Initial () b
forall s b. s -> Initial s b
IPartial ()
step :: () -> b -> m (Step s b)
step () b
a = Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Done Int
1 b
a
extract :: () -> m a
extract () = ParseError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m a) -> ParseError -> m a
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"peek: end of input"
{-# INLINABLE eof #-}
eof :: Monad m => Parser m a ()
eof :: Parser m a ()
eof = (() -> a -> m (Step () ()))
-> m (Initial () ()) -> (() -> m ()) -> Parser m a ()
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser () -> a -> m (Step () ())
forall (m :: * -> *) p s b. Monad m => () -> p -> m (Step s b)
step m (Initial () ())
forall b. m (Initial () b)
initial () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return
where
initial :: m (Initial () b)
initial = Initial () b -> m (Initial () b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial () b -> m (Initial () b))
-> Initial () b -> m (Initial () b)
forall a b. (a -> b) -> a -> b
$ () -> Initial () b
forall s b. s -> Initial s b
IPartial ()
step :: () -> p -> m (Step s b)
step () p
_ = Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ String -> Step s b
forall s b. String -> Step s b
Error String
"eof: not at end of input"
{-# INLINE satisfy #-}
satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
satisfy :: (a -> Bool) -> Parser m a a
satisfy a -> Bool
predicate = (() -> a -> m (Step () a))
-> m (Initial () a) -> (() -> m a) -> Parser m a a
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser () -> a -> m (Step () a)
forall (m :: * -> *) s. Monad m => () -> a -> m (Step s a)
step m (Initial () a)
forall b. m (Initial () b)
initial () -> m a
forall (m :: * -> *) p a. MonadThrow m => p -> m a
extract
where
initial :: m (Initial () b)
initial = Initial () b -> m (Initial () b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial () b -> m (Initial () b))
-> Initial () b -> m (Initial () b)
forall a b. (a -> b) -> a -> b
$ () -> Initial () b
forall s b. s -> Initial s b
IPartial ()
step :: () -> a -> m (Step s a)
step () a
a = Step s a -> m (Step s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s a -> m (Step s a)) -> Step s a -> m (Step s a)
forall a b. (a -> b) -> a -> b
$
if a -> Bool
predicate a
a
then Int -> a -> Step s a
forall s b. Int -> b -> Step s b
Done Int
0 a
a
else String -> Step s a
forall s b. String -> Step s b
Error String
"satisfy: predicate failed"
extract :: p -> m a
extract p
_ = ParseError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m a) -> ParseError -> m a
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"satisfy: end of input"
{-# INLINE maybe #-}
maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
maybe :: (a -> Maybe b) -> Parser m a b
maybe a -> Maybe b
parser = (() -> a -> m (Step () b))
-> m (Initial () b) -> (() -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser () -> a -> m (Step () b)
forall (m :: * -> *) s. Monad m => () -> a -> m (Step s b)
step m (Initial () b)
forall b. m (Initial () b)
initial () -> m b
forall (m :: * -> *) p a. MonadThrow m => p -> m a
extract
where
initial :: m (Initial () b)
initial = Initial () b -> m (Initial () b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial () b -> m (Initial () b))
-> Initial () b -> m (Initial () b)
forall a b. (a -> b) -> a -> b
$ () -> Initial () b
forall s b. s -> Initial s b
IPartial ()
step :: () -> a -> m (Step s b)
step () a
a = Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$
case a -> Maybe b
parser a
a of
Just b
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Done Int
0 b
b
Maybe b
Nothing -> String -> Step s b
forall s b. String -> Step s b
Error String
"maybe: predicate failed"
extract :: p -> m a
extract p
_ = ParseError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m a) -> ParseError -> m a
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"maybe: end of input"
{-# INLINE either #-}
either :: MonadThrow m => (a -> Either String b) -> Parser m a b
either :: (a -> Either String b) -> Parser m a b
either a -> Either String b
parser = (() -> a -> m (Step () b))
-> m (Initial () b) -> (() -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser () -> a -> m (Step () b)
forall (m :: * -> *) s. Monad m => () -> a -> m (Step s b)
step m (Initial () b)
forall b. m (Initial () b)
initial () -> m b
forall (m :: * -> *) p a. MonadThrow m => p -> m a
extract
where
initial :: m (Initial () b)
initial = Initial () b -> m (Initial () b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial () b -> m (Initial () b))
-> Initial () b -> m (Initial () b)
forall a b. (a -> b) -> a -> b
$ () -> Initial () b
forall s b. s -> Initial s b
IPartial ()
step :: () -> a -> m (Step s b)
step () a
a = Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$
case a -> Either String b
parser a
a of
Right b
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Done Int
0 b
b
Left String
err -> String -> Step s b
forall s b. String -> Step s b
Error (String -> Step s b) -> String -> Step s b
forall a b. (a -> b) -> a -> b
$ String
"either: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
extract :: p -> m a
extract p
_ = ParseError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m a) -> ParseError -> m a
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"either: end of input"
{-# INLINE takeBetween #-}
takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a b
takeBetween :: Int -> Int -> Fold m a b -> Parser m a b
takeBetween Int
low Int
high (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) =
(Tuple' Int s -> a -> m (Step (Tuple' Int s) b))
-> m (Initial (Tuple' Int s) b)
-> (Tuple' Int s -> m b)
-> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step m (Initial (Tuple' Int s) b)
initial Tuple' Int s -> m b
extract
where
initial :: m (Initial (Tuple' Int s) b)
initial = do
Step s b
res <- m (Step s b)
finitial
Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b))
-> Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s -> Tuple' Int s -> Initial (Tuple' Int s) b
forall s b. s -> Initial s b
IPartial (Tuple' Int s -> Initial (Tuple' Int s) b)
-> Tuple' Int s -> Initial (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
0 s
s
FL.Done b
b ->
if Int
low Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then b -> Initial (Tuple' Int s) b
forall s b. b -> Initial s b
IDone b
b
else String -> Initial (Tuple' Int s) b
forall s b. String -> Initial s b
IError
(String -> Initial (Tuple' Int s) b)
-> String -> Initial (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ String
"takeBetween: the collecting fold terminated without"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" consuming any elements"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" minimum" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
low String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements needed"
step :: Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step (Tuple' Int
i s
s) a
a
| Int
low Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
high =
ParseError -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
(ParseError -> m (Step (Tuple' Int s) b))
-> ParseError -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError
(String -> ParseError) -> String -> ParseError
forall a b. (a -> b) -> a -> b
$ String
"takeBetween: lower bound - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
low
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is greater than higher bound - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
high
| Int
high Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
Done Int
1 (b -> Step (Tuple' Int s) b) -> m b -> m (Step (Tuple' Int s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
s
| Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
low = do
Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s1 -> Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Continue Int
0 (Tuple' Int s -> Step (Tuple' Int s) b)
-> Tuple' Int s -> Step (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
i1 s
s1
FL.Done b
_ ->
String -> Step (Tuple' Int s) b
forall s b. String -> Step s b
Error
(String -> Step (Tuple' Int s) b)
-> String -> Step (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ String
"takeBetween: the collecting fold terminated after"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" consuming" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" minimum" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
low String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements needed"
| Bool
otherwise = do
Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
case Step s b
res of
FL.Partial s
s1 ->
if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
high
then Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
Done Int
0 (b -> Step (Tuple' Int s) b) -> m b -> m (Step (Tuple' Int s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
s1
else Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Partial Int
0 (Tuple' Int s -> Step (Tuple' Int s) b)
-> Tuple' Int s -> Step (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
i1 s
s1
FL.Done b
b -> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
Done Int
0 b
b
where
i1 :: Int
i1 = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
extract :: Tuple' Int s -> m b
extract (Tuple' Int
i s
s)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
low Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
high = s -> m b
fextract s
s
| Bool
otherwise = ParseError -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err
where
err :: String
err =
String
"takeBetween: Expecting alteast " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
low
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
{-# INLINE takeEQ #-}
takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
takeEQ :: Int -> Fold m a b -> Parser m a b
takeEQ Int
n (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) = (Tuple' Int s -> a -> m (Step (Tuple' Int s) b))
-> m (Initial (Tuple' Int s) b)
-> (Tuple' Int s -> m b)
-> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step m (Initial (Tuple' Int s) b)
initial Tuple' Int s -> m b
forall a. (Eq a, Num a, Show a) => Tuple' a s -> m b
extract
where
cnt :: Int
cnt = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0
initial :: m (Initial (Tuple' Int s) b)
initial = do
Step s b
res <- m (Step s b)
finitial
Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b))
-> Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s -> Tuple' Int s -> Initial (Tuple' Int s) b
forall s b. s -> Initial s b
IPartial (Tuple' Int s -> Initial (Tuple' Int s) b)
-> Tuple' Int s -> Initial (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
0 s
s
FL.Done b
b ->
if Int
cnt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then b -> Initial (Tuple' Int s) b
forall s b. b -> Initial s b
IDone b
b
else String -> Initial (Tuple' Int s) b
forall s b. String -> Initial s b
IError
(String -> Initial (Tuple' Int s) b)
-> String -> Initial (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ String
"takeEQ: Expecting exactly " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
cnt
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, fold terminated without"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" consuming any elements"
step :: Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step (Tuple' Int
i s
r) a
a
| Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cnt = do
Step s b
res <- s -> a -> m (Step s b)
fstep s
r a
a
Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s -> Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Continue Int
0 (Tuple' Int s -> Step (Tuple' Int s) b)
-> Tuple' Int s -> Step (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
i1 s
s
FL.Done b
_ ->
String -> Step (Tuple' Int s) b
forall s b. String -> Step s b
Error
(String -> Step (Tuple' Int s) b)
-> String -> Step (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ String
"takeEQ: Expecting exactly " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
cnt
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, fold terminated on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i1
| Int
i1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cnt = do
Step s b
res <- s -> a -> m (Step s b)
fstep s
r a
a
Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
Done Int
0
(b -> Step (Tuple' Int s) b) -> m b -> m (Step (Tuple' Int s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Step s b
res of
FL.Partial s
s -> s -> m b
fextract s
s
FL.Done b
b -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
| Bool
otherwise = Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
Done Int
1 (b -> Step (Tuple' Int s) b) -> m b -> m (Step (Tuple' Int s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
r
where
i1 :: Int
i1 = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
extract :: Tuple' a s -> m b
extract (Tuple' a
i s
r)
| a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& Int
cnt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = s -> m b
fextract s
r
| Bool
otherwise =
ParseError -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
(ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError
(String -> ParseError) -> String -> ParseError
forall a b. (a -> b) -> a -> b
$ String
"takeEQ: Expecting exactly " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
cnt
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, input terminated on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i
{-# INLINE takeGE #-}
takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
takeGE :: Int -> Fold m a b -> Parser m a b
takeGE Int
n (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) = (Tuple' Int s -> a -> m (Step (Tuple' Int s) b))
-> m (Initial (Tuple' Int s) b)
-> (Tuple' Int s -> m b)
-> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step m (Initial (Tuple' Int s) b)
initial Tuple' Int s -> m b
extract
where
cnt :: Int
cnt = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0
initial :: m (Initial (Tuple' Int s) b)
initial = do
Step s b
res <- m (Step s b)
finitial
Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b))
-> Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s -> Tuple' Int s -> Initial (Tuple' Int s) b
forall s b. s -> Initial s b
IPartial (Tuple' Int s -> Initial (Tuple' Int s) b)
-> Tuple' Int s -> Initial (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
0 s
s
FL.Done b
b ->
if Int
cnt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then b -> Initial (Tuple' Int s) b
forall s b. b -> Initial s b
IDone b
b
else String -> Initial (Tuple' Int s) b
forall s b. String -> Initial s b
IError
(String -> Initial (Tuple' Int s) b)
-> String -> Initial (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ String
"takeGE: Expecting at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
cnt
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, fold terminated without"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" consuming any elements"
step :: Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step (Tuple' Int
i s
r) a
a
| Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cnt = do
Step s b
res <- s -> a -> m (Step s b)
fstep s
r a
a
Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s -> Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Continue Int
0 (Tuple' Int s -> Step (Tuple' Int s) b)
-> Tuple' Int s -> Step (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
i1 s
s
FL.Done b
_ ->
String -> Step (Tuple' Int s) b
forall s b. String -> Step s b
Error
(String -> Step (Tuple' Int s) b)
-> String -> Step (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ String
"takeGE: Expecting at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
cnt
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, fold terminated on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i1
| Bool
otherwise = do
Step s b
res <- s -> a -> m (Step s b)
fstep s
r a
a
Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s -> Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Partial Int
0 (Tuple' Int s -> Step (Tuple' Int s) b)
-> Tuple' Int s -> Step (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
i1 s
s
FL.Done b
b -> Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
Done Int
0 b
b
where
i1 :: Int
i1 = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
extract :: Tuple' Int s -> m b
extract (Tuple' Int
i s
r)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
cnt = s -> m b
fextract s
r
| Bool
otherwise =
ParseError -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
(ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError
(String -> ParseError) -> String -> ParseError
forall a b. (a -> b) -> a -> b
$ String
"takeGE: Expecting at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
cnt
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, input terminated on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
{-# INLINE takeWhile #-}
takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
takeWhile :: (a -> Bool) -> Fold m a b -> Parser m a b
takeWhile a -> Bool
predicate (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) =
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m b
fextract
where
initial :: m (Initial s b)
initial = do
Step s b
res <- m (Step s b)
finitial
Initial s b -> m (Initial s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial s b -> m (Initial s b)) -> Initial s b -> m (Initial s b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s -> s -> Initial s b
forall s b. s -> Initial s b
IPartial s
s
FL.Done b
b -> b -> Initial s b
forall s b. b -> Initial s b
IDone b
b
step :: s -> a -> m (Step s b)
step s
s a
a =
if a -> Bool
predicate a
a
then do
Step s b
fres <- s -> a -> m (Step s b)
fstep s
s a
a
Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ case Step s b
fres of
FL.Partial s
s1 -> Int -> s -> Step s b
forall s b. Int -> s -> Step s b
Partial Int
0 s
s1
FL.Done b
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Done Int
0 b
b
else Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Done Int
1 (b -> Step s b) -> m b -> m (Step s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
s
{-# INLINE takeWhile1 #-}
takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
takeWhile1 :: (a -> Bool) -> Fold m a b -> Parser m a b
takeWhile1 a -> Bool
predicate (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) =
(Either s s -> a -> m (Step (Either s s) b))
-> m (Initial (Either s s) b)
-> (Either s s -> m b)
-> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser Either s s -> a -> m (Step (Either s s) b)
forall a. Either s s -> a -> m (Step (Either a s) b)
step m (Initial (Either s s) b)
forall b b. m (Initial (Either s b) b)
initial Either s s -> m b
forall a. Either a s -> m b
extract
where
initial :: m (Initial (Either s b) b)
initial = do
Step s b
res <- m (Step s b)
finitial
Initial (Either s b) b -> m (Initial (Either s b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Either s b) b -> m (Initial (Either s b) b))
-> Initial (Either s b) b -> m (Initial (Either s b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s -> Either s b -> Initial (Either s b) b
forall s b. s -> Initial s b
IPartial (s -> Either s b
forall a b. a -> Either a b
Left s
s)
FL.Done b
_ ->
String -> Initial (Either s b) b
forall s b. String -> Initial s b
IError
(String -> Initial (Either s b) b)
-> String -> Initial (Either s b) b
forall a b. (a -> b) -> a -> b
$ String
"takeWhile1: fold terminated without consuming:"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" any element"
{-# INLINE process #-}
process :: s -> a -> m (Step (Either a s) b)
process s
s a
a = do
Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
Step (Either a s) b -> m (Step (Either a s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step (Either a s) b -> m (Step (Either a s) b))
-> Step (Either a s) b -> m (Step (Either a s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s1 -> Int -> Either a s -> Step (Either a s) b
forall s b. Int -> s -> Step s b
Partial Int
0 (s -> Either a s
forall a b. b -> Either a b
Right s
s1)
FL.Done b
b -> Int -> b -> Step (Either a s) b
forall s b. Int -> b -> Step s b
Done Int
0 b
b
step :: Either s s -> a -> m (Step (Either a s) b)
step (Left s
s) a
a =
if a -> Bool
predicate a
a
then s -> a -> m (Step (Either a s) b)
forall a. s -> a -> m (Step (Either a s) b)
process s
s a
a
else Step (Either a s) b -> m (Step (Either a s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either a s) b -> m (Step (Either a s) b))
-> Step (Either a s) b -> m (Step (Either a s) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (Either a s) b
forall s b. String -> Step s b
Error String
"takeWhile1: predicate failed on first element"
step (Right s
s) a
a =
if a -> Bool
predicate a
a
then s -> a -> m (Step (Either a s) b)
forall a. s -> a -> m (Step (Either a s) b)
process s
s a
a
else do
b
b <- s -> m b
fextract s
s
Step (Either a s) b -> m (Step (Either a s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either a s) b -> m (Step (Either a s) b))
-> Step (Either a s) b -> m (Step (Either a s) b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step (Either a s) b
forall s b. Int -> b -> Step s b
Done Int
1 b
b
extract :: Either a s -> m b
extract (Left a
_) = ParseError -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"takeWhile1: end of input"
extract (Right s
s) = s -> m b
fextract s
s
sliceSepByP :: MonadCatch m =>
(a -> Bool) -> Parser m a b -> Parser m a b
sliceSepByP :: (a -> Bool) -> Parser m a b -> Parser m a b
sliceSepByP a -> Bool
cond (Parser s -> a -> m (Step s b)
pstep m (Initial s b)
pinitial s -> m b
pextract) =
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m b
pextract
where
initial :: m (Initial s b)
initial = m (Initial s b)
pinitial
step :: s -> a -> m (Step s b)
step s
s a
a =
if a -> Bool
cond a
a
then do
b
res <- s -> m b
pextract s
s
Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Done Int
0 b
res
else s -> a -> m (Step s b)
pstep s
s a
a
data SliceBeginWithState s = Left' s | Right' s
{-# INLINE sliceBeginWith #-}
sliceBeginWith :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
sliceBeginWith :: (a -> Bool) -> Fold m a b -> Parser m a b
sliceBeginWith a -> Bool
cond (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) =
(SliceBeginWithState s -> a -> m (Step (SliceBeginWithState s) b))
-> m (Initial (SliceBeginWithState s) b)
-> (SliceBeginWithState s -> m b)
-> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser SliceBeginWithState s -> a -> m (Step (SliceBeginWithState s) b)
step m (Initial (SliceBeginWithState s) b)
forall b. m (Initial (SliceBeginWithState s) b)
initial SliceBeginWithState s -> m b
extract
where
initial :: m (Initial (SliceBeginWithState s) b)
initial = do
Step s b
res <- m (Step s b)
finitial
Initial (SliceBeginWithState s) b
-> m (Initial (SliceBeginWithState s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SliceBeginWithState s) b
-> m (Initial (SliceBeginWithState s) b))
-> Initial (SliceBeginWithState s) b
-> m (Initial (SliceBeginWithState s) b)
forall a b. (a -> b) -> a -> b
$
case Step s b
res of
FL.Partial s
s -> SliceBeginWithState s -> Initial (SliceBeginWithState s) b
forall s b. s -> Initial s b
IPartial (s -> SliceBeginWithState s
forall s. s -> SliceBeginWithState s
Left' s
s)
FL.Done b
_ -> String -> Initial (SliceBeginWithState s) b
forall s b. String -> Initial s b
IError String
"sliceBeginWith : bad finitial"
{-# INLINE process #-}
process :: s -> a -> m (Step (SliceBeginWithState s) b)
process s
s a
a = do
Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
Step (SliceBeginWithState s) b
-> m (Step (SliceBeginWithState s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step (SliceBeginWithState s) b
-> m (Step (SliceBeginWithState s) b))
-> Step (SliceBeginWithState s) b
-> m (Step (SliceBeginWithState s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s1 -> Int -> SliceBeginWithState s -> Step (SliceBeginWithState s) b
forall s b. Int -> s -> Step s b
Partial Int
0 (s -> SliceBeginWithState s
forall s. s -> SliceBeginWithState s
Right' s
s1)
FL.Done b
b -> Int -> b -> Step (SliceBeginWithState s) b
forall s b. Int -> b -> Step s b
Done Int
0 b
b
step :: SliceBeginWithState s -> a -> m (Step (SliceBeginWithState s) b)
step (Left' s
s) a
a =
if a -> Bool
cond a
a
then s -> a -> m (Step (SliceBeginWithState s) b)
process s
s a
a
else String -> m (Step (SliceBeginWithState s) b)
forall a. HasCallStack => String -> a
error (String -> m (Step (SliceBeginWithState s) b))
-> String -> m (Step (SliceBeginWithState s) b)
forall a b. (a -> b) -> a -> b
$ String
"sliceBeginWith : slice begins with an element which "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"fails the predicate"
step (Right' s
s) a
a =
if Bool -> Bool
not (a -> Bool
cond a
a)
then s -> a -> m (Step (SliceBeginWithState s) b)
process s
s a
a
else Int -> b -> Step (SliceBeginWithState s) b
forall s b. Int -> b -> Step s b
Done Int
1 (b -> Step (SliceBeginWithState s) b)
-> m b -> m (Step (SliceBeginWithState s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
s
extract :: SliceBeginWithState s -> m b
extract (Left' s
s) = s -> m b
fextract s
s
extract (Right' s
s) = s -> m b
fextract s
s
data WordByState s b = WBLeft !s | WBWord !s | WBRight !b
{-# INLINE wordBy #-}
wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
wordBy :: (a -> Bool) -> Fold m a b -> Parser m a b
wordBy a -> Bool
predicate (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) = (WordByState s b -> a -> m (Step (WordByState s b) b))
-> m (Initial (WordByState s b) b)
-> (WordByState s b -> m b)
-> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser WordByState s b -> a -> m (Step (WordByState s b) b)
step m (Initial (WordByState s b) b)
forall b. m (Initial (WordByState s b) b)
initial WordByState s b -> m b
extract
where
{-# INLINE worder #-}
worder :: s -> a -> m (Step (WordByState s b) b)
worder s
s a
a = do
Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step (WordByState s b) b -> m (Step (WordByState s b) b))
-> Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s1 -> Int -> WordByState s b -> Step (WordByState s b) b
forall s b. Int -> s -> Step s b
Partial Int
0 (WordByState s b -> Step (WordByState s b) b)
-> WordByState s b -> Step (WordByState s b) b
forall a b. (a -> b) -> a -> b
$ s -> WordByState s b
forall s b. s -> WordByState s b
WBWord s
s1
FL.Done b
b -> Int -> b -> Step (WordByState s b) b
forall s b. Int -> b -> Step s b
Done Int
0 b
b
initial :: m (Initial (WordByState s b) b)
initial = do
Step s b
res <- m (Step s b)
finitial
Initial (WordByState s b) b -> m (Initial (WordByState s b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Initial (WordByState s b) b -> m (Initial (WordByState s b) b))
-> Initial (WordByState s b) b -> m (Initial (WordByState s b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s -> WordByState s b -> Initial (WordByState s b) b
forall s b. s -> Initial s b
IPartial (WordByState s b -> Initial (WordByState s b) b)
-> WordByState s b -> Initial (WordByState s b) b
forall a b. (a -> b) -> a -> b
$ s -> WordByState s b
forall s b. s -> WordByState s b
WBLeft s
s
FL.Done b
b -> b -> Initial (WordByState s b) b
forall s b. b -> Initial s b
IDone b
b
step :: WordByState s b -> a -> m (Step (WordByState s b) b)
step (WBLeft s
s) a
a =
if Bool -> Bool
not (a -> Bool
predicate a
a)
then s -> a -> m (Step (WordByState s b) b)
forall b. s -> a -> m (Step (WordByState s b) b)
worder s
s a
a
else Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordByState s b) b -> m (Step (WordByState s b) b))
-> Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordByState s b -> Step (WordByState s b) b
forall s b. Int -> s -> Step s b
Partial Int
0 (WordByState s b -> Step (WordByState s b) b)
-> WordByState s b -> Step (WordByState s b) b
forall a b. (a -> b) -> a -> b
$ s -> WordByState s b
forall s b. s -> WordByState s b
WBLeft s
s
step (WBWord s
s) a
a =
if Bool -> Bool
not (a -> Bool
predicate a
a)
then s -> a -> m (Step (WordByState s b) b)
forall b. s -> a -> m (Step (WordByState s b) b)
worder s
s a
a
else do
b
b <- s -> m b
fextract s
s
Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordByState s b) b -> m (Step (WordByState s b) b))
-> Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordByState s b -> Step (WordByState s b) b
forall s b. Int -> s -> Step s b
Partial Int
0 (WordByState s b -> Step (WordByState s b) b)
-> WordByState s b -> Step (WordByState s b) b
forall a b. (a -> b) -> a -> b
$ b -> WordByState s b
forall s b. b -> WordByState s b
WBRight b
b
step (WBRight b
b) a
a =
Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step (WordByState s b) b -> m (Step (WordByState s b) b))
-> Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not (a -> Bool
predicate a
a)
then Int -> b -> Step (WordByState s b) b
forall s b. Int -> b -> Step s b
Done Int
1 b
b
else Int -> WordByState s b -> Step (WordByState s b) b
forall s b. Int -> s -> Step s b
Partial Int
0 (WordByState s b -> Step (WordByState s b) b)
-> WordByState s b -> Step (WordByState s b) b
forall a b. (a -> b) -> a -> b
$ b -> WordByState s b
forall s b. b -> WordByState s b
WBRight b
b
extract :: WordByState s b -> m b
extract (WBLeft s
s) = s -> m b
fextract s
s
extract (WBWord s
s) = s -> m b
fextract s
s
extract (WBRight b
b) = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
{-# ANN type GroupByState Fuse #-}
data GroupByState a s
= GroupByInit !s
| GroupByGrouping !a !s
{-# INLINE groupBy #-}
groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
groupBy :: (a -> a -> Bool) -> Fold m a b -> Parser m a b
groupBy a -> a -> Bool
eq (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) = (GroupByState a s -> a -> m (Step (GroupByState a s) b))
-> m (Initial (GroupByState a s) b)
-> (GroupByState a s -> m b)
-> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser GroupByState a s -> a -> m (Step (GroupByState a s) b)
step m (Initial (GroupByState a s) b)
forall a. m (Initial (GroupByState a s) b)
initial GroupByState a s -> m b
forall a. GroupByState a s -> m b
extract
where
{-# INLINE grouper #-}
grouper :: s -> a -> a -> m (Step (GroupByState a s) b)
grouper s
s a
a0 a
a = do
Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
Step (GroupByState a s) b -> m (Step (GroupByState a s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step (GroupByState a s) b -> m (Step (GroupByState a s) b))
-> Step (GroupByState a s) b -> m (Step (GroupByState a s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Done b
b -> Int -> b -> Step (GroupByState a s) b
forall s b. Int -> b -> Step s b
Done Int
0 b
b
FL.Partial s
s1 -> Int -> GroupByState a s -> Step (GroupByState a s) b
forall s b. Int -> s -> Step s b
Partial Int
0 (a -> s -> GroupByState a s
forall a s. a -> s -> GroupByState a s
GroupByGrouping a
a0 s
s1)
initial :: m (Initial (GroupByState a s) b)
initial = do
Step s b
res <- m (Step s b)
finitial
Initial (GroupByState a s) b -> m (Initial (GroupByState a s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Initial (GroupByState a s) b -> m (Initial (GroupByState a s) b))
-> Initial (GroupByState a s) b -> m (Initial (GroupByState a s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s -> GroupByState a s -> Initial (GroupByState a s) b
forall s b. s -> Initial s b
IPartial (GroupByState a s -> Initial (GroupByState a s) b)
-> GroupByState a s -> Initial (GroupByState a s) b
forall a b. (a -> b) -> a -> b
$ s -> GroupByState a s
forall a s. s -> GroupByState a s
GroupByInit s
s
FL.Done b
b -> b -> Initial (GroupByState a s) b
forall s b. b -> Initial s b
IDone b
b
step :: GroupByState a s -> a -> m (Step (GroupByState a s) b)
step (GroupByInit s
s) a
a = s -> a -> a -> m (Step (GroupByState a s) b)
forall a. s -> a -> a -> m (Step (GroupByState a s) b)
grouper s
s a
a a
a
step (GroupByGrouping a
a0 s
s) a
a =
if a -> a -> Bool
eq a
a0 a
a
then s -> a -> a -> m (Step (GroupByState a s) b)
forall a. s -> a -> a -> m (Step (GroupByState a s) b)
grouper s
s a
a0 a
a
else Int -> b -> Step (GroupByState a s) b
forall s b. Int -> b -> Step s b
Done Int
1 (b -> Step (GroupByState a s) b)
-> m b -> m (Step (GroupByState a s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
s
extract :: GroupByState a s -> m b
extract (GroupByInit s
s) = s -> m b
fextract s
s
extract (GroupByGrouping a
_ s
s) = s -> m b
fextract s
s
{-# INLINE groupByRolling #-}
groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a b
groupByRolling :: (a -> a -> Bool) -> Fold m a b -> Parser m a b
groupByRolling a -> a -> Bool
eq (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) = (GroupByState a s -> a -> m (Step (GroupByState a s) b))
-> m (Initial (GroupByState a s) b)
-> (GroupByState a s -> m b)
-> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser GroupByState a s -> a -> m (Step (GroupByState a s) b)
step m (Initial (GroupByState a s) b)
forall a. m (Initial (GroupByState a s) b)
initial GroupByState a s -> m b
forall a. GroupByState a s -> m b
extract
where
{-# INLINE grouper #-}
grouper :: s -> a -> m (Step (GroupByState a s) b)
grouper s
s a
a = do
Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
Step (GroupByState a s) b -> m (Step (GroupByState a s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step (GroupByState a s) b -> m (Step (GroupByState a s) b))
-> Step (GroupByState a s) b -> m (Step (GroupByState a s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Done b
b -> Int -> b -> Step (GroupByState a s) b
forall s b. Int -> b -> Step s b
Done Int
0 b
b
FL.Partial s
s1 -> Int -> GroupByState a s -> Step (GroupByState a s) b
forall s b. Int -> s -> Step s b
Partial Int
0 (a -> s -> GroupByState a s
forall a s. a -> s -> GroupByState a s
GroupByGrouping a
a s
s1)
initial :: m (Initial (GroupByState a s) b)
initial = do
Step s b
res <- m (Step s b)
finitial
Initial (GroupByState a s) b -> m (Initial (GroupByState a s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Initial (GroupByState a s) b -> m (Initial (GroupByState a s) b))
-> Initial (GroupByState a s) b -> m (Initial (GroupByState a s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
FL.Partial s
s -> GroupByState a s -> Initial (GroupByState a s) b
forall s b. s -> Initial s b
IPartial (GroupByState a s -> Initial (GroupByState a s) b)
-> GroupByState a s -> Initial (GroupByState a s) b
forall a b. (a -> b) -> a -> b
$ s -> GroupByState a s
forall a s. s -> GroupByState a s
GroupByInit s
s
FL.Done b
b -> b -> Initial (GroupByState a s) b
forall s b. b -> Initial s b
IDone b
b
step :: GroupByState a s -> a -> m (Step (GroupByState a s) b)
step (GroupByInit s
s) a
a = s -> a -> m (Step (GroupByState a s) b)
grouper s
s a
a
step (GroupByGrouping a
a0 s
s) a
a =
if a -> a -> Bool
eq a
a0 a
a
then s -> a -> m (Step (GroupByState a s) b)
grouper s
s a
a
else Int -> b -> Step (GroupByState a s) b
forall s b. Int -> b -> Step s b
Done Int
1 (b -> Step (GroupByState a s) b)
-> m b -> m (Step (GroupByState a s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
s
extract :: GroupByState a s -> m b
extract (GroupByInit s
s) = s -> m b
fextract s
s
extract (GroupByGrouping a
_ s
s) = s -> m b
fextract s
s
{-# INLINE eqBy #-}
eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
eqBy :: (a -> a -> Bool) -> [a] -> Parser m a ()
eqBy a -> a -> Bool
cmp [a]
str = ([a] -> a -> m (Step [a] ()))
-> m (Initial [a] ()) -> ([a] -> m ()) -> Parser m a ()
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser [a] -> a -> m (Step [a] ())
forall (m :: * -> *). Monad m => [a] -> a -> m (Step [a] ())
step m (Initial [a] ())
forall b. m (Initial [a] b)
initial [a] -> m ()
forall (m :: * -> *) (t :: * -> *) a a.
(MonadThrow m, Foldable t) =>
t a -> m a
extract
where
initial :: m (Initial [a] b)
initial = Initial [a] b -> m (Initial [a] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial [a] b -> m (Initial [a] b))
-> Initial [a] b -> m (Initial [a] b)
forall a b. (a -> b) -> a -> b
$ [a] -> Initial [a] b
forall s b. s -> Initial s b
IPartial [a]
str
step :: [a] -> a -> m (Step [a] ())
step [] a
_ = Step [a] () -> m (Step [a] ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Step [a] () -> m (Step [a] ())) -> Step [a] () -> m (Step [a] ())
forall a b. (a -> b) -> a -> b
$ Int -> () -> Step [a] ()
forall s b. Int -> b -> Step s b
Done Int
0 ()
step [a
x] a
a =
Step [a] () -> m (Step [a] ())
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step [a] () -> m (Step [a] ())) -> Step [a] () -> m (Step [a] ())
forall a b. (a -> b) -> a -> b
$ if a
x a -> a -> Bool
`cmp` a
a
then Int -> () -> Step [a] ()
forall s b. Int -> b -> Step s b
Done Int
0 ()
else String -> Step [a] ()
forall s b. String -> Step s b
Error String
"eqBy: failed, yet to match the last element"
step (a
x:[a]
xs) a
a =
Step [a] () -> m (Step [a] ())
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step [a] () -> m (Step [a] ())) -> Step [a] () -> m (Step [a] ())
forall a b. (a -> b) -> a -> b
$ if a
x a -> a -> Bool
`cmp` a
a
then Int -> [a] -> Step [a] ()
forall s b. Int -> s -> Step s b
Continue Int
0 [a]
xs
else String -> Step [a] ()
forall s b. String -> Step s b
Error
(String -> Step [a] ()) -> String -> Step [a] ()
forall a b. (a -> b) -> a -> b
$ String
"eqBy: failed, yet to match "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements"
extract :: t a -> m a
extract t a
xs =
ParseError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
(ParseError -> m a) -> ParseError -> m a
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError
(String -> ParseError) -> String -> ParseError
forall a b. (a -> b) -> a -> b
$ String
"eqBy: end of input, yet to match "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements"
{-# INLINE span #-}
span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
span :: (a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
span a -> Bool
p Fold m a b
f1 Fold m a c
f2 = (b -> c -> (b, c))
-> Parser m a b -> Parser m a c -> Parser m a (b, c)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
noErrorUnsafeSplitWith (,) ((a -> Bool) -> Fold m a b -> Parser m a b
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Parser m a b
takeWhile a -> Bool
p Fold m a b
f1) (Fold m a c -> Parser m a c
forall (m :: * -> *) a b. Monad m => Fold m a b -> Parser m a b
fromFold Fold m a c
f2)
{-# INLINE spanBy #-}
spanBy ::
Monad m
=> (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
spanBy :: (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
spanBy a -> a -> Bool
eq Fold m a b
f1 Fold m a c
f2 = (b -> c -> (b, c))
-> Parser m a b -> Parser m a c -> Parser m a (b, c)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
noErrorUnsafeSplitWith (,) ((a -> a -> Bool) -> Fold m a b -> Parser m a b
forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Parser m a b
groupBy a -> a -> Bool
eq Fold m a b
f1) (Fold m a c -> Parser m a c
forall (m :: * -> *) a b. Monad m => Fold m a b -> Parser m a b
fromFold Fold m a c
f2)
{-# INLINE spanByRolling #-}
spanByRolling ::
Monad m
=> (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
spanByRolling :: (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (b, c)
spanByRolling a -> a -> Bool
eq Fold m a b
f1 Fold m a c
f2 =
(b -> c -> (b, c))
-> Parser m a b -> Parser m a c -> Parser m a (b, c)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
noErrorUnsafeSplitWith (,) ((a -> a -> Bool) -> Fold m a b -> Parser m a b
forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Parser m a b
groupByRolling a -> a -> Bool
eq Fold m a b
f1) (Fold m a c -> Parser m a c
forall (m :: * -> *) a b. Monad m => Fold m a b -> Parser m a b
fromFold Fold m a c
f2)
{-# INLINE lookAhead #-}
lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
lookAhead :: Parser m a b -> Parser m a b
lookAhead (Parser s -> a -> m (Step s b)
step1 m (Initial s b)
initial1 s -> m b
_) = (Tuple' Int s -> a -> m (Step (Tuple' Int s) b))
-> m (Initial (Tuple' Int s) b)
-> (Tuple' Int s -> m b)
-> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step m (Initial (Tuple' Int s) b)
initial Tuple' Int s -> m b
forall (m :: * -> *) a b a.
(MonadThrow m, Show a) =>
Tuple' a b -> m a
extract
where
initial :: m (Initial (Tuple' Int s) b)
initial = do
Initial s b
res <- m (Initial s b)
initial1
Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b))
-> Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Initial s b
res of
IPartial s
s -> Tuple' Int s -> Initial (Tuple' Int s) b
forall s b. s -> Initial s b
IPartial (Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
0 s
s)
IDone b
b -> b -> Initial (Tuple' Int s) b
forall s b. b -> Initial s b
IDone b
b
IError String
e -> String -> Initial (Tuple' Int s) b
forall s b. String -> Initial s b
IError String
e
step :: Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step (Tuple' Int
cnt s
st) a
a = do
Step s b
r <- s -> a -> m (Step s b)
step1 s
st a
a
let cnt1 :: Int
cnt1 = Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
Partial Int
n s
s -> Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Continue Int
n (Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
s)
Continue Int
n s
s -> Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
Continue Int
n (Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
s)
Done Int
_ b
b -> Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
Done Int
cnt1 b
b
Error String
err -> String -> Step (Tuple' Int s) b
forall s b. String -> Step s b
Error String
err
extract :: Tuple' a b -> m a
extract (Tuple' a
n b
_) =
ParseError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
(ParseError -> m a) -> ParseError -> m a
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError
(String -> ParseError) -> String -> ParseError
forall a b. (a -> b) -> a -> b
$ String
"lookAhead: end of input after consuming "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements"
{-# INLINE deintercalate #-}
deintercalate ::
Fold m a y -> Parser m x a
-> Fold m b z -> Parser m x b
-> Parser m x (y, z)
deintercalate :: Fold m a y
-> Parser m x a -> Fold m b z -> Parser m x b -> Parser m x (y, z)
deintercalate = Fold m a y
-> Parser m x a -> Fold m b z -> Parser m x b -> Parser m x (y, z)
forall a. HasCallStack => a
undefined
{-# INLINE sequence #-}
sequence ::
Fold m b c -> t (Parser m a b) -> Parser m a c
sequence :: Fold m b c -> t (Parser m a b) -> Parser m a c
sequence Fold m b c
_f t (Parser m a b)
_p = Parser m a c
forall a. HasCallStack => a
undefined
{-# INLINE choice #-}
choice ::
t (Parser m a b) -> Parser m a b
choice :: t (Parser m a b) -> Parser m a b
choice t (Parser m a b)
_ps = Parser m a b
forall a. HasCallStack => a
undefined
{-# INLINE many #-}
many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
many :: Parser m a b -> Fold m b c -> Parser m a c
many = Parser m a b -> Fold m b c -> Parser m a c
forall (m :: * -> *) a b c.
MonadCatch m =>
Parser m a b -> Fold m b c -> Parser m a c
splitMany
{-# INLINE some #-}
some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
some :: Parser m a b -> Fold m b c -> Parser m a c
some = Parser m a b -> Fold m b c -> Parser m a c
forall (m :: * -> *) a b c.
MonadCatch m =>
Parser m a b -> Fold m b c -> Parser m a c
splitSome
{-# INLINE countBetween #-}
countBetween ::
Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
countBetween :: Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
countBetween Int
_m Int
_n Parser m a b
_p = Fold m b c -> Parser m a c
forall a. HasCallStack => a
undefined
{-# INLINE count #-}
count ::
Int -> Parser m a b -> Fold m b c -> Parser m a c
count :: Int -> Parser m a b -> Fold m b c -> Parser m a c
count Int
n = Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
forall (m :: * -> *) a b c.
Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c
countBetween Int
n Int
n
data ManyTillState fs sr sl
= ManyTillR Int fs sr
| ManyTillL Int fs sl
{-# INLINE manyTill #-}
manyTill :: MonadCatch m
=> Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
manyTill :: Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
manyTill (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
fextract)
(Parser s -> a -> m (Step s b)
stepL m (Initial s b)
initialL s -> m b
extractL)
(Parser s -> a -> m (Step s x)
stepR m (Initial s x)
initialR s -> m x
_) =
(ManyTillState s s s -> a -> m (Step (ManyTillState s s s) c))
-> m (Initial (ManyTillState s s s) c)
-> (ManyTillState s s s -> m c)
-> Parser m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser ManyTillState s s s -> a -> m (Step (ManyTillState s s s) c)
step m (Initial (ManyTillState s s s) c)
initial ManyTillState s s s -> m c
forall sr. ManyTillState s sr s -> m c
extract
where
scrutL :: s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutL s
fs ManyTillState s s sl -> b
p ManyTillState s sr s -> b
c c -> b
d String -> b
e = do
Initial s b
resL <- m (Initial s b)
initialL
case Initial s b
resL of
IPartial s
sl -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ ManyTillState s sr s -> b
c (Int -> s -> s -> ManyTillState s sr s
forall fs sr sl. Int -> fs -> sl -> ManyTillState fs sr sl
ManyTillL Int
0 s
fs s
sl)
IDone b
bl -> do
Step s c
fr <- s -> b -> m (Step s c)
fstep s
fs b
bl
case Step s c
fr of
FL.Partial s
fs1 -> s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutR s
fs1 ManyTillState s s sl -> b
p ManyTillState s sr s -> b
c c -> b
d String -> b
e
FL.Done c
fb -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ c -> b
d c
fb
IError String
err -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ String -> b
e String
err
{-# INLINE scrutR #-}
scrutR :: s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutR s
fs ManyTillState s s sl -> b
p ManyTillState s sr s -> b
c c -> b
d String -> b
e = do
Initial s x
resR <- m (Initial s x)
initialR
case Initial s x
resR of
IPartial s
sr -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ ManyTillState s s sl -> b
p (Int -> s -> s -> ManyTillState s s sl
forall fs sr sl. Int -> fs -> sr -> ManyTillState fs sr sl
ManyTillR Int
0 s
fs s
sr)
IDone x
_ -> c -> b
d (c -> b) -> m c -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
fextract s
fs
IError String
_ -> s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutL s
fs ManyTillState s s sl -> b
p ManyTillState s sr s -> b
c c -> b
d String -> b
e
initial :: m (Initial (ManyTillState s s s) c)
initial = do
Step s c
res <- m (Step s c)
finitial
case Step s c
res of
FL.Partial s
fs -> s
-> (ManyTillState s s s -> Initial (ManyTillState s s s) c)
-> (ManyTillState s s s -> Initial (ManyTillState s s s) c)
-> (c -> Initial (ManyTillState s s s) c)
-> (String -> Initial (ManyTillState s s s) c)
-> m (Initial (ManyTillState s s s) c)
forall sl b sr.
s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutR s
fs ManyTillState s s s -> Initial (ManyTillState s s s) c
forall s b. s -> Initial s b
IPartial ManyTillState s s s -> Initial (ManyTillState s s s) c
forall s b. s -> Initial s b
IPartial c -> Initial (ManyTillState s s s) c
forall s b. b -> Initial s b
IDone String -> Initial (ManyTillState s s s) c
forall s b. String -> Initial s b
IError
FL.Done c
b -> Initial (ManyTillState s s s) c
-> m (Initial (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (ManyTillState s s s) c
-> m (Initial (ManyTillState s s s) c))
-> Initial (ManyTillState s s s) c
-> m (Initial (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ c -> Initial (ManyTillState s s s) c
forall s b. b -> Initial s b
IDone c
b
step :: ManyTillState s s s -> a -> m (Step (ManyTillState s s s) c)
step (ManyTillR Int
cnt s
fs s
st) a
a = do
Step s x
r <- s -> a -> m (Step s x)
stepR s
st a
a
case Step s x
r of
Partial Int
n s
s -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Partial Int
n (Int -> s -> s -> ManyTillState s s s
forall fs sr sl. Int -> fs -> sr -> ManyTillState fs sr sl
ManyTillR Int
0 s
fs s
s)
Continue Int
n s
s -> do
Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Continue Int
n (Int -> s -> s -> ManyTillState s s s
forall fs sr sl. Int -> fs -> sr -> ManyTillState fs sr sl
ManyTillR (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
fs s
s)
Done Int
n x
_ -> do
c
b <- s -> m c
fextract s
fs
Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (ManyTillState s s s) c
forall s b. Int -> b -> Step s b
Done Int
n c
b
Error String
_ -> do
Initial s b
resL <- m (Initial s b)
initialL
case Initial s b
resL of
IPartial s
sl ->
Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Continue (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> s -> s -> ManyTillState s s s
forall fs sr sl. Int -> fs -> sl -> ManyTillState fs sr sl
ManyTillL Int
0 s
fs s
sl)
IDone b
bl -> do
Step s c
fr <- s -> b -> m (Step s c)
fstep s
fs b
bl
let cnt1 :: Int
cnt1 = Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
p :: s -> Step s b
p = Int -> s -> Step s b
forall s b. Int -> s -> Step s b
Partial Int
cnt
c :: s -> Step s b
c = Int -> s -> Step s b
forall s b. Int -> s -> Step s b
Continue Int
cnt
d :: b -> Step s b
d = Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Done Int
cnt
case Step s c
fr of
FL.Partial s
fs1 -> s
-> (ManyTillState s s s -> Step (ManyTillState s s s) c)
-> (ManyTillState s s s -> Step (ManyTillState s s s) c)
-> (c -> Step (ManyTillState s s s) c)
-> (String -> Step (ManyTillState s s s) c)
-> m (Step (ManyTillState s s s) c)
forall sl b sr.
s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutR s
fs1 ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. s -> Step s b
p ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. s -> Step s b
c c -> Step (ManyTillState s s s) c
forall b s. b -> Step s b
d String -> Step (ManyTillState s s s) c
forall s b. String -> Step s b
Error
FL.Done c
fb -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (ManyTillState s s s) c
forall s b. Int -> b -> Step s b
Done Int
cnt1 c
fb
IError String
err -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (ManyTillState s s s) c
forall s b. String -> Step s b
Error String
err
step (ManyTillL Int
cnt s
fs s
st) a
a = do
Step s b
r <- s -> a -> m (Step s b)
stepL s
st a
a
case Step s b
r of
Partial Int
n s
s -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Partial Int
n (Int -> s -> s -> ManyTillState s s s
forall fs sr sl. Int -> fs -> sl -> ManyTillState fs sr sl
ManyTillL Int
0 s
fs s
s)
Continue Int
n s
s -> do
Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Continue Int
n (Int -> s -> s -> ManyTillState s s s
forall fs sr sl. Int -> fs -> sl -> ManyTillState fs sr sl
ManyTillL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
fs s
s)
Done Int
n b
b -> do
Step s c
fs1 <- s -> b -> m (Step s c)
fstep s
fs b
b
case Step s c
fs1 of
FL.Partial s
s ->
s
-> (ManyTillState s s s -> Step (ManyTillState s s s) c)
-> (ManyTillState s s s -> Step (ManyTillState s s s) c)
-> (c -> Step (ManyTillState s s s) c)
-> (String -> Step (ManyTillState s s s) c)
-> m (Step (ManyTillState s s s) c)
forall sl b sr.
s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutR s
s (Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Partial Int
n) (Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
Continue Int
n) (Int -> c -> Step (ManyTillState s s s) c
forall s b. Int -> b -> Step s b
Done Int
n) String -> Step (ManyTillState s s s) c
forall s b. String -> Step s b
Error
FL.Done c
b1 -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (ManyTillState s s s) c
forall s b. Int -> b -> Step s b
Done Int
n c
b1
Error String
err -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (ManyTillState s s s) c
forall s b. String -> Step s b
Error String
err
extract :: ManyTillState s sr s -> m c
extract (ManyTillL Int
_ s
fs s
sR) = do
Step s c
res <- s -> m b
extractL s
sR m b -> (b -> m (Step s c)) -> m (Step s c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> b -> m (Step s c)
fstep s
fs
case Step s c
res of
FL.Partial s
s -> s -> m c
fextract s
s
FL.Done c
b -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
b
extract (ManyTillR Int
_ s
fs sr
_) = s -> m c
fextract s
fs