{-# LANGUAGE UndecidableInstances #-}
#include "inline.hs"
module Streamly.Internal.Data.Parser.ParserD.Type
(
Initial (..)
, Step (..)
, Parser (..)
, ParseError (..)
, rmapM
, parser
, parserM
, fromPure
, fromEffect
, serialWith
, split_
, die
, dieM
, splitSome
, splitMany
, splitManyPost
, alt
, concatMap
, noErrorUnsafeSplit_
, noErrorUnsafeSplitWith
, noErrorUnsafeConcatMap
)
where
import Control.Applicative (Alternative(..), liftA2)
import Control.Exception (assert, Exception(..))
import Control.Monad (MonadPlus(..), (>=>))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader.Class (MonadReader, ask, local)
import Control.Monad.State.Class (MonadState, get, put)
import Control.Monad.Catch (MonadCatch, try, throwM, MonadThrow)
import Data.Bifunctor (Bifunctor(..))
import Fusion.Plugin.Types (Fuse(..))
import Streamly.Internal.Data.Fold.Type (Fold(..), toList)
import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))
import qualified Streamly.Internal.Data.Fold.Type as FL
import Prelude hiding (concatMap)
{-# ANN type Initial Fuse #-}
data Initial s b
= IPartial !s
| IDone !b
| IError String
instance Bifunctor Initial where
{-# INLINE bimap #-}
bimap :: forall a b c d. (a -> b) -> (c -> d) -> Initial a c -> Initial b d
bimap a -> b
f c -> d
_ (IPartial a
a) = forall s b. s -> Initial s b
IPartial (a -> b
f a
a)
bimap a -> b
_ c -> d
g (IDone c
b) = forall s b. b -> Initial s b
IDone (c -> d
g c
b)
bimap a -> b
_ c -> d
_ (IError String
err) = forall s b. String -> Initial s b
IError String
err
{-# INLINE first #-}
first :: forall a b c. (a -> b) -> Initial a c -> Initial b c
first a -> b
f (IPartial a
a) = forall s b. s -> Initial s b
IPartial (a -> b
f a
a)
first a -> b
_ (IDone c
x) = forall s b. b -> Initial s b
IDone c
x
first a -> b
_ (IError String
err) = forall s b. String -> Initial s b
IError String
err
{-# INLINE second #-}
second :: forall b c a. (b -> c) -> Initial a b -> Initial a c
second b -> c
_ (IPartial a
x) = forall s b. s -> Initial s b
IPartial a
x
second b -> c
f (IDone b
a) = forall s b. b -> Initial s b
IDone (b -> c
f b
a)
second b -> c
_ (IError String
err) = forall s b. String -> Initial s b
IError String
err
instance Functor (Initial s) where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> Initial s a -> Initial s b
fmap = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second
{-# ANN type Step Fuse #-}
data Step s b =
Partial Int s
| Continue Int s
| Done Int b
| Error String
instance Functor (Step s) where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> Step s a -> Step s b
fmap a -> b
_ (Partial Int
n s
s) = forall s b. Int -> s -> Step s b
Partial Int
n s
s
fmap a -> b
_ (Continue Int
n s
s) = forall s b. Int -> s -> Step s b
Continue Int
n s
s
fmap a -> b
f (Done Int
n a
b) = forall s b. Int -> b -> Step s b
Done Int
n (a -> b
f a
b)
fmap a -> b
_ (Error String
err) = forall s b. String -> Step s b
Error String
err
{-# INLINE mapMStep #-}
mapMStep :: Applicative m => (a -> m b) -> Step s a -> m (Step s b)
mapMStep :: forall (m :: * -> *) a b s.
Applicative m =>
(a -> m b) -> Step s a -> m (Step s b)
mapMStep a -> m b
f Step s a
res =
case Step s a
res of
Partial Int
n s
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Partial Int
n s
s
Done Int
n a
b -> forall s b. Int -> b -> Step s b
Done Int
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
b
Continue Int
n s
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n s
s
Error String
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s b. String -> Step s b
Error String
err
data Parser m a b =
forall s. Parser (s -> a -> m (Step s b)) (m (Initial s b)) (s -> m b)
newtype ParseError = ParseError String
deriving Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show
instance Exception ParseError where
displayException :: ParseError -> String
displayException (ParseError String
err) = String
err
instance Functor m => Functor (Parser m a) where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> Parser m a a -> Parser m a b
fmap a -> b
f (Parser s -> a -> m (Step s a)
step1 m (Initial s a)
initial1 s -> m a
extract) =
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 (forall {f :: * -> *} {f :: * -> *} {a} {b}.
(Functor f, Functor f) =>
(a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
f s -> m a
extract)
where
initial :: m (Initial s b)
initial = forall {f :: * -> *} {f :: * -> *} {a} {b}.
(Functor f, Functor f) =>
(a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
f m (Initial s a)
initial1
step :: s -> a -> m (Step s b)
step s
s a
b = forall {f :: * -> *} {f :: * -> *} {a} {b}.
(Functor f, Functor f) =>
(a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
f (s -> a -> m (Step s a)
step1 s
s a
b)
fmap2 :: (a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
g = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
g)
{-# INLINE parser #-}
parser :: Monad m => (b -> a -> Step b b) -> Initial b b -> Parser m a b
parser :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> Step b b) -> Initial b b -> Parser m a b
parser b -> a -> Step b b
step Initial b b
initial =
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser (\b
s a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ b -> a -> Step b b
step b
s a
a) (forall (m :: * -> *) a. Monad m => a -> m a
return Initial b b
initial) forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE parserM #-}
parserM ::
Monad m => (b -> a -> m (Step b b)) -> m (Initial b b) -> Parser m a b
parserM :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m (Step b b)) -> m (Initial b b) -> Parser m a b
parserM b -> a -> m (Step b b)
step m (Initial b b)
initial = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser b -> a -> m (Step b b)
step m (Initial b b)
initial forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE rmapM #-}
rmapM :: Monad m => (b -> m c) -> Parser m a b -> Parser m a c
rmapM :: forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Parser m a b -> Parser m a c
rmapM b -> m c
f (Parser s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m b
extract) = 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 c)
step1 m (Initial s c)
initial1 (s -> m b
extract forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> m c
f)
where
initial1 :: m (Initial s c)
initial1 = do
Initial s b
res <- m (Initial s b)
initial
case Initial s b
res of
IPartial s
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
IPartial s
x
IDone b
a -> forall s b. b -> Initial s b
IDone forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> m c
f b
a
IError String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Initial s b
IError String
err
step1 :: s -> a -> m (Step s c)
step1 s
s a
a = s -> a -> m (Step s b)
step s
s a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a b s.
Applicative m =>
(a -> m b) -> Step s a -> m (Step s b)
mapMStep b -> m c
f
{-# INLINE_NORMAL fromPure #-}
fromPure :: Monad m => b -> Parser m a b
fromPure :: forall (m :: * -> *) b a. Monad m => b -> Parser m a b
fromPure b
b = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser forall a. HasCallStack => a
undefined (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s b. b -> Initial s b
IDone b
b) forall a. HasCallStack => a
undefined
{-# INLINE fromEffect #-}
fromEffect :: Monad m => m b -> Parser m a b
fromEffect :: forall (m :: * -> *) b a. Monad m => m b -> Parser m a b
fromEffect m b
b = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser forall a. HasCallStack => a
undefined (forall s b. b -> Initial s b
IDone forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
b) forall a. HasCallStack => a
undefined
{-# ANN type SeqParseState Fuse #-}
data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr
{-# INLINE serialWith #-}
serialWith :: MonadThrow m
=> (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
serialWith :: forall (m :: * -> *) a b c x.
MonadThrow m =>
(a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
serialWith a -> b -> c
func (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m a
extractL)
(Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m b
extractR) =
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser SeqParseState s (b -> c) s
-> x -> m (Step (SeqParseState s (b -> c) s) c)
step m (Initial (SeqParseState s (b -> c) s) c)
initial SeqParseState s (b -> c) s -> m c
extract
where
initial :: m (Initial (SeqParseState s (b -> c) s) c)
initial = do
Initial s a
resL <- m (Initial s a)
initialL
case Initial s a
resL of
IPartial s
sl -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
sl
IDone a
bl -> do
Initial s b
resR <- m (Initial s b)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
IPartial s
sr -> forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR (a -> b -> c
func a
bl) s
sr
IDone b
br -> forall s b. b -> Initial s b
IDone (a -> b -> c
func a
bl b
br)
IError String
err -> forall s b. String -> Initial s b
IError String
err
IError String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Initial s b
IError String
err
step :: SeqParseState s (b -> c) s
-> x -> m (Step (SeqParseState s (b -> c) s) c)
step (SeqParseL s
st) x
a = do
Step s a
resL <- s -> x -> m (Step s a)
stepL s
st x
a
case Step s a
resL of
Partial Int
n s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
s)
Continue Int
n s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
s)
Done Int
n a
b -> do
Initial s b
initR <- m (Initial s b)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Initial s b
initR of
IPartial s
sr -> forall s b. Int -> s -> Step s b
Continue Int
n forall a b. (a -> b) -> a -> b
$ forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR (a -> b -> c
func a
b) s
sr
IDone b
br -> forall s b. Int -> b -> Step s b
Done Int
n (a -> b -> c
func a
b b
br)
IError String
err -> forall s b. String -> Step s b
Error String
err
Error String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Step s b
Error String
err
step (SeqParseR b -> c
f s
st) x
a = do
Step s b
resR <- s -> x -> m (Step s b)
stepR s
st x
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s b
resR of
Partial Int
n s
s -> forall s b. Int -> s -> Step s b
Partial Int
n (forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR b -> c
f s
s)
Continue Int
n s
s -> forall s b. Int -> s -> Step s b
Continue Int
n (forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR b -> c
f s
s)
Done Int
n b
b -> forall s b. Int -> b -> Step s b
Done Int
n (b -> c
f b
b)
Error String
err -> forall s b. String -> Step s b
Error String
err
extract :: SeqParseState s (b -> c) s -> m c
extract (SeqParseR b -> c
f s
sR) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f (s -> m b
extractR s
sR)
extract (SeqParseL s
sL) = do
a
rL <- s -> m a
extractL s
sL
Initial s b
res <- m (Initial s b)
initialR
case Initial s b
res of
IPartial s
sR -> do
b
rR <- s -> m b
extractR s
sR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b -> c
func a
rL b
rR
IDone b
rR -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b -> c
func a
rL b
rR
IError String
err -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err
{-# INLINE noErrorUnsafeSplitWith #-}
noErrorUnsafeSplitWith :: Monad m
=> (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
noErrorUnsafeSplitWith :: 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 -> b -> c
func (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m a
extractL)
(Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m b
extractR) =
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser SeqParseState s (b -> c) s
-> x -> m (Step (SeqParseState s (b -> c) s) c)
step m (Initial (SeqParseState s (b -> c) s) c)
initial SeqParseState s (b -> c) s -> m c
extract
where
initial :: m (Initial (SeqParseState s (b -> c) s) c)
initial = do
Initial s a
resL <- m (Initial s a)
initialL
case Initial s a
resL of
IPartial s
sl -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
sl
IDone a
bl -> do
Initial s b
resR <- m (Initial s b)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
IPartial s
sr -> forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR (a -> b -> c
func a
bl) s
sr
IDone b
br -> forall s b. b -> Initial s b
IDone (a -> b -> c
func a
bl b
br)
IError String
err -> forall s b. String -> Initial s b
IError String
err
IError String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Initial s b
IError String
err
step :: SeqParseState s (b -> c) s
-> x -> m (Step (SeqParseState s (b -> c) s) c)
step (SeqParseL s
st) x
a = do
Step s a
r <- s -> x -> m (Step s a)
stepL s
st x
a
case Step s a
r of
Partial Int
n s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Partial Int
n (forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
s)
Continue Int
n s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
s)
Done Int
n a
b -> do
Initial s b
res <- m (Initial s b)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return
forall a b. (a -> b) -> a -> b
$ case Initial s b
res of
IPartial s
sr -> forall s b. Int -> s -> Step s b
Partial Int
n forall a b. (a -> b) -> a -> b
$ forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR (a -> b -> c
func a
b) s
sr
IDone b
br -> forall s b. Int -> b -> Step s b
Done Int
n (a -> b -> c
func a
b b
br)
IError String
err -> forall s b. String -> Step s b
Error String
err
Error String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Step s b
Error String
err
step (SeqParseR b -> c
f s
st) x
a = do
Step s b
r <- s -> x -> m (Step s b)
stepR s
st x
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s b
r of
Partial Int
n s
s -> forall s b. Int -> s -> Step s b
Partial Int
n (forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR b -> c
f s
s)
Continue Int
n s
s -> forall s b. Int -> s -> Step s b
Continue Int
n (forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR b -> c
f s
s)
Done Int
n b
b -> forall s b. Int -> b -> Step s b
Done Int
n (b -> c
f b
b)
Error String
err -> forall s b. String -> Step s b
Error String
err
extract :: SeqParseState s (b -> c) s -> m c
extract (SeqParseR b -> c
f s
sR) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f (s -> m b
extractR s
sR)
extract (SeqParseL s
sL) = do
a
rL <- s -> m a
extractL s
sL
Initial s b
res <- m (Initial s b)
initialR
case Initial s b
res of
IPartial s
sR -> do
b
rR <- s -> m b
extractR s
sR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b -> c
func a
rL b
rR
IDone b
rR -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b -> c
func a
rL b
rR
IError String
err -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"noErrorUnsafeSplitWith: cannot use a "
forall a. [a] -> [a] -> [a]
++ String
"failing parser. Parser failed with: " forall a. [a] -> [a] -> [a]
++ String
err
{-# ANN type SeqAState Fuse #-}
data SeqAState sl sr = SeqAL sl | SeqAR sr
{-# INLINE split_ #-}
split_ :: MonadThrow m => Parser m x a -> Parser m x b -> Parser m x b
split_ :: forall (m :: * -> *) x a b.
MonadThrow m =>
Parser m x a -> Parser m x b -> Parser m x b
split_ (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m a
extractL) (Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m b
extractR) =
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser SeqAState s s -> x -> m (Step (SeqAState s s) b)
step m (Initial (SeqAState s s) b)
initial SeqAState s s -> m b
extract
where
initial :: m (Initial (SeqAState s s) b)
initial = do
Initial s a
resL <- m (Initial s a)
initialL
case Initial s a
resL of
IPartial s
sl -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl sr. sl -> SeqAState sl sr
SeqAL s
sl
IDone a
_ -> do
Initial s b
resR <- m (Initial s b)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
IPartial s
sr -> forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl sr. sr -> SeqAState sl sr
SeqAR s
sr
IDone b
br -> forall s b. b -> Initial s b
IDone b
br
IError String
err -> forall s b. String -> Initial s b
IError String
err
IError String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Initial s b
IError String
err
step :: SeqAState s s -> x -> m (Step (SeqAState s s) b)
step (SeqAL s
st) x
a = do
Step s a
resL <- s -> x -> m (Step s a)
stepL s
st x
a
case Step s a
resL of
Partial Int
n s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall sl sr. sl -> SeqAState sl sr
SeqAL s
s)
Continue Int
n s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall sl sr. sl -> SeqAState sl sr
SeqAL s
s)
Done Int
n a
_ -> do
Initial s b
initR <- m (Initial s b)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Initial s b
initR of
IPartial s
s -> forall s b. Int -> s -> Step s b
Continue Int
n (forall sl sr. sr -> SeqAState sl sr
SeqAR s
s)
IDone b
b -> forall s b. Int -> b -> Step s b
Done Int
n b
b
IError String
err -> forall s b. String -> Step s b
Error String
err
Error String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Step s b
Error String
err
step (SeqAR s
st) x
a =
(\case
Partial Int
n s
s -> forall s b. Int -> s -> Step s b
Partial Int
n (forall sl sr. sr -> SeqAState sl sr
SeqAR s
s)
Continue Int
n s
s -> forall s b. Int -> s -> Step s b
Continue Int
n (forall sl sr. sr -> SeqAState sl sr
SeqAR s
s)
Done Int
n b
b -> forall s b. Int -> b -> Step s b
Done Int
n b
b
Error String
err -> forall s b. String -> Step s b
Error String
err) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> x -> m (Step s b)
stepR s
st x
a
extract :: SeqAState s s -> m b
extract (SeqAR s
sR) = s -> m b
extractR s
sR
extract (SeqAL s
sL) = do
a
_ <- s -> m a
extractL s
sL
Initial s b
res <- m (Initial s b)
initialR
case Initial s b
res of
IPartial s
sR -> s -> m b
extractR s
sR
IDone b
rR -> forall (m :: * -> *) a. Monad m => a -> m a
return b
rR
IError String
err -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err
{-# INLINE noErrorUnsafeSplit_ #-}
noErrorUnsafeSplit_ :: MonadThrow m => Parser m x a -> Parser m x b -> Parser m x b
noErrorUnsafeSplit_ :: forall (m :: * -> *) x a b.
MonadThrow m =>
Parser m x a -> Parser m x b -> Parser m x b
noErrorUnsafeSplit_ (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m a
extractL) (Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m b
extractR) =
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser SeqAState s s -> x -> m (Step (SeqAState s s) b)
step m (Initial (SeqAState s s) b)
initial SeqAState s s -> m b
extract
where
initial :: m (Initial (SeqAState s s) b)
initial = do
Initial s a
resL <- m (Initial s a)
initialL
case Initial s a
resL of
IPartial s
sl -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl sr. sl -> SeqAState sl sr
SeqAL s
sl
IDone a
_ -> do
Initial s b
resR <- m (Initial s b)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
IPartial s
sr -> forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl sr. sr -> SeqAState sl sr
SeqAR s
sr
IDone b
br -> forall s b. b -> Initial s b
IDone b
br
IError String
err -> forall s b. String -> Initial s b
IError String
err
IError String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Initial s b
IError String
err
step :: SeqAState s s -> x -> m (Step (SeqAState s s) b)
step (SeqAL s
st) x
a = do
Step s a
resL <- s -> x -> m (Step s a)
stepL s
st x
a
case Step s a
resL of
Partial Int
n s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Partial Int
n (forall sl sr. sl -> SeqAState sl sr
SeqAL s
s)
Continue Int
n s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall sl sr. sl -> SeqAState sl sr
SeqAL s
s)
Done Int
n a
_ -> do
Initial s b
initR <- m (Initial s b)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Initial s b
initR of
IPartial s
s -> forall s b. Int -> s -> Step s b
Partial Int
n (forall sl sr. sr -> SeqAState sl sr
SeqAR s
s)
IDone b
b -> forall s b. Int -> b -> Step s b
Done Int
n b
b
IError String
err -> forall s b. String -> Step s b
Error String
err
Error String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Step s b
Error String
err
step (SeqAR s
st) x
a =
(\case
Partial Int
n s
s -> forall s b. Int -> s -> Step s b
Partial Int
n (forall sl sr. sr -> SeqAState sl sr
SeqAR s
s)
Continue Int
n s
s -> forall s b. Int -> s -> Step s b
Continue Int
n (forall sl sr. sr -> SeqAState sl sr
SeqAR s
s)
Done Int
n b
b -> forall s b. Int -> b -> Step s b
Done Int
n b
b
Error String
err -> forall s b. String -> Step s b
Error String
err) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> x -> m (Step s b)
stepR s
st x
a
extract :: SeqAState s s -> m b
extract (SeqAR s
sR) = s -> m b
extractR s
sR
extract (SeqAL s
sL) = do
a
_ <- s -> m a
extractL s
sL
Initial s b
res <- m (Initial s b)
initialR
case Initial s b
res of
IPartial s
sR -> s -> m b
extractR s
sR
IDone b
rR -> forall (m :: * -> *) a. Monad m => a -> m a
return b
rR
IError String
err -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err
instance MonadThrow m => Applicative (Parser m a) where
{-# INLINE pure #-}
pure :: forall a. a -> Parser m a a
pure = forall (m :: * -> *) b a. Monad m => b -> Parser m a b
fromPure
{-# INLINE (<*>) #-}
<*> :: forall a b. Parser m a (a -> b) -> Parser m a a -> Parser m a b
(<*>) = forall (m :: * -> *) a b c x.
MonadThrow m =>
(a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
serialWith forall a. a -> a
id
{-# INLINE (*>) #-}
*> :: forall a b. Parser m a a -> Parser m a b -> Parser m a b
(*>) = forall (m :: * -> *) x a b.
MonadThrow m =>
Parser m x a -> Parser m x b -> Parser m x b
split_
#if MIN_VERSION_base(4,10,0)
{-# INLINE liftA2 #-}
liftA2 :: forall a b c.
(a -> b -> c) -> Parser m a a -> Parser m a b -> Parser m a c
liftA2 a -> b -> c
f Parser m a a
x = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b -> c
f Parser m a a
x)
#endif
{-# ANN type AltParseState Fuse #-}
data AltParseState sl sr = AltParseL Int sl | AltParseR sr
{-# INLINE alt #-}
alt :: Monad m => Parser m x a -> Parser m x a -> Parser m x a
alt :: forall (m :: * -> *) x a.
Monad m =>
Parser m x a -> Parser m x a -> Parser m x a
alt (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m a
extractL) (Parser s -> x -> m (Step s a)
stepR m (Initial s a)
initialR s -> m a
extractR) =
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser AltParseState s s -> x -> m (Step (AltParseState s s) a)
step m (Initial (AltParseState s s) a)
initial AltParseState s s -> m a
extract
where
initial :: m (Initial (AltParseState s s) a)
initial = do
Initial s a
resL <- m (Initial s a)
initialL
case Initial s a
resL of
IPartial s
sl -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl sr. Int -> sl -> AltParseState sl sr
AltParseL Int
0 s
sl
IDone a
bl -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. b -> Initial s b
IDone a
bl
IError String
_ -> do
Initial s a
resR <- m (Initial s a)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Initial s a
resR of
IPartial s
sr -> forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl sr. sr -> AltParseState sl sr
AltParseR s
sr
IDone a
br -> forall s b. b -> Initial s b
IDone a
br
IError String
err -> forall s b. String -> Initial s b
IError String
err
step :: AltParseState s s -> x -> m (Step (AltParseState s s) a)
step (AltParseL Int
cnt s
st) x
a = do
Step s a
r <- s -> x -> m (Step s a)
stepL s
st x
a
case Step s a
r of
Partial Int
n s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Partial Int
n (forall sl sr. Int -> sl -> AltParseState sl sr
AltParseL Int
0 s
s)
Continue Int
n s
s -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall sl sr. Int -> sl -> AltParseState sl sr
AltParseL (Int
cnt forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
- Int
n) s
s)
Done Int
n a
b -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> b -> Step s b
Done Int
n a
b
Error String
_ -> do
Initial s a
res <- m (Initial s a)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return
forall a b. (a -> b) -> a -> b
$ case Initial s a
res of
IPartial s
rR -> forall s b. Int -> s -> Step s b
Continue (Int
cnt forall a. Num a => a -> a -> a
+ Int
1) (forall sl sr. sr -> AltParseState sl sr
AltParseR s
rR)
IDone a
b -> forall s b. Int -> b -> Step s b
Done (Int
cnt forall a. Num a => a -> a -> a
+ Int
1) a
b
IError String
err -> forall s b. String -> Step s b
Error String
err
step (AltParseR s
st) x
a = do
Step s a
r <- s -> x -> m (Step s a)
stepR s
st x
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s a
r of
Partial Int
n s
s -> forall s b. Int -> s -> Step s b
Partial Int
n (forall sl sr. sr -> AltParseState sl sr
AltParseR s
s)
Continue Int
n s
s -> forall s b. Int -> s -> Step s b
Continue Int
n (forall sl sr. sr -> AltParseState sl sr
AltParseR s
s)
Done Int
n a
b -> forall s b. Int -> b -> Step s b
Done Int
n a
b
Error String
err -> forall s b. String -> Step s b
Error String
err
extract :: AltParseState s s -> m a
extract (AltParseR s
sR) = s -> m a
extractR s
sR
extract (AltParseL Int
_ s
sL) = s -> m a
extractL s
sL
{-# INLINE splitMany #-}
splitMany :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
splitMany :: forall (m :: * -> *) a b c.
MonadCatch m =>
Parser m a b -> Fold m b c -> Parser m a c
splitMany (Parser s -> a -> m (Step s b)
step1 m (Initial s b)
initial1 s -> m b
extract1) (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
fextract) =
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser Tuple3' s Int s -> a -> m (Step (Tuple3' s Int s) c)
step m (Initial (Tuple3' s Int s) c)
initial forall {a}. (Eq a, Num a) => Tuple3' s a s -> m c
extract
where
handleCollect :: (Tuple3' s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect Tuple3' s b s -> b
partial c -> b
done Step s c
fres =
case Step s c
fres of
FL.Partial s
fs -> do
Initial s b
pres <- m (Initial s b)
initial1
case Initial s b
pres of
IPartial s
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Tuple3' s b s -> b
partial forall a b. (a -> b) -> a -> b
$ forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
ps b
0 s
fs
IDone b
pb ->
forall {b}. (Step s c -> m b) -> s -> b -> m b
runCollectorWith ((Tuple3' s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect Tuple3' s b s -> b
partial c -> b
done) s
fs b
pb
IError String
_ -> c -> b
done forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
fextract s
fs
FL.Done c
fb -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ c -> b
done c
fb
runCollectorWith :: (Step s c -> m b) -> s -> b -> m b
runCollectorWith Step s c -> m b
cont s
fs b
pb = s -> b -> m (Step s c)
fstep s
fs b
pb forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Step s c -> m b
cont
initial :: m (Initial (Tuple3' s Int s) c)
initial = m (Step s c)
finitial forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b} {b}.
Num b =>
(Tuple3' s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect forall s b. s -> Initial s b
IPartial forall s b. b -> Initial s b
IDone
{-# INLINE step #-}
step :: Tuple3' s Int s -> a -> m (Step (Tuple3' s Int s) c)
step (Tuple3' s
st Int
cnt s
fs) a
a = do
Step s b
r <- s -> a -> m (Step s b)
step1 s
st a
a
let cnt1 :: Int
cnt1 = Int
cnt forall a. Num a => a -> a -> a
+ Int
1
case Step s b
r of
Partial Int
n s
s -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n) s
fs)
Continue Int
n s
s -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n) s
fs)
Done Int
n b
b -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
s -> b -> m (Step s c)
fstep s
fs b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b} {b}.
Num b =>
(Tuple3' s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect (forall s b. Int -> s -> Step s b
Partial Int
n) (forall s b. Int -> b -> Step s b
Done Int
n)
Error String
_ -> do
c
xs <- s -> m c
fextract s
fs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> b -> Step s b
Done Int
cnt1 c
xs
extract :: Tuple3' s a s -> m c
extract (Tuple3' s
_ a
0 s
fs) = s -> m c
fextract s
fs
extract (Tuple3' s
s a
_ s
fs) = do
Either ParseError b
r <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ s -> m b
extract1 s
s
case Either ParseError b
r of
Left (ParseError
_ :: ParseError) -> s -> m c
fextract s
fs
Right 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
s1 -> s -> m c
fextract s
s1
FL.Done c
b1 -> forall (m :: * -> *) a. Monad m => a -> m a
return c
b1
{-# INLINE splitManyPost #-}
splitManyPost :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
splitManyPost :: forall (m :: * -> *) a b c.
MonadCatch m =>
Parser m a b -> Fold m b c -> Parser m a c
splitManyPost (Parser s -> a -> m (Step s b)
step1 m (Initial s b)
initial1 s -> m b
extract1) (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
fextract) =
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser Tuple3' s Int s -> a -> m (Step (Tuple3' s Int s) c)
step m (Initial (Tuple3' s Int s) c)
initial forall {b}. Tuple3' s b s -> m c
extract
where
handleCollect :: (Tuple3' s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect Tuple3' s b s -> b
partial c -> b
done Step s c
fres =
case Step s c
fres of
FL.Partial s
fs -> do
Initial s b
pres <- m (Initial s b)
initial1
case Initial s b
pres of
IPartial s
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Tuple3' s b s -> b
partial forall a b. (a -> b) -> a -> b
$ forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
ps b
0 s
fs
IDone b
pb ->
forall {b}. (Step s c -> m b) -> s -> b -> m b
runCollectorWith ((Tuple3' s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect Tuple3' s b s -> b
partial c -> b
done) s
fs b
pb
IError String
_ -> c -> b
done forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
fextract s
fs
FL.Done c
fb -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ c -> b
done c
fb
runCollectorWith :: (Step s c -> m b) -> s -> b -> m b
runCollectorWith Step s c -> m b
cont s
fs b
pb = s -> b -> m (Step s c)
fstep s
fs b
pb forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Step s c -> m b
cont
initial :: m (Initial (Tuple3' s Int s) c)
initial = m (Step s c)
finitial forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b} {b}.
Num b =>
(Tuple3' s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect forall s b. s -> Initial s b
IPartial forall s b. b -> Initial s b
IDone
{-# INLINE step #-}
step :: Tuple3' s Int s -> a -> m (Step (Tuple3' s Int s) c)
step (Tuple3' s
st Int
cnt s
fs) a
a = do
Step s b
r <- s -> a -> m (Step s b)
step1 s
st a
a
let cnt1 :: Int
cnt1 = Int
cnt forall a. Num a => a -> a -> a
+ Int
1
case Step s b
r of
Partial Int
n s
s -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n) s
fs)
Continue Int
n s
s -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n) s
fs)
Done Int
n b
b -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
s -> b -> m (Step s c)
fstep s
fs b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b} {b}.
Num b =>
(Tuple3' s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect (forall s b. Int -> s -> Step s b
Partial Int
n) (forall s b. Int -> b -> Step s b
Done Int
n)
Error String
_ -> do
c
xs <- s -> m c
fextract s
fs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> b -> Step s b
Done Int
cnt1 c
xs
extract :: Tuple3' s b s -> m c
extract (Tuple3' s
s b
_ s
fs) = do
Either ParseError b
r <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ s -> m b
extract1 s
s
case Either ParseError b
r of
Left (ParseError
_ :: ParseError) -> s -> m c
fextract s
fs
Right 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
s1 -> s -> m c
fextract s
s1
FL.Done c
b1 -> forall (m :: * -> *) a. Monad m => a -> m a
return c
b1
{-# INLINE splitSome #-}
splitSome :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
splitSome :: forall (m :: * -> *) a b c.
MonadCatch m =>
Parser m a b -> Fold m b c -> Parser m a c
splitSome (Parser s -> a -> m (Step s b)
step1 m (Initial s b)
initial1 s -> m b
extract1) (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
fextract) =
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser Tuple3' s Int (Either s s)
-> a -> m (Step (Tuple3' s Int (Either s s)) c)
step m (Initial (Tuple3' s Int (Either s s)) c)
initial forall {b}. Tuple3' s b (Either s s) -> m c
extract
where
handleCollect :: (Tuple3' s b (Either a s) -> b) -> (c -> b) -> Step s c -> m b
handleCollect Tuple3' s b (Either a s) -> b
partial c -> b
done Step s c
fres =
case Step s c
fres of
FL.Partial s
fs -> do
Initial s b
pres <- m (Initial s b)
initial1
case Initial s b
pres of
IPartial s
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Tuple3' s b (Either a s) -> b
partial forall a b. (a -> b) -> a -> b
$ forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
ps b
0 forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right s
fs
IDone b
pb ->
forall {b}. (Step s c -> m b) -> s -> b -> m b
runCollectorWith ((Tuple3' s b (Either a s) -> b) -> (c -> b) -> Step s c -> m b
handleCollect Tuple3' s b (Either a s) -> b
partial c -> b
done) s
fs b
pb
IError String
_ -> c -> b
done forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
fextract s
fs
FL.Done c
fb -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ c -> b
done c
fb
runCollectorWith :: (Step s c -> m b) -> s -> b -> m b
runCollectorWith Step s c -> m b
cont s
fs b
pb = s -> b -> m (Step s c)
fstep s
fs b
pb forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Step s c -> m b
cont
initial :: m (Initial (Tuple3' s Int (Either s s)) c)
initial = do
Step s c
fres <- m (Step s c)
finitial
case Step s c
fres of
FL.Partial s
fs -> do
Initial s b
pres <- m (Initial s b)
initial1
case Initial s b
pres of
IPartial s
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
ps Int
0 forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left s
fs
IDone b
pb ->
forall {b}. (Step s c -> m b) -> s -> b -> m b
runCollectorWith (forall {b} {a} {b}.
Num b =>
(Tuple3' s b (Either a s) -> b) -> (c -> b) -> Step s c -> m b
handleCollect forall s b. s -> Initial s b
IPartial forall s b. b -> Initial s b
IDone) s
fs b
pb
IError String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Initial s b
IError String
err
FL.Done c
_ ->
forall (m :: * -> *) a. Monad m => a -> m a
return
forall a b. (a -> b) -> a -> b
$ forall s b. String -> Initial s b
IError
forall a b. (a -> b) -> a -> b
$ String
"splitSome: The collecting fold terminated without"
forall a. [a] -> [a] -> [a]
++ String
" consuming any elements."
{-# INLINE step #-}
step :: Tuple3' s Int (Either s s)
-> a -> m (Step (Tuple3' s Int (Either s s)) c)
step (Tuple3' s
st Int
cnt (Left s
fs)) a
a = do
Step s b
r <- s -> a -> m (Step s b)
step1 s
st a
a
let cnt1 :: Int
cnt1 = Int
cnt forall a. Num a => a -> a -> a
+ Int
1
case Step s b
r of
Partial Int
n s
s -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n) (forall a b. a -> Either a b
Left s
fs))
Continue Int
n s
s -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n) (forall a b. a -> Either a b
Left s
fs))
Done Int
n b
b -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
s -> b -> m (Step s c)
fstep s
fs b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b} {a} {b}.
Num b =>
(Tuple3' s b (Either a s) -> b) -> (c -> b) -> Step s c -> m b
handleCollect (forall s b. Int -> s -> Step s b
Partial Int
n) (forall s b. Int -> b -> Step s b
Done Int
n)
Error String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Step s b
Error String
err
step (Tuple3' s
st Int
cnt (Right s
fs)) a
a = do
Step s b
r <- s -> a -> m (Step s b)
step1 s
st a
a
let cnt1 :: Int
cnt1 = Int
cnt forall a. Num a => a -> a -> a
+ Int
1
case Step s b
r of
Partial Int
n s
s -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Partial Int
n (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n) (forall a b. b -> Either a b
Right s
fs))
Continue Int
n s
s -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n) (forall a b. b -> Either a b
Right s
fs))
Done Int
n b
b -> do
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 forall a. Num a => a -> a -> a
- Int
n forall a. Ord a => a -> a -> Bool
>= Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
s -> b -> m (Step s c)
fstep s
fs b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b} {a} {b}.
Num b =>
(Tuple3' s b (Either a s) -> b) -> (c -> b) -> Step s c -> m b
handleCollect (forall s b. Int -> s -> Step s b
Partial Int
n) (forall s b. Int -> b -> Step s b
Done Int
n)
Error String
_ -> forall s b. Int -> b -> Step s b
Done Int
cnt1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
fextract s
fs
extract :: Tuple3' s b (Either s s) -> m c
extract (Tuple3' s
s b
_ (Left s
fs)) = do
b
b <- s -> m b
extract1 s
s
Step s c
fs1 <- s -> b -> m (Step s c)
fstep s
fs b
b
case Step s c
fs1 of
FL.Partial s
s1 -> s -> m c
fextract s
s1
FL.Done c
b1 -> forall (m :: * -> *) a. Monad m => a -> m a
return c
b1
extract (Tuple3' s
s b
_ (Right s
fs)) = do
Either ParseError b
r <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ s -> m b
extract1 s
s
case Either ParseError b
r of
Left (ParseError
_ :: ParseError) -> s -> m c
fextract s
fs
Right 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
s1 -> s -> m c
fextract s
s1
FL.Done c
b1 -> forall (m :: * -> *) a. Monad m => a -> m a
return c
b1
{-# INLINE_NORMAL die #-}
die :: MonadThrow m => String -> Parser m a b
die :: forall (m :: * -> *) a b. MonadThrow m => String -> Parser m a b
die String
err = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser forall a. HasCallStack => a
undefined (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s b. String -> Initial s b
IError String
err)) forall a. HasCallStack => a
undefined
{-# INLINE dieM #-}
dieM :: MonadThrow m => m String -> Parser m a b
dieM :: forall (m :: * -> *) a b. MonadThrow m => m String -> Parser m a b
dieM m String
err = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser forall a. HasCallStack => a
undefined (forall s b. String -> Initial s b
IError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
err) forall a. HasCallStack => a
undefined
instance MonadCatch m => Alternative (Parser m a) where
{-# INLINE empty #-}
empty :: forall a. Parser m a a
empty = forall (m :: * -> *) a b. MonadThrow m => String -> Parser m a b
die String
"empty"
{-# INLINE (<|>) #-}
<|> :: forall a. Parser m a a -> Parser m a a -> Parser m a a
(<|>) = forall (m :: * -> *) x a.
Monad m =>
Parser m x a -> Parser m x a -> Parser m x a
alt
{-# INLINE many #-}
many :: forall a. Parser m a a -> Parser m a [a]
many = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b c.
MonadCatch m =>
Parser m a b -> Fold m b c -> Parser m a c
splitMany forall (m :: * -> *) a. Monad m => Fold m a [a]
toList
{-# INLINE some #-}
some :: forall a. Parser m a a -> Parser m a [a]
some = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b c.
MonadCatch m =>
Parser m a b -> Fold m b c -> Parser m a c
splitSome forall (m :: * -> *) a. Monad m => Fold m a [a]
toList
{-# ANN type ConcatParseState Fuse #-}
data ConcatParseState sl m a b =
ConcatParseL sl
| forall s. ConcatParseR (s -> a -> m (Step s b)) s (s -> m b)
{-# INLINE concatMap #-}
concatMap :: MonadThrow m =>
(b -> Parser m a c) -> Parser m a b -> Parser m a c
concatMap :: forall (m :: * -> *) b a c.
MonadThrow m =>
(b -> Parser m a c) -> Parser m a b -> Parser m a c
concatMap b -> Parser m a c
func (Parser s -> a -> m (Step s b)
stepL m (Initial s b)
initialL s -> m b
extractL) = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser ConcatParseState s m a c
-> a -> m (Step (ConcatParseState s m a c) c)
step m (Initial (ConcatParseState s m a c) c)
initial forall {a}. ConcatParseState s m a c -> m c
extract
where
{-# INLINE initializeR #-}
initializeR :: Parser m a b -> m (Initial (ConcatParseState sl m a b) b)
initializeR (Parser s -> a -> m (Step s b)
stepR m (Initial s b)
initialR s -> m b
extractR) = do
Initial s b
resR <- m (Initial s b)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
IPartial s
sr -> forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
sr s -> m b
extractR
IDone b
br -> forall s b. b -> Initial s b
IDone b
br
IError String
err -> forall s b. String -> Initial s b
IError String
err
initial :: m (Initial (ConcatParseState s m a c) c)
initial = do
Initial s b
res <- m (Initial s b)
initialL
case Initial s b
res of
IPartial s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s
IDone b
b -> forall {m :: * -> *} {a} {b} {sl}.
Monad m =>
Parser m a b -> m (Initial (ConcatParseState sl m a b) b)
initializeR (b -> Parser m a c
func b
b)
IError String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Initial s b
IError String
err
{-# INLINE initializeRL #-}
initializeRL :: Int -> Parser m a b -> m (Step (ConcatParseState sl m a b) b)
initializeRL Int
n (Parser s -> a -> m (Step s b)
stepR m (Initial s b)
initialR s -> m b
extractR) = do
Initial s b
resR <- m (Initial s b)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
IPartial s
sr -> forall s b. Int -> s -> Step s b
Continue Int
n forall a b. (a -> b) -> a -> b
$ forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
sr s -> m b
extractR
IDone b
br -> forall s b. Int -> b -> Step s b
Done Int
n b
br
IError String
err -> forall s b. String -> Step s b
Error String
err
step :: ConcatParseState s m a c
-> a -> m (Step (ConcatParseState s m a c) c)
step (ConcatParseL 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s)
Continue Int
n s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s)
Done Int
n b
b -> forall {m :: * -> *} {a} {b} {sl}.
Monad m =>
Int -> Parser m a b -> m (Step (ConcatParseState sl m a b) b)
initializeRL Int
n (b -> Parser m a c
func b
b)
Error String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Step s b
Error String
err
step (ConcatParseR s -> a -> m (Step s c)
stepR s
st s -> m c
extractR) a
a = do
Step s c
r <- s -> a -> m (Step s c)
stepR s
st a
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s c
r of
Partial Int
n s
s -> forall s b. Int -> s -> Step s b
Partial Int
n forall a b. (a -> b) -> a -> b
$ forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m c
extractR
Continue Int
n s
s -> forall s b. Int -> s -> Step s b
Continue Int
n forall a b. (a -> b) -> a -> b
$ forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m c
extractR
Done Int
n c
b -> forall s b. Int -> b -> Step s b
Done Int
n c
b
Error String
err -> forall s b. String -> Step s b
Error String
err
{-# INLINE extractP #-}
extractP :: Parser m a b -> m b
extractP (Parser s -> a -> m (Step s b)
_ m (Initial s b)
initialR s -> m b
extractR) = do
Initial s b
res <- m (Initial s b)
initialR
case Initial s b
res of
IPartial s
s -> s -> m b
extractR s
s
IDone b
b -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b
IError String
err -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err
extract :: ConcatParseState s m a c -> m c
extract (ConcatParseR s -> a -> m (Step s c)
_ s
s s -> m c
extractR) = s -> m c
extractR s
s
extract (ConcatParseL s
sL) = s -> m b
extractL s
sL forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {a} {b}. MonadThrow m => Parser m a b -> m b
extractP forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Parser m a c
func
{-# INLINE noErrorUnsafeConcatMap #-}
noErrorUnsafeConcatMap :: MonadThrow m =>
(b -> Parser m a c) -> Parser m a b -> Parser m a c
noErrorUnsafeConcatMap :: forall (m :: * -> *) b a c.
MonadThrow m =>
(b -> Parser m a c) -> Parser m a b -> Parser m a c
noErrorUnsafeConcatMap b -> Parser m a c
func (Parser s -> a -> m (Step s b)
stepL m (Initial s b)
initialL s -> m b
extractL) =
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser ConcatParseState s m a c
-> a -> m (Step (ConcatParseState s m a c) c)
step m (Initial (ConcatParseState s m a c) c)
initial forall {a}. ConcatParseState s m a c -> m c
extract
where
{-# INLINE initializeR #-}
initializeR :: Parser m a b -> m (Initial (ConcatParseState sl m a b) b)
initializeR (Parser s -> a -> m (Step s b)
stepR m (Initial s b)
initialR s -> m b
extractR) = do
Initial s b
resR <- m (Initial s b)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
IPartial s
sr -> forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
sr s -> m b
extractR
IDone b
br -> forall s b. b -> Initial s b
IDone b
br
IError String
err -> forall s b. String -> Initial s b
IError String
err
initial :: m (Initial (ConcatParseState s m a c) c)
initial = do
Initial s b
res <- m (Initial s b)
initialL
case Initial s b
res of
IPartial s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
IPartial forall a b. (a -> b) -> a -> b
$ forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s
IDone b
b -> forall {m :: * -> *} {a} {b} {sl}.
Monad m =>
Parser m a b -> m (Initial (ConcatParseState sl m a b) b)
initializeR (b -> Parser m a c
func b
b)
IError String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Initial s b
IError String
err
{-# INLINE initializeRL #-}
initializeRL :: Int -> Parser m a b -> m (Step (ConcatParseState sl m a b) b)
initializeRL Int
n (Parser s -> a -> m (Step s b)
stepR m (Initial s b)
initialR s -> m b
extractR) = do
Initial s b
resR <- m (Initial s b)
initialR
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
IPartial s
sr -> forall s b. Int -> s -> Step s b
Partial Int
n forall a b. (a -> b) -> a -> b
$ forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
sr s -> m b
extractR
IDone b
br -> forall s b. Int -> b -> Step s b
Done Int
n b
br
IError String
err -> forall s b. String -> Step s b
Error String
err
step :: ConcatParseState s m a c
-> a -> m (Step (ConcatParseState s m a c) c)
step (ConcatParseL 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Partial Int
n (forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s)
Continue Int
n s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
Continue Int
n (forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s)
Done Int
n b
b -> forall {m :: * -> *} {a} {b} {sl}.
Monad m =>
Int -> Parser m a b -> m (Step (ConcatParseState sl m a b) b)
initializeRL Int
n (b -> Parser m a c
func b
b)
Error String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. String -> Step s b
Error String
err
step (ConcatParseR s -> a -> m (Step s c)
stepR s
st s -> m c
extractR) a
a = do
Step s c
r <- s -> a -> m (Step s c)
stepR s
st a
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s c
r of
Partial Int
n s
s -> forall s b. Int -> s -> Step s b
Partial Int
n forall a b. (a -> b) -> a -> b
$ forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m c
extractR
Continue Int
n s
s -> forall s b. Int -> s -> Step s b
Continue Int
n forall a b. (a -> b) -> a -> b
$ forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m c
extractR
Done Int
n c
b -> forall s b. Int -> b -> Step s b
Done Int
n c
b
Error String
err -> forall s b. String -> Step s b
Error String
err
{-# INLINE extractP #-}
extractP :: Parser m a b -> m b
extractP (Parser s -> a -> m (Step s b)
_ m (Initial s b)
initialR s -> m b
extractR) = do
Initial s b
res <- m (Initial s b)
initialR
case Initial s b
res of
IPartial s
s -> s -> m b
extractR s
s
IDone b
b -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b
IError String
err -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err
extract :: ConcatParseState s m a c -> m c
extract (ConcatParseR s -> a -> m (Step s c)
_ s
s s -> m c
extractR) = s -> m c
extractR s
s
extract (ConcatParseL s
sL) = s -> m b
extractL s
sL forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {a} {b}. MonadThrow m => Parser m a b -> m b
extractP forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Parser m a c
func
instance MonadThrow m => Monad (Parser m a) where
{-# INLINE return #-}
return :: forall a. a -> Parser m a a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE (>>=) #-}
>>= :: forall a b. Parser m a a -> (a -> Parser m a b) -> Parser m a b
(>>=) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) b a c.
MonadThrow m =>
(b -> Parser m a c) -> Parser m a b -> Parser m a c
concatMap
{-# INLINE (>>) #-}
>> :: forall a b. Parser m a a -> Parser m a b -> Parser m a b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
instance MonadCatch m => MonadPlus (Parser m a) where
{-# INLINE mzero #-}
mzero :: forall a. Parser m a a
mzero = forall (m :: * -> *) a b. MonadThrow m => String -> Parser m a b
die String
"mzero"
{-# INLINE mplus #-}
mplus :: forall a. Parser m a a -> Parser m a a -> Parser m a a
mplus = forall (m :: * -> *) x a.
Monad m =>
Parser m x a -> Parser m x a -> Parser m x a
alt
instance (MonadThrow m, MonadReader r m, MonadCatch m) => MonadReader r (Parser m a) where
{-# INLINE ask #-}
ask :: Parser m a r
ask = forall (m :: * -> *) b a. Monad m => m b -> Parser m a b
fromEffect forall r (m :: * -> *). MonadReader r m => m r
ask
{-# INLINE local #-}
local :: forall a. (r -> r) -> Parser m a a -> Parser m a a
local r -> r
f (Parser s -> a -> m (Step s a)
step m (Initial s a)
init' s -> m a
extract) =
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser ((forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> m (Step s a)
step)
(forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f m (Initial s a)
init')
(forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m a
extract)
instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where
{-# INLINE get #-}
get :: Parser m a s
get = forall (m :: * -> *) b a. Monad m => m b -> Parser m a b
fromEffect forall s (m :: * -> *). MonadState s m => m s
get
{-# INLINE put #-}
put :: s -> Parser m a ()
put = forall (m :: * -> *) b a. Monad m => m b -> Parser m a b
fromEffect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
instance (MonadThrow m, MonadIO m) => MonadIO (Parser m a) where
{-# INLINE liftIO #-}
liftIO :: forall a. IO a -> Parser m a a
liftIO = forall (m :: * -> *) b a. Monad m => m b -> Parser m a b
fromEffect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO