#include "inline.hs"

-- |
-- Module      : Streamly.Internal.Data.Parser.ParserD.Type
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- Streaming and backtracking parsers.
--
-- Parsers just extend folds.  Please read the 'Fold' design notes in
-- "Streamly.Internal.Data.Fold.Type" for background on the design.
--
-- = Parser Design
--
-- The 'Parser' type or a parsing fold is a generalization of the 'Fold' type.
-- The 'Fold' type /always/ succeeds on each input. Therefore, it does not need
-- to buffer the input. In contrast, a 'Parser' may fail and backtrack to
-- replay the input again to explore another branch of the parser. Therefore,
-- it needs to buffer the input. Therefore, a 'Parser' is a fold with some
-- additional requirements.  To summarize, unlike a 'Fold', a 'Parser':
--
-- 1. may not generate a new value of the accumulator on every input, it may
-- generate a new accumulator only after consuming multiple input elements
-- (e.g. takeEQ).
-- 2. on success may return some unconsumed input (e.g. takeWhile)
-- 3. may fail and return all input without consuming it (e.g. satisfy)
-- 4. backtrack and start inspecting the past input again (e.g. alt)
--
-- These use cases require buffering and replaying of input.  To facilitate
-- this, the step function of the 'Fold' is augmented to return the next state
-- of the fold along with a command tag using a 'Step' functor, the tag tells
-- the fold driver to manipulate the future input as the parser wishes. The
-- 'Step' functor provides the following commands to the fold driver
-- corresponding to the use cases outlined in the previous para:
--
-- 1. 'Continue': buffer the current input and optionally go back to a previous
--    position in the stream
-- 2. 'Partial': buffer the current input and optionally go back to a previous
--    position in the stream, drop the buffer before that position.
-- 3. 'Done': parser succeeded, returns how much input was leftover
-- 4. 'Error': indicates that the parser has failed without a result
--
-- = How a Parser Works?
--
-- A parser is just like a fold, it keeps consuming inputs from the stream and
-- accumulating them in an accumulator. The accumulator of the parser could be
-- a singleton value or it could be a collection of values e.g. a list.
--
-- The parser may build a new output value from multiple input items. When it
-- consumes an input item but needs more input to build a complete output item
-- it uses @Continue 0 s@, yielding the intermediate state @s@ and asking the
-- driver to provide more input.  When the parser determines that a new output
-- value is complete it can use a @Done n b@ to terminate the parser with @n@
-- items of input unused and the final value of the accumulator returned as
-- @b@. If at any time the parser determines that the parse has failed it can
-- return @Error err@.
--
-- A parser building a collection of values (e.g. a list) can use the @Partial@
-- constructor whenever a new item in the output collection is generated. If a
-- parser building a collection of values has yielded at least one value then
-- it considered successful and cannot fail after that. In the current
-- implementation, this is not automatically enforced, there is a rule that the
-- parser MUST use only @Done@ for termination after the first @Partial@, it
-- cannot use @Error@. It may be possible to change the implementation so that
-- this rule is not required, but there may be some performance cost to it.
--
-- 'Streamly.Internal.Data.Parser.takeWhile' and
-- 'Streamly.Internal.Data.Parser.some' combinators are good examples of
-- efficient implementations using all features of this representation.  It is
-- possible to idiomatically build a collection of parsed items using a
-- singleton parser and @Alternative@ instance instead of using a
-- multi-yield parser.  However, this implementation is amenable to stream
-- fusion and can therefore be much faster.
--
-- = Error Handling
--
-- When a parser's @step@ function is invoked it may terminate by either a
-- 'Done' or an 'Error' return value. In an 'Alternative' composition an error
-- return can make the composed parser backtrack and try another parser.
--
-- If the stream stops before a parser could terminate then we use the
-- @extract@ function of the parser to retrieve the last yielded value of the
-- parser. If the parser has yielded at least one value then @extract@ MUST
-- return a value without throwing an error, otherwise it uses the 'ParseError'
-- exception to throw an error.
--
-- We chose the exception throwing mechanism for @extract@ instead of using an
-- explicit error return via an 'Either' type for keeping the interface simple
-- as most of the time we do not need to catch the error in intermediate
-- layers. Note that we cannot use exception throwing mechanism in @step@
-- function because of performance reasons. 'Error' constructor in that case
-- allows loop fusion and better performance.
--
-- = Future Work
--
-- It may make sense to move "takeWhile" type of parsers, which cannot fail but
-- need some lookahead, to splitting folds.  This will allow such combinators
-- to be accepted where we need an unfailing "Fold" type.
--
-- Based on application requirements it should be possible to design even a
-- richer interface to manipulate the input stream/buffer. For example, we
-- could randomly seek into the stream in the forward or reverse directions or
-- we can even seek to the end or from the end or seek from the beginning.
--
-- We can distribute and scan/parse a stream using both folds and parsers and
-- merge the resulting streams using different merge strategies (e.g.
-- interleaving or serial).

module Streamly.Internal.Data.Parser.ParserD.Type
    (
      Initial (..)
    , Step (..)
    , Parser (..)
    , ParseError (..)
    , rmapM

    , fromPure
    , fromEffect
    , serialWith
    , split_

    , die
    , dieM
    , splitSome -- parseSome?
    , splitMany -- parseMany?
    , splitManyPost
    , alt
    , concatMap

    , noErrorUnsafeSplit_
    , noErrorUnsafeSplitWith
    , noErrorUnsafeConcatMap
    )
where

import Control.Applicative (Alternative(..), liftA2)
import Control.Exception (assert, Exception(..))
import Control.Monad (MonadPlus(..), (>=>))
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)
--
-- $setup
-- >>> :m
-- >>> import Control.Applicative ((<|>))
-- >>> import Prelude hiding (concatMap)
-- >>> import qualified Streamly.Prelude as Stream
-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream (parse)
-- >>> import qualified Streamly.Internal.Data.Parser as Parser

-- | The type of a 'Parser''s initial action.
--
-- /Internal/
--
{-# ANN type Initial Fuse #-}
data Initial s b
    = IPartial !s   -- ^ Wait for step function to be called with state @s@.
    | IDone !b      -- ^ Return a result right away without an input.
    | IError String -- ^ Return an error right away without an input.

-- | @first@ maps on 'IPartial' and @second@ maps on 'IDone'.
--
-- /Internal/
--
instance Bifunctor Initial where
    {-# INLINE bimap #-}
    bimap :: (a -> b) -> (c -> d) -> Initial a c -> Initial b d
bimap a -> b
f c -> d
_ (IPartial a
a) = b -> Initial b d
forall s b. s -> Initial s b
IPartial (a -> b
f a
a)
    bimap a -> b
_ c -> d
g (IDone c
b) = d -> Initial b d
forall s b. b -> Initial s b
IDone (c -> d
g c
b)
    bimap a -> b
_ c -> d
_ (IError String
err) = String -> Initial b d
forall s b. String -> Initial s b
IError String
err

    {-# INLINE first #-}
    first :: (a -> b) -> Initial a c -> Initial b c
first a -> b
f (IPartial a
a) = b -> Initial b c
forall s b. s -> Initial s b
IPartial (a -> b
f a
a)
    first a -> b
_ (IDone c
x) = c -> Initial b c
forall s b. b -> Initial s b
IDone c
x
    first a -> b
_ (IError String
err) = String -> Initial b c
forall s b. String -> Initial s b
IError String
err

    {-# INLINE second #-}
    second :: (b -> c) -> Initial a b -> Initial a c
second b -> c
_ (IPartial a
x) = a -> Initial a c
forall s b. s -> Initial s b
IPartial a
x
    second b -> c
f (IDone b
a) = c -> Initial a c
forall s b. b -> Initial s b
IDone (b -> c
f b
a)
    second b -> c
_ (IError String
err) = String -> Initial a c
forall s b. String -> Initial s b
IError String
err

-- | Maps a function over the result held by 'IDone'.
--
-- @
-- fmap = 'second'
-- @
--
-- /Internal/
--
instance Functor (Initial s) where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> Initial s a -> Initial s b
fmap = (a -> b) -> Initial s a -> Initial s b
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second

-- | The return type of a 'Parser' step.
--
-- The parse operation feeds the input stream to the parser one element at a
-- time, representing a parse 'Step'. The parser may or may not consume the
-- item and returns a result. If the result is 'Partial' we can either extract
-- the result or feed more input to the parser. If the result is 'Continue', we
-- must feed more input in order to get a result. If the parser returns 'Done'
-- then the parser can no longer take any more input.
--
-- If the result is 'Continue', the parse operation retains the input in a
-- backtracking buffer, in case the parser may ask to backtrack in future.
-- Whenever a 'Partial n' result is returned we first backtrack by @n@ elements
-- in the input and then release any remaining backtracking buffer. Similarly,
-- 'Continue n' backtracks to @n@ elements before the current position and
-- starts feeding the input from that point for future invocations of the
-- parser.
--
-- If parser is not yet done, we can use the @extract@ operation on the @state@
-- of the parser to extract a result. If the parser has not yet yielded a
-- result, the operation fails with a 'ParseError' exception. If the parser
-- yielded a 'Partial' result in the past the last partial result is returned.
-- Therefore, if a parser yields a partial result once it cannot fail later on.
--
-- The parser can never backtrack beyond the position where the last partial
-- result left it at. The parser must ensure that the backtrack position is
-- always after that.
--
-- /Pre-release/
--
{-# ANN type Step Fuse #-}
data Step s b =
        Partial Int s
    -- ^ Partial result with an optional backtrack request.
    --
    -- @Partial count state@ means a partial result is available which
    -- can be extracted successfully, @state@ is the opaque state of the
    -- parser to be supplied to the next invocation of the step operation.
    -- The current input position is reset to @count@ elements back and any
    -- input before that is dropped from the backtrack buffer.

    | Continue Int s
    -- ^ Need more input with an optional backtrack request.
    --
    -- @Continue count state@ means the parser has consumed the current input
    -- but no new result is generated, @state@ is the next state of the parser.
    -- The current input is retained in the backtrack buffer and the input
    -- position is reset to @count@ elements back.

    | Done Int b
    -- ^ Done with leftover input count and result.
    --
    -- @Done count result@ means the parser has finished, it will accept no
    -- more input, last @count@ elements from the input are unused and the
    -- result of the parser is in @result@.

    | Error String
    -- ^ Parser failed without generating any output.
    --
    -- The parsing operation may backtrack to the beginning and try another
    -- alternative.

instance Functor (Step s) where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> Step s a -> Step s b
fmap a -> b
_ (Partial Int
n s
s) = Int -> s -> Step s b
forall s b. Int -> s -> Step s b
Partial Int
n s
s
    fmap a -> b
_ (Continue Int
n s
s) = Int -> s -> Step s b
forall s b. Int -> s -> Step s b
Continue Int
n s
s
    fmap a -> b
f (Done Int
n a
b) = Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Done Int
n (a -> b
f a
b)
    fmap a -> b
_ (Error String
err) = String -> Step s b
forall s b. String -> Step s b
Error String
err

-- | Map a monadic function over the result @b@ in @Step s b@.
--
-- /Internal/
{-# INLINE mapMStep #-}
mapMStep :: Applicative m => (a -> m b) -> Step s a -> m (Step s b)
mapMStep :: (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 -> Step s b -> m (Step s b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Step s b
forall s b. Int -> s -> Step s b
Partial Int
n s
s
        Done Int
n a
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
Done Int
n (b -> Step s b) -> m b -> m (Step s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
b
        Continue Int
n s
s -> Step s b -> m (Step s b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Step s b
forall s b. Int -> s -> Step s b
Continue Int
n s
s
        Error String
err -> Step s b -> m (Step s b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
err

-- | A parser is a fold that can fail and is represented as @Parser step
-- initial extract@. Before we drive a parser we call the @initial@ action to
-- retrieve the initial state of the fold. The parser driver invokes @step@
-- with the state returned by the previous step and the next input element. It
-- results into a new state and a command to the driver represented by 'Step'
-- type. The driver keeps invoking the step function until it stops or fails.
-- At any point of time the driver can call @extract@ to inspect the result of
-- the fold. It may result in an error or an output value.
--
-- /Pre-release/
--
data Parser m a b =
    forall s. Parser (s -> a -> m (Step s b)) (m (Initial s b)) (s -> m b)

-- | This exception is used for two purposes:
--
-- * When a parser ultimately fails, the user of the parser is intimated via
--    this exception.
-- * When the "extract" function of a parser needs to throw an error.
--
-- /Pre-release/
--
newtype ParseError = ParseError String
    deriving Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
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 :: (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) =
        (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 ((a -> b) -> (s -> m a) -> s -> m b
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 = (a -> b) -> m (Initial s a) -> m (Initial s b)
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 = (a -> b) -> m (Step s a) -> m (Step s 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 = (f a -> f b) -> f (f a) -> f (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
g)

------------------------------------------------------------------------------
-- Mapping on the output
------------------------------------------------------------------------------

-- | Map a monadic function on the output of a parser.
--
-- /Pre-release/
{-# INLINE rmapM #-}
rmapM :: Monad m => (b -> m c) -> Parser m a b -> Parser m a c
rmapM :: (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) = (s -> a -> m (Step s c))
-> m (Initial s c) -> (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 s -> a -> m (Step s c)
step1 m (Initial s c)
initial1 (s -> m b
extract (s -> m b) -> (b -> m c) -> s -> m c
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 -> Initial s c -> m (Initial s c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial s c -> m (Initial s c)) -> Initial s c -> m (Initial s c)
forall a b. (a -> b) -> a -> b
$ s -> Initial s c
forall s b. s -> Initial s b
IPartial s
x
            IDone b
a -> c -> Initial s c
forall s b. b -> Initial s b
IDone (c -> Initial s c) -> m c -> m (Initial s c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> m c
f b
a
            IError String
err -> Initial s c -> m (Initial s c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial s c -> m (Initial s c)) -> Initial s c -> m (Initial s c)
forall a b. (a -> b) -> a -> b
$ String -> Initial s c
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 m (Step s b) -> (Step s b -> m (Step s c)) -> m (Step s c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (b -> m c) -> Step s b -> m (Step s c)
forall (m :: * -> *) a b s.
Applicative m =>
(a -> m b) -> Step s a -> m (Step s b)
mapMStep b -> m c
f

-- | See 'Streamly.Internal.Data.Parser.fromPure'.
--
-- /Pre-release/
--
{-# INLINE_NORMAL fromPure #-}
fromPure :: Monad m => b -> Parser m a b
fromPure :: b -> Parser m a b
fromPure b
b = (Any -> a -> m (Step Any b))
-> m (Initial Any b) -> (Any -> 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 Any -> a -> m (Step Any b)
forall a. HasCallStack => a
undefined (Initial Any b -> m (Initial Any b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Initial Any b -> m (Initial Any b))
-> Initial Any b -> m (Initial Any b)
forall a b. (a -> b) -> a -> b
$ b -> Initial Any b
forall s b. b -> Initial s b
IDone b
b) Any -> m b
forall a. HasCallStack => a
undefined

-- | See 'Streamly.Internal.Data.Parser.fromEffect'.
--
-- /Pre-release/
--
{-# INLINE fromEffect #-}
fromEffect :: Monad m => m b -> Parser m a b
fromEffect :: m b -> Parser m a b
fromEffect m b
b = (Any -> a -> m (Step Any b))
-> m (Initial Any b) -> (Any -> 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 Any -> a -> m (Step Any b)
forall a. HasCallStack => a
undefined (b -> Initial Any b
forall s b. b -> Initial s b
IDone (b -> Initial Any b) -> m b -> m (Initial Any b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
b) Any -> m b
forall a. HasCallStack => a
undefined

-------------------------------------------------------------------------------
-- Sequential applicative
-------------------------------------------------------------------------------

{-# ANN type SeqParseState Fuse #-}
data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr

-- | See 'Streamly.Internal.Data.Parser.serialWith'.
--
-- Note: this implementation of serialWith is fast because of stream fusion but
-- has quadratic time complexity, because each composition adds a new branch
-- that each subsequent parse's input element has to go through, therefore, it
-- cannot scale to a large number of compositions. After around 100
-- compositions the performance starts dipping rapidly beyond a CPS style
-- unfused implementation.
--
-- /Pre-release/
--
{-# INLINE serialWith #-}
serialWith :: MonadThrow m
    => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
serialWith :: (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) =
    (SeqParseState s (b -> c) s
 -> x -> m (Step (SeqParseState s (b -> c) s) c))
-> m (Initial (SeqParseState s (b -> c) s) c)
-> (SeqParseState s (b -> c) s -> m c)
-> Parser m x c
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 -> Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SeqParseState s (b -> c) s) c
 -> m (Initial (SeqParseState s (b -> c) s) c))
-> Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ SeqParseState s (b -> c) s
-> Initial (SeqParseState s (b -> c) s) c
forall s b. s -> Initial s b
IPartial (SeqParseState s (b -> c) s
 -> Initial (SeqParseState s (b -> c) s) c)
-> SeqParseState s (b -> c) s
-> Initial (SeqParseState s (b -> c) s) c
forall a b. (a -> b) -> a -> b
$ s -> SeqParseState s (b -> c) s
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
                Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SeqParseState s (b -> c) s) c
 -> m (Initial (SeqParseState s (b -> c) s) c))
-> Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
                    IPartial s
sr -> SeqParseState s (b -> c) s
-> Initial (SeqParseState s (b -> c) s) c
forall s b. s -> Initial s b
IPartial (SeqParseState s (b -> c) s
 -> Initial (SeqParseState s (b -> c) s) c)
-> SeqParseState s (b -> c) s
-> Initial (SeqParseState s (b -> c) s) c
forall a b. (a -> b) -> a -> b
$ (b -> c) -> s -> SeqParseState s (b -> c) s
forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR (a -> b -> c
func a
bl) s
sr
                    IDone b
br -> c -> Initial (SeqParseState s (b -> c) s) c
forall s b. b -> Initial s b
IDone (a -> b -> c
func a
bl b
br)
                    IError String
err -> String -> Initial (SeqParseState s (b -> c) s) c
forall s b. String -> Initial s b
IError String
err
            IError String
err -> Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SeqParseState s (b -> c) s) c
 -> m (Initial (SeqParseState s (b -> c) s) c))
-> Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ String -> Initial (SeqParseState s (b -> c) s) c
forall s b. String -> Initial s b
IError String
err

    -- Note: For the composed parse to terminate, the left parser has to be
    -- a terminating parser returning a Done at some point.
    step :: SeqParseState s (b -> c) s
-> x -> m (Step (SeqParseState s (b -> c) s) c)
step (SeqParseL s
st) x
a =
      (\Step s a
resL Initial s b
initR ->
        case Step s a
resL of
            -- Note: We need to buffer the input for a possible Alternative
            -- e.g. in ((,) <$> p1 <*> p2) <|> p3, if p2 fails we have to
            -- backtrack and start running p3. So we need to keep the input
            -- buffered until we know that the applicative cannot fail.
            Partial Int
n s
s -> Int
-> SeqParseState s (b -> c) s
-> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> SeqParseState s (b -> c) s
forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
s)
            Continue Int
n s
s -> Int
-> SeqParseState s (b -> c) s
-> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> SeqParseState s (b -> c) s
forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
s)
            Done Int
n a
b ->
                case Initial s b
initR of
                   IPartial s
sr -> Int
-> SeqParseState s (b -> c) s
-> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> s -> Step s b
Continue Int
n (SeqParseState s (b -> c) s -> Step (SeqParseState s (b -> c) s) c)
-> SeqParseState s (b -> c) s
-> Step (SeqParseState s (b -> c) s) c
forall a b. (a -> b) -> a -> b
$ (b -> c) -> s -> SeqParseState s (b -> c) s
forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR (a -> b -> c
func a
b) s
sr
                   IDone b
br -> Int -> c -> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> b -> Step s b
Done Int
n (a -> b -> c
func a
b b
br)
                   IError String
err -> String -> Step (SeqParseState s (b -> c) s) c
forall s b. String -> Step s b
Error String
err
            Error String
err -> String -> Step (SeqParseState s (b -> c) s) c
forall s b. String -> Step s b
Error String
err) (Step s a -> Initial s b -> Step (SeqParseState s (b -> c) s) c)
-> m (Step s a)
-> m (Initial s b -> Step (SeqParseState s (b -> c) s) c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> x -> m (Step s a)
stepL s
st x
a m (Initial s b -> Step (SeqParseState s (b -> c) s) c)
-> m (Initial s b) -> m (Step (SeqParseState s (b -> c) s) c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Initial s b)
initialR

    step (SeqParseR b -> c
f s
st) x
a =
        (\case
            Partial Int
n s
s -> Int
-> SeqParseState s (b -> c) s
-> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> s -> Step s b
Partial Int
n ((b -> c) -> s -> SeqParseState s (b -> c) s
forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR b -> c
f s
s)
            Continue Int
n s
s -> Int
-> SeqParseState s (b -> c) s
-> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> s -> Step s b
Continue Int
n ((b -> c) -> s -> SeqParseState s (b -> c) s
forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR b -> c
f s
s)
            Done Int
n b
b -> Int -> c -> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> b -> Step s b
Done Int
n (b -> c
f b
b)
            Error String
err -> String -> Step (SeqParseState s (b -> c) s) c
forall s b. String -> Step s b
Error String
err) (Step s b -> Step (SeqParseState s (b -> c) s) c)
-> m (Step s b) -> m (Step (SeqParseState s (b -> c) s) c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> x -> m (Step s b)
stepR s
st x
a

    extract :: SeqParseState s (b -> c) s -> m c
extract (SeqParseR b -> c
f s
sR) = (b -> c) -> m b -> m c
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
                c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
func a
rL b
rR
            IDone b
rR -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
func a
rL b
rR
            IError String
err -> ParseError -> m c
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m c) -> ParseError -> m c
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

-- | Works correctly only if the first parser is guaranteed to never fail.
{-# INLINE noErrorUnsafeSplitWith #-}
noErrorUnsafeSplitWith :: Monad m
    => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
noErrorUnsafeSplitWith :: (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) =
    (SeqParseState s (b -> c) s
 -> x -> m (Step (SeqParseState s (b -> c) s) c))
-> m (Initial (SeqParseState s (b -> c) s) c)
-> (SeqParseState s (b -> c) s -> m c)
-> Parser m x c
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 -> Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SeqParseState s (b -> c) s) c
 -> m (Initial (SeqParseState s (b -> c) s) c))
-> Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ SeqParseState s (b -> c) s
-> Initial (SeqParseState s (b -> c) s) c
forall s b. s -> Initial s b
IPartial (SeqParseState s (b -> c) s
 -> Initial (SeqParseState s (b -> c) s) c)
-> SeqParseState s (b -> c) s
-> Initial (SeqParseState s (b -> c) s) c
forall a b. (a -> b) -> a -> b
$ s -> SeqParseState s (b -> c) s
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
                Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SeqParseState s (b -> c) s) c
 -> m (Initial (SeqParseState s (b -> c) s) c))
-> Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
                    IPartial s
sr -> SeqParseState s (b -> c) s
-> Initial (SeqParseState s (b -> c) s) c
forall s b. s -> Initial s b
IPartial (SeqParseState s (b -> c) s
 -> Initial (SeqParseState s (b -> c) s) c)
-> SeqParseState s (b -> c) s
-> Initial (SeqParseState s (b -> c) s) c
forall a b. (a -> b) -> a -> b
$ (b -> c) -> s -> SeqParseState s (b -> c) s
forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR (a -> b -> c
func a
bl) s
sr
                    IDone b
br -> c -> Initial (SeqParseState s (b -> c) s) c
forall s b. b -> Initial s b
IDone (a -> b -> c
func a
bl b
br)
                    IError String
err -> String -> Initial (SeqParseState s (b -> c) s) c
forall s b. String -> Initial s b
IError String
err
            IError String
err -> Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SeqParseState s (b -> c) s) c
 -> m (Initial (SeqParseState s (b -> c) s) c))
-> Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ String -> Initial (SeqParseState s (b -> c) s) c
forall s b. String -> Initial s b
IError String
err

    -- Note: For the composed parse to terminate, the left parser has to be
    -- a terminating parser returning a Done at some point.
    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
            -- Assume that the first parser can never fail, therefore we do not
            -- need to keep the input for backtracking.
            Partial Int
n s
s -> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqParseState s (b -> c) s) c
 -> m (Step (SeqParseState s (b -> c) s) c))
-> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ Int
-> SeqParseState s (b -> c) s
-> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> s -> Step s b
Partial Int
n (s -> SeqParseState s (b -> c) s
forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
s)
            Continue Int
n s
s -> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqParseState s (b -> c) s) c
 -> m (Step (SeqParseState s (b -> c) s) c))
-> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ Int
-> SeqParseState s (b -> c) s
-> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> SeqParseState s (b -> c) s
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
                Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step (SeqParseState s (b -> c) s) c
 -> m (Step (SeqParseState s (b -> c) s) c))
-> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ case Initial s b
res of
                          IPartial s
sr -> Int
-> SeqParseState s (b -> c) s
-> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> s -> Step s b
Partial Int
n (SeqParseState s (b -> c) s -> Step (SeqParseState s (b -> c) s) c)
-> SeqParseState s (b -> c) s
-> Step (SeqParseState s (b -> c) s) c
forall a b. (a -> b) -> a -> b
$ (b -> c) -> s -> SeqParseState s (b -> c) s
forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR (a -> b -> c
func a
b) s
sr
                          IDone b
br -> Int -> c -> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> b -> Step s b
Done Int
n (a -> b -> c
func a
b b
br)
                          IError String
err -> String -> Step (SeqParseState s (b -> c) s) c
forall s b. String -> Step s b
Error String
err
            Error String
err -> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqParseState s (b -> c) s) c
 -> m (Step (SeqParseState s (b -> c) s) c))
-> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (SeqParseState s (b -> c) s) c
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
        Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqParseState s (b -> c) s) c
 -> m (Step (SeqParseState s (b -> c) s) c))
-> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Partial Int
n s
s -> Int
-> SeqParseState s (b -> c) s
-> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> s -> Step s b
Partial Int
n ((b -> c) -> s -> SeqParseState s (b -> c) s
forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR b -> c
f s
s)
            Continue Int
n s
s -> Int
-> SeqParseState s (b -> c) s
-> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> s -> Step s b
Continue Int
n ((b -> c) -> s -> SeqParseState s (b -> c) s
forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR b -> c
f s
s)
            Done Int
n b
b -> Int -> c -> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> b -> Step s b
Done Int
n (b -> c
f b
b)
            Error String
err -> String -> Step (SeqParseState s (b -> c) s) c
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) = (b -> c) -> m b -> m c
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
                c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
func a
rL b
rR
            IDone b
rR -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
func a
rL b
rR
            IError String
err -> String -> m c
forall a. HasCallStack => String -> a
error (String -> m c) -> String -> m c
forall a b. (a -> b) -> a -> b
$ String
"noErrorUnsafeSplitWith: cannot use a "
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"failing parser. Parser failed with: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err

{-# ANN type SeqAState Fuse #-}
data SeqAState sl sr = SeqAL sl | SeqAR sr

-- This turns out to be slightly faster than serialWith
-- | See 'Streamly.Internal.Data.Parser.split_'.
--
-- /Pre-release/
--
{-# INLINE split_ #-}
split_ :: MonadThrow m => Parser m x a -> Parser m x b -> Parser m x b
split_ :: 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) =
    (SeqAState s s -> x -> m (Step (SeqAState s s) b))
-> m (Initial (SeqAState s s) b)
-> (SeqAState s s -> m b)
-> Parser m x b
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 -> Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b))
-> Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ SeqAState s s -> Initial (SeqAState s s) b
forall s b. s -> Initial s b
IPartial (SeqAState s s -> Initial (SeqAState s s) b)
-> SeqAState s s -> Initial (SeqAState s s) b
forall a b. (a -> b) -> a -> b
$ s -> SeqAState s s
forall sl sr. sl -> SeqAState sl sr
SeqAL s
sl
            IDone a
_ -> do
                Initial s b
resR <- m (Initial s b)
initialR
                Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b))
-> Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
                    IPartial s
sr -> SeqAState s s -> Initial (SeqAState s s) b
forall s b. s -> Initial s b
IPartial (SeqAState s s -> Initial (SeqAState s s) b)
-> SeqAState s s -> Initial (SeqAState s s) b
forall a b. (a -> b) -> a -> b
$ s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR s
sr
                    IDone b
br -> b -> Initial (SeqAState s s) b
forall s b. b -> Initial s b
IDone b
br
                    IError String
err -> String -> Initial (SeqAState s s) b
forall s b. String -> Initial s b
IError String
err
            IError String
err -> Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b))
-> Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ String -> Initial (SeqAState s s) b
forall s b. String -> Initial s b
IError String
err

    -- Note: For the composed parse to terminate, the left parser has to be
    -- a terminating parser returning a Done at some point.
    step :: SeqAState s s -> x -> m (Step (SeqAState s s) b)
step (SeqAL s
st) x
a = do
        -- Important: Do not use Applicative here. Applicative somehow caused
        -- the right action to run many times, not sure why though.
        Step s a
resL <- s -> x -> m (Step s a)
stepL s
st x
a
        case Step s a
resL of
            -- Note: this leads to buffering even if we are not in an
            -- Alternative composition.
            Partial Int
n s
s -> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqAState s s) b -> m (Step (SeqAState s s) b))
-> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ Int -> SeqAState s s -> Step (SeqAState s s) b
forall s b. Int -> s -> Step s b
Continue Int
n (s -> SeqAState s s
forall sl sr. sl -> SeqAState sl sr
SeqAL s
s)
            Continue Int
n s
s -> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqAState s s) b -> m (Step (SeqAState s s) b))
-> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ Int -> SeqAState s s -> Step (SeqAState s s) b
forall s b. Int -> s -> Step s b
Continue Int
n (s -> SeqAState s s
forall sl sr. sl -> SeqAState sl sr
SeqAL s
s)
            Done Int
n a
_ -> do
                Initial s b
initR <- m (Initial s b)
initialR
                Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqAState s s) b -> m (Step (SeqAState s s) b))
-> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ case Initial s b
initR of
                    IPartial s
s -> Int -> SeqAState s s -> Step (SeqAState s s) b
forall s b. Int -> s -> Step s b
Continue Int
n (s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR s
s)
                    IDone b
b -> Int -> b -> Step (SeqAState s s) b
forall s b. Int -> b -> Step s b
Done Int
n b
b
                    IError String
err -> String -> Step (SeqAState s s) b
forall s b. String -> Step s b
Error String
err
            Error String
err -> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqAState s s) b -> m (Step (SeqAState s s) b))
-> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (SeqAState s s) b
forall s b. String -> Step s b
Error String
err

    step (SeqAR s
st) x
a =
        (\case
            Partial Int
n s
s -> Int -> SeqAState s s -> Step (SeqAState s s) b
forall s b. Int -> s -> Step s b
Partial Int
n (s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR s
s)
            Continue Int
n s
s -> Int -> SeqAState s s -> Step (SeqAState s s) b
forall s b. Int -> s -> Step s b
Continue Int
n (s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR s
s)
            Done Int
n b
b -> Int -> b -> Step (SeqAState s s) b
forall s b. Int -> b -> Step s b
Done Int
n b
b
            Error String
err -> String -> Step (SeqAState s s) b
forall s b. String -> Step s b
Error String
err) (Step s b -> Step (SeqAState s s) b)
-> m (Step s b) -> m (Step (SeqAState s s) b)
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 -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
rR
            IError String
err -> 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

{-# INLINE noErrorUnsafeSplit_ #-}
noErrorUnsafeSplit_ :: MonadThrow m => Parser m x a -> Parser m x b -> Parser m x b
noErrorUnsafeSplit_ :: 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) =
    (SeqAState s s -> x -> m (Step (SeqAState s s) b))
-> m (Initial (SeqAState s s) b)
-> (SeqAState s s -> m b)
-> Parser m x b
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 -> Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b))
-> Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ SeqAState s s -> Initial (SeqAState s s) b
forall s b. s -> Initial s b
IPartial (SeqAState s s -> Initial (SeqAState s s) b)
-> SeqAState s s -> Initial (SeqAState s s) b
forall a b. (a -> b) -> a -> b
$ s -> SeqAState s s
forall sl sr. sl -> SeqAState sl sr
SeqAL s
sl
            IDone a
_ -> do
                Initial s b
resR <- m (Initial s b)
initialR
                Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b))
-> Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
                    IPartial s
sr -> SeqAState s s -> Initial (SeqAState s s) b
forall s b. s -> Initial s b
IPartial (SeqAState s s -> Initial (SeqAState s s) b)
-> SeqAState s s -> Initial (SeqAState s s) b
forall a b. (a -> b) -> a -> b
$ s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR s
sr
                    IDone b
br -> b -> Initial (SeqAState s s) b
forall s b. b -> Initial s b
IDone b
br
                    IError String
err -> String -> Initial (SeqAState s s) b
forall s b. String -> Initial s b
IError String
err
            IError String
err -> Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b))
-> Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ String -> Initial (SeqAState s s) b
forall s b. String -> Initial s b
IError String
err

    -- Note: For the composed parse to terminate, the left parser has to be
    -- a terminating parser returning a Done at some point.
    step :: SeqAState s s -> x -> m (Step (SeqAState s s) b)
step (SeqAL s
st) x
a = do
        -- Important: Please do not use Applicative here. Applicative somehow
        -- caused the next action to run many times in the "tar" parsing code,
        -- not sure why though.
        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 -> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqAState s s) b -> m (Step (SeqAState s s) b))
-> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ Int -> SeqAState s s -> Step (SeqAState s s) b
forall s b. Int -> s -> Step s b
Partial Int
n (s -> SeqAState s s
forall sl sr. sl -> SeqAState sl sr
SeqAL s
s)
            Continue Int
n s
s -> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqAState s s) b -> m (Step (SeqAState s s) b))
-> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ Int -> SeqAState s s -> Step (SeqAState s s) b
forall s b. Int -> s -> Step s b
Continue Int
n (s -> SeqAState s s
forall sl sr. sl -> SeqAState sl sr
SeqAL s
s)
            Done Int
n a
_ -> do
                Initial s b
initR <- m (Initial s b)
initialR
                Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqAState s s) b -> m (Step (SeqAState s s) b))
-> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ case Initial s b
initR of
                    IPartial s
s -> Int -> SeqAState s s -> Step (SeqAState s s) b
forall s b. Int -> s -> Step s b
Partial Int
n (s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR s
s)
                    IDone b
b -> Int -> b -> Step (SeqAState s s) b
forall s b. Int -> b -> Step s b
Done Int
n b
b
                    IError String
err -> String -> Step (SeqAState s s) b
forall s b. String -> Step s b
Error String
err
            Error String
err -> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqAState s s) b -> m (Step (SeqAState s s) b))
-> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (SeqAState s s) b
forall s b. String -> Step s b
Error String
err

    step (SeqAR s
st) x
a =
        (\case
            Partial Int
n s
s -> Int -> SeqAState s s -> Step (SeqAState s s) b
forall s b. Int -> s -> Step s b
Partial Int
n (s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR s
s)
            Continue Int
n s
s -> Int -> SeqAState s s -> Step (SeqAState s s) b
forall s b. Int -> s -> Step s b
Continue Int
n (s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR s
s)
            Done Int
n b
b -> Int -> b -> Step (SeqAState s s) b
forall s b. Int -> b -> Step s b
Done Int
n b
b
            Error String
err -> String -> Step (SeqAState s s) b
forall s b. String -> Step s b
Error String
err) (Step s b -> Step (SeqAState s s) b)
-> m (Step s b) -> m (Step (SeqAState s s) b)
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 -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
rR
            IError String
err -> 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

-- | 'Applicative' form of 'serialWith'.
instance MonadThrow m => Applicative (Parser m a) where
    {-# INLINE pure #-}
    pure :: a -> Parser m a a
pure = a -> Parser m a a
forall (m :: * -> *) b a. Monad m => b -> Parser m a b
fromPure

    {-# INLINE (<*>) #-}
    <*> :: Parser m a (a -> b) -> Parser m a a -> Parser m a b
(<*>) = ((a -> b) -> 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 (a -> b) -> a -> b
forall a. a -> a
id

    {-# INLINE (*>) #-}
    *> :: Parser m a a -> Parser m a b -> Parser m 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 :: (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 = Parser m a (b -> c) -> Parser m a b -> Parser m a c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ((a -> b -> c) -> Parser m a a -> Parser m a (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b -> c
f Parser m a a
x)
#endif

-------------------------------------------------------------------------------
-- Sequential Alternative
-------------------------------------------------------------------------------

{-# ANN type AltParseState Fuse #-}
data AltParseState sl sr = AltParseL Int sl | AltParseR sr

-- Note: this implementation of alt is fast because of stream fusion but has
-- quadratic time complexity, because each composition adds a new branch that
-- each subsequent alternative's input element has to go through, therefore, it
-- cannot scale to a large number of compositions
--
-- | See 'Streamly.Internal.Data.Parser.alt'.
--
-- /Pre-release/
--
{-# INLINE alt #-}
alt :: Monad m => Parser m x a -> Parser m x a -> Parser m x a
alt :: 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) =
    (AltParseState s s -> x -> m (Step (AltParseState s s) a))
-> m (Initial (AltParseState s s) a)
-> (AltParseState s s -> m a)
-> Parser m x a
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 -> Initial (AltParseState s s) a -> m (Initial (AltParseState s s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (AltParseState s s) a
 -> m (Initial (AltParseState s s) a))
-> Initial (AltParseState s s) a
-> m (Initial (AltParseState s s) a)
forall a b. (a -> b) -> a -> b
$ AltParseState s s -> Initial (AltParseState s s) a
forall s b. s -> Initial s b
IPartial (AltParseState s s -> Initial (AltParseState s s) a)
-> AltParseState s s -> Initial (AltParseState s s) a
forall a b. (a -> b) -> a -> b
$ Int -> s -> AltParseState s s
forall sl sr. Int -> sl -> AltParseState sl sr
AltParseL Int
0 s
sl
            IDone a
bl -> Initial (AltParseState s s) a -> m (Initial (AltParseState s s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (AltParseState s s) a
 -> m (Initial (AltParseState s s) a))
-> Initial (AltParseState s s) a
-> m (Initial (AltParseState s s) a)
forall a b. (a -> b) -> a -> b
$ a -> Initial (AltParseState s s) a
forall s b. b -> Initial s b
IDone a
bl
            IError String
_ -> do
                Initial s a
resR <- m (Initial s a)
initialR
                Initial (AltParseState s s) a -> m (Initial (AltParseState s s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (AltParseState s s) a
 -> m (Initial (AltParseState s s) a))
-> Initial (AltParseState s s) a
-> m (Initial (AltParseState s s) a)
forall a b. (a -> b) -> a -> b
$ case Initial s a
resR of
                    IPartial s
sr -> AltParseState s s -> Initial (AltParseState s s) a
forall s b. s -> Initial s b
IPartial (AltParseState s s -> Initial (AltParseState s s) a)
-> AltParseState s s -> Initial (AltParseState s s) a
forall a b. (a -> b) -> a -> b
$ s -> AltParseState s s
forall sl sr. sr -> AltParseState sl sr
AltParseR s
sr
                    IDone a
br -> a -> Initial (AltParseState s s) a
forall s b. b -> Initial s b
IDone a
br
                    IError String
err -> String -> Initial (AltParseState s s) a
forall s b. String -> Initial s b
IError String
err

    -- Once a parser yields at least one value it cannot fail.  This
    -- restriction helps us make backtracking more efficient, as we do not need
    -- to keep the consumed items buffered after a yield. Note that we do not
    -- enforce this and if a misbehaving parser does not honor this then we can
    -- get unexpected results.
    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 -> Step (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (AltParseState s s) a -> m (Step (AltParseState s s) a))
-> Step (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall a b. (a -> b) -> a -> b
$ Int -> AltParseState s s -> Step (AltParseState s s) a
forall s b. Int -> s -> Step s b
Partial Int
n (Int -> s -> AltParseState s s
forall sl sr. Int -> sl -> AltParseState sl sr
AltParseL Int
0 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 (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (AltParseState s s) a -> m (Step (AltParseState s s) a))
-> Step (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall a b. (a -> b) -> a -> b
$ Int -> AltParseState s s -> Step (AltParseState s s) a
forall s b. Int -> s -> Step s b
Continue Int
n (Int -> s -> AltParseState s s
forall sl sr. Int -> sl -> AltParseState sl sr
AltParseL (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
s)
            Done Int
n a
b -> Step (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (AltParseState s s) a -> m (Step (AltParseState s s) a))
-> Step (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> Step (AltParseState s s) a
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
                Step (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step (AltParseState s s) a -> m (Step (AltParseState s s) a))
-> Step (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall a b. (a -> b) -> a -> b
$ case Initial s a
res of
                          IPartial s
rR -> Int -> AltParseState s s -> Step (AltParseState s s) a
forall s b. Int -> s -> Step s b
Continue (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (s -> AltParseState s s
forall sl sr. sr -> AltParseState sl sr
AltParseR s
rR)
                          IDone a
b -> Int -> a -> Step (AltParseState s s) a
forall s b. Int -> b -> Step s b
Done (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
b
                          IError String
err -> String -> Step (AltParseState s s) a
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
        Step (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (AltParseState s s) a -> m (Step (AltParseState s s) a))
-> Step (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Partial Int
n s
s -> Int -> AltParseState s s -> Step (AltParseState s s) a
forall s b. Int -> s -> Step s b
Partial Int
n (s -> AltParseState s s
forall sl sr. sr -> AltParseState sl sr
AltParseR s
s)
            Continue Int
n s
s -> Int -> AltParseState s s -> Step (AltParseState s s) a
forall s b. Int -> s -> Step s b
Continue Int
n (s -> AltParseState s s
forall sl sr. sr -> AltParseState sl sr
AltParseR s
s)
            Done Int
n a
b -> Int -> a -> Step (AltParseState s s) a
forall s b. Int -> b -> Step s b
Done Int
n a
b
            Error String
err -> String -> Step (AltParseState s s) a
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

-- | See documentation of 'Streamly.Internal.Data.Parser.many'.
--
-- /Pre-release/
--
{-# INLINE splitMany #-}
splitMany :: MonadCatch m =>  Parser m a b -> Fold m b c -> Parser m a c
splitMany :: 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) =
    (Tuple3' s Int s -> a -> m (Step (Tuple3' s Int s) c))
-> m (Initial (Tuple3' s Int s) c)
-> (Tuple3' s Int 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 Tuple3' s Int s -> a -> m (Step (Tuple3' s Int s) c)
step m (Initial (Tuple3' s Int s) c)
initial Tuple3' s Int s -> m c
forall a. (Eq a, Num a) => Tuple3' s a s -> m c
extract

    where

    -- Caution! There is mutual recursion here, inlining the right functions is
    -- important.

    {-# INLINE handleCollect #-}
    handleCollect :: (Tuple3' s b s -> a) -> (c -> a) -> Step s c -> m a
handleCollect Tuple3' s b s -> a
partial c -> a
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 -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Tuple3' s b s -> a
partial (Tuple3' s b s -> a) -> Tuple3' s b s -> a
forall a b. (a -> b) -> a -> b
$ s -> b -> s -> Tuple3' s b s
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
ps b
0 s
fs
                    IDone b
pb ->
                        (Step s c -> m a) -> s -> b -> m a
forall b. (Step s c -> m b) -> s -> b -> m b
runCollectorWith ((Tuple3' s b s -> a) -> (c -> a) -> Step s c -> m a
handleCollect Tuple3' s b s -> a
partial c -> a
done) s
fs b
pb
                    IError String
_ -> c -> a
done (c -> a) -> m c -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
fextract s
fs
            FL.Done c
fb -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ c -> a
done c
fb

    -- Do not inline this
    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 m (Step s c) -> (Step s c -> m b) -> m b
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 m (Step s c)
-> (Step s c -> m (Initial (Tuple3' s Int s) c))
-> m (Initial (Tuple3' s Int s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tuple3' s Int s -> Initial (Tuple3' s Int s) c)
-> (c -> Initial (Tuple3' s Int s) c)
-> Step s c
-> m (Initial (Tuple3' s Int s) c)
forall b a.
Num b =>
(Tuple3' s b s -> a) -> (c -> a) -> Step s c -> m a
handleCollect Tuple3' s Int s -> Initial (Tuple3' s Int s) c
forall s b. s -> Initial s b
IPartial c -> Initial (Tuple3' s Int s) c
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        case Step s b
r of
            Partial Int
n s
s -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 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 (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c))
-> Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple3' s Int s -> Step (Tuple3' s Int s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> s -> Tuple3' s Int s
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
fs)
            Continue Int
n s
s -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 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 (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c))
-> Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple3' s Int s -> Step (Tuple3' s Int s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> s -> Tuple3' s Int s
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
fs)
            Done Int
n b
b -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 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 ())
                s -> b -> m (Step s c)
fstep s
fs b
b m (Step s c)
-> (Step s c -> m (Step (Tuple3' s Int s) c))
-> m (Step (Tuple3' s Int s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tuple3' s Int s -> Step (Tuple3' s Int s) c)
-> (c -> Step (Tuple3' s Int s) c)
-> Step s c
-> m (Step (Tuple3' s Int s) c)
forall b a.
Num b =>
(Tuple3' s b s -> a) -> (c -> a) -> Step s c -> m a
handleCollect (Int -> Tuple3' s Int s -> Step (Tuple3' s Int s) c
forall s b. Int -> s -> Step s b
Partial Int
n) (Int -> c -> Step (Tuple3' s Int s) c
forall s b. Int -> b -> Step s b
Done Int
n)
            Error String
_ -> do
                c
xs <- s -> m c
fextract s
fs
                Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c))
-> Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (Tuple3' s Int s) c
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
    -- XXX The "try" may impact performance if this parser is used as a scan
    extract (Tuple3' s
s a
_ s
fs) = do
        Either ParseError b
r <- m b -> m (Either ParseError b)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m b -> m (Either ParseError b)) -> m b -> m (Either ParseError b)
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 -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
b1

-- | Like splitMany, but inner fold emits an output at the end even if no input
-- is received.
--
-- /Internal/
--
{-# INLINE splitManyPost #-}
splitManyPost :: MonadCatch m =>  Parser m a b -> Fold m b c -> Parser m a c
splitManyPost :: 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) =
    (Tuple3' s Int s -> a -> m (Step (Tuple3' s Int s) c))
-> m (Initial (Tuple3' s Int s) c)
-> (Tuple3' s Int 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 Tuple3' s Int s -> a -> m (Step (Tuple3' s Int s) c)
step m (Initial (Tuple3' s Int s) c)
initial Tuple3' s Int s -> m c
forall b. Tuple3' s b s -> m c
extract

    where

    -- Caution! There is mutual recursion here, inlining the right functions is
    -- important.

    {-# INLINE handleCollect #-}
    handleCollect :: (Tuple3' s b s -> a) -> (c -> a) -> Step s c -> m a
handleCollect Tuple3' s b s -> a
partial c -> a
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 -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Tuple3' s b s -> a
partial (Tuple3' s b s -> a) -> Tuple3' s b s -> a
forall a b. (a -> b) -> a -> b
$ s -> b -> s -> Tuple3' s b s
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
ps b
0 s
fs
                    IDone b
pb ->
                        (Step s c -> m a) -> s -> b -> m a
forall b. (Step s c -> m b) -> s -> b -> m b
runCollectorWith ((Tuple3' s b s -> a) -> (c -> a) -> Step s c -> m a
handleCollect Tuple3' s b s -> a
partial c -> a
done) s
fs b
pb
                    IError String
_ -> c -> a
done (c -> a) -> m c -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
fextract s
fs
            FL.Done c
fb -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ c -> a
done c
fb

    -- Do not inline this
    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 m (Step s c) -> (Step s c -> m b) -> m b
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 m (Step s c)
-> (Step s c -> m (Initial (Tuple3' s Int s) c))
-> m (Initial (Tuple3' s Int s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tuple3' s Int s -> Initial (Tuple3' s Int s) c)
-> (c -> Initial (Tuple3' s Int s) c)
-> Step s c
-> m (Initial (Tuple3' s Int s) c)
forall b a.
Num b =>
(Tuple3' s b s -> a) -> (c -> a) -> Step s c -> m a
handleCollect Tuple3' s Int s -> Initial (Tuple3' s Int s) c
forall s b. s -> Initial s b
IPartial c -> Initial (Tuple3' s Int s) c
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        case Step s b
r of
            Partial Int
n s
s -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 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 (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c))
-> Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple3' s Int s -> Step (Tuple3' s Int s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> s -> Tuple3' s Int s
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
fs)
            Continue Int
n s
s -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 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 (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c))
-> Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple3' s Int s -> Step (Tuple3' s Int s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> s -> Tuple3' s Int s
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
fs)
            Done Int
n b
b -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 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 ())
                s -> b -> m (Step s c)
fstep s
fs b
b m (Step s c)
-> (Step s c -> m (Step (Tuple3' s Int s) c))
-> m (Step (Tuple3' s Int s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tuple3' s Int s -> Step (Tuple3' s Int s) c)
-> (c -> Step (Tuple3' s Int s) c)
-> Step s c
-> m (Step (Tuple3' s Int s) c)
forall b a.
Num b =>
(Tuple3' s b s -> a) -> (c -> a) -> Step s c -> m a
handleCollect (Int -> Tuple3' s Int s -> Step (Tuple3' s Int s) c
forall s b. Int -> s -> Step s b
Partial Int
n) (Int -> c -> Step (Tuple3' s Int s) c
forall s b. Int -> b -> Step s b
Done Int
n)
            Error String
_ -> do
                c
xs <- s -> m c
fextract s
fs
                Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c))
-> Step (Tuple3' s Int s) c -> m (Step (Tuple3' s Int s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (Tuple3' s Int s) c
forall s b. Int -> b -> Step s b
Done Int
cnt1 c
xs

    -- XXX The "try" may impact performance if this parser is used as a scan
    extract :: Tuple3' s b s -> m c
extract (Tuple3' s
s b
_ s
fs) = do
        Either ParseError b
r <- m b -> m (Either ParseError b)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m b -> m (Either ParseError b)) -> m b -> m (Either ParseError b)
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 -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
b1

-- | See documentation of 'Streamly.Internal.Data.Parser.some'.
--
-- /Pre-release/
--
{-# INLINE splitSome #-}
splitSome :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c
splitSome :: 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) =
    (Tuple3' s Int (Either s s)
 -> a -> m (Step (Tuple3' s Int (Either s s)) c))
-> m (Initial (Tuple3' s Int (Either s s)) c)
-> (Tuple3' s Int (Either 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 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 Tuple3' s Int (Either s s) -> m c
forall b. Tuple3' s b (Either s s) -> m c
extract

    where

    -- Caution! There is mutual recursion here, inlining the right functions is
    -- important.

    {-# INLINE handleCollect #-}
    handleCollect :: (Tuple3' s b (Either a s) -> a) -> (c -> a) -> Step s c -> m a
handleCollect Tuple3' s b (Either a s) -> a
partial c -> a
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 -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Tuple3' s b (Either a s) -> a
partial (Tuple3' s b (Either a s) -> a) -> Tuple3' s b (Either a s) -> a
forall a b. (a -> b) -> a -> b
$ s -> b -> Either a s -> Tuple3' s b (Either a s)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
ps b
0 (Either a s -> Tuple3' s b (Either a s))
-> Either a s -> Tuple3' s b (Either a s)
forall a b. (a -> b) -> a -> b
$ s -> Either a s
forall a b. b -> Either a b
Right s
fs
                    IDone b
pb ->
                        (Step s c -> m a) -> s -> b -> m a
forall b. (Step s c -> m b) -> s -> b -> m b
runCollectorWith ((Tuple3' s b (Either a s) -> a) -> (c -> a) -> Step s c -> m a
handleCollect Tuple3' s b (Either a s) -> a
partial c -> a
done) s
fs b
pb
                    IError String
_ -> c -> a
done (c -> a) -> m c -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
fextract s
fs
            FL.Done c
fb -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ c -> a
done c
fb

    -- Do not inline this
    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 m (Step s c) -> (Step s c -> m b) -> m b
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 -> Initial (Tuple3' s Int (Either s s)) c
-> m (Initial (Tuple3' s Int (Either s s)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple3' s Int (Either s s)) c
 -> m (Initial (Tuple3' s Int (Either s s)) c))
-> Initial (Tuple3' s Int (Either s s)) c
-> m (Initial (Tuple3' s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ Tuple3' s Int (Either s s)
-> Initial (Tuple3' s Int (Either s s)) c
forall s b. s -> Initial s b
IPartial (Tuple3' s Int (Either s s)
 -> Initial (Tuple3' s Int (Either s s)) c)
-> Tuple3' s Int (Either s s)
-> Initial (Tuple3' s Int (Either s s)) c
forall a b. (a -> b) -> a -> b
$ s -> Int -> Either s s -> Tuple3' s Int (Either s s)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
ps Int
0 (Either s s -> Tuple3' s Int (Either s s))
-> Either s s -> Tuple3' s Int (Either s s)
forall a b. (a -> b) -> a -> b
$ s -> Either s s
forall a b. a -> Either a b
Left s
fs
                    IDone b
pb ->
                        (Step s c -> m (Initial (Tuple3' s Int (Either s s)) c))
-> s -> b -> m (Initial (Tuple3' s Int (Either s s)) c)
forall b. (Step s c -> m b) -> s -> b -> m b
runCollectorWith ((Tuple3' s Int (Either s s)
 -> Initial (Tuple3' s Int (Either s s)) c)
-> (c -> Initial (Tuple3' s Int (Either s s)) c)
-> Step s c
-> m (Initial (Tuple3' s Int (Either s s)) c)
forall b a a.
Num b =>
(Tuple3' s b (Either a s) -> a) -> (c -> a) -> Step s c -> m a
handleCollect Tuple3' s Int (Either s s)
-> Initial (Tuple3' s Int (Either s s)) c
forall s b. s -> Initial s b
IPartial c -> Initial (Tuple3' s Int (Either s s)) c
forall s b. b -> Initial s b
IDone) s
fs b
pb
                    IError String
err -> Initial (Tuple3' s Int (Either s s)) c
-> m (Initial (Tuple3' s Int (Either s s)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple3' s Int (Either s s)) c
 -> m (Initial (Tuple3' s Int (Either s s)) c))
-> Initial (Tuple3' s Int (Either s s)) c
-> m (Initial (Tuple3' s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ String -> Initial (Tuple3' s Int (Either s s)) c
forall s b. String -> Initial s b
IError String
err
            FL.Done c
_ ->
                Initial (Tuple3' s Int (Either s s)) c
-> m (Initial (Tuple3' s Int (Either s s)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Initial (Tuple3' s Int (Either s s)) c
 -> m (Initial (Tuple3' s Int (Either s s)) c))
-> Initial (Tuple3' s Int (Either s s)) c
-> m (Initial (Tuple3' s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ String -> Initial (Tuple3' s Int (Either s s)) c
forall s b. String -> Initial s b
IError
                    (String -> Initial (Tuple3' s Int (Either s s)) c)
-> String -> Initial (Tuple3' s Int (Either s s)) c
forall a b. (a -> b) -> a -> b
$ String
"splitSome: The collecting fold terminated without"
                          String -> ShowS
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
        -- In the Left state, count is used only for the assert
        let cnt1 :: Int
cnt1 = Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        case Step s b
r of
            Partial Int
n s
s -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 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 (Tuple3' s Int (Either s s)) c
-> m (Step (Tuple3' s Int (Either s s)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' s Int (Either s s)) c
 -> m (Step (Tuple3' s Int (Either s s)) c))
-> Step (Tuple3' s Int (Either s s)) c
-> m (Step (Tuple3' s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ Int
-> Tuple3' s Int (Either s s)
-> Step (Tuple3' s Int (Either s s)) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> Either s s -> Tuple3' s Int (Either s s)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (s -> Either s s
forall a b. a -> Either a b
Left s
fs))
            Continue Int
n s
s -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 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 (Tuple3' s Int (Either s s)) c
-> m (Step (Tuple3' s Int (Either s s)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' s Int (Either s s)) c
 -> m (Step (Tuple3' s Int (Either s s)) c))
-> Step (Tuple3' s Int (Either s s)) c
-> m (Step (Tuple3' s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ Int
-> Tuple3' s Int (Either s s)
-> Step (Tuple3' s Int (Either s s)) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> Either s s -> Tuple3' s Int (Either s s)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (s -> Either s s
forall a b. a -> Either a b
Left s
fs))
            Done Int
n b
b -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 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 ())
                s -> b -> m (Step s c)
fstep s
fs b
b m (Step s c)
-> (Step s c -> m (Step (Tuple3' s Int (Either s s)) c))
-> m (Step (Tuple3' s Int (Either s s)) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tuple3' s Int (Either s s) -> Step (Tuple3' s Int (Either s s)) c)
-> (c -> Step (Tuple3' s Int (Either s s)) c)
-> Step s c
-> m (Step (Tuple3' s Int (Either s s)) c)
forall b a a.
Num b =>
(Tuple3' s b (Either a s) -> a) -> (c -> a) -> Step s c -> m a
handleCollect (Int
-> Tuple3' s Int (Either s s)
-> Step (Tuple3' s Int (Either s s)) c
forall s b. Int -> s -> Step s b
Partial Int
n) (Int -> c -> Step (Tuple3' s Int (Either s s)) c
forall s b. Int -> b -> Step s b
Done Int
n)
            Error String
err -> Step (Tuple3' s Int (Either s s)) c
-> m (Step (Tuple3' s Int (Either s s)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' s Int (Either s s)) c
 -> m (Step (Tuple3' s Int (Either s s)) c))
-> Step (Tuple3' s Int (Either s s)) c
-> m (Step (Tuple3' s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (Tuple3' s Int (Either s s)) c
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        case Step s b
r of
            Partial Int
n s
s -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 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 (Tuple3' s Int (Either s s)) c
-> m (Step (Tuple3' s Int (Either s s)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' s Int (Either s s)) c
 -> m (Step (Tuple3' s Int (Either s s)) c))
-> Step (Tuple3' s Int (Either s s)) c
-> m (Step (Tuple3' s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ Int
-> Tuple3' s Int (Either s s)
-> Step (Tuple3' s Int (Either s s)) c
forall s b. Int -> s -> Step s b
Partial Int
n (s -> Int -> Either s s -> Tuple3' s Int (Either s s)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (s -> Either s s
forall a b. b -> Either a b
Right s
fs))
            Continue Int
n s
s -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 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 (Tuple3' s Int (Either s s)) c
-> m (Step (Tuple3' s Int (Either s s)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' s Int (Either s s)) c
 -> m (Step (Tuple3' s Int (Either s s)) c))
-> Step (Tuple3' s Int (Either s s)) c
-> m (Step (Tuple3' s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ Int
-> Tuple3' s Int (Either s s)
-> Step (Tuple3' s Int (Either s s)) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> Either s s -> Tuple3' s Int (Either s s)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
s (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (s -> Either s s
forall a b. b -> Either a b
Right s
fs))
            Done Int
n b
b -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
cnt1 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 ())
                s -> b -> m (Step s c)
fstep s
fs b
b m (Step s c)
-> (Step s c -> m (Step (Tuple3' s Int (Either s s)) c))
-> m (Step (Tuple3' s Int (Either s s)) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tuple3' s Int (Either s s) -> Step (Tuple3' s Int (Either s s)) c)
-> (c -> Step (Tuple3' s Int (Either s s)) c)
-> Step s c
-> m (Step (Tuple3' s Int (Either s s)) c)
forall b a a.
Num b =>
(Tuple3' s b (Either a s) -> a) -> (c -> a) -> Step s c -> m a
handleCollect (Int
-> Tuple3' s Int (Either s s)
-> Step (Tuple3' s Int (Either s s)) c
forall s b. Int -> s -> Step s b
Partial Int
n) (Int -> c -> Step (Tuple3' s Int (Either s s)) c
forall s b. Int -> b -> Step s b
Done Int
n)
            Error String
_ -> Int -> c -> Step (Tuple3' s Int (Either s s)) c
forall s b. Int -> b -> Step s b
Done Int
cnt1 (c -> Step (Tuple3' s Int (Either s s)) c)
-> m c -> m (Step (Tuple3' s Int (Either s s)) c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
fextract s
fs

    -- XXX The "try" may impact performance if this parser is used as a scan
    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 -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
b1
    extract (Tuple3' s
s b
_ (Right s
fs)) = do
        Either ParseError b
r <- m b -> m (Either ParseError b)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m b -> m (Either ParseError b)) -> m b -> m (Either ParseError b)
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 -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
b1

-- | See 'Streamly.Internal.Data.Parser.die'.
--
-- /Pre-release/
--
{-# INLINE_NORMAL die #-}
die :: MonadThrow m => String -> Parser m a b
die :: String -> Parser m a b
die String
err = (Any -> a -> m (Step Any b))
-> m (Initial Any b) -> (Any -> 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 Any -> a -> m (Step Any b)
forall a. HasCallStack => a
undefined (Initial Any b -> m (Initial Any b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Initial Any b
forall s b. String -> Initial s b
IError String
err)) Any -> m b
forall a. HasCallStack => a
undefined

-- | See 'Streamly.Internal.Data.Parser.dieM'.
--
-- /Pre-release/
--
{-# INLINE dieM #-}
dieM :: MonadThrow m => m String -> Parser m a b
dieM :: m String -> Parser m a b
dieM m String
err = (Any -> a -> m (Step Any b))
-> m (Initial Any b) -> (Any -> 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 Any -> a -> m (Step Any b)
forall a. HasCallStack => a
undefined (String -> Initial Any b
forall s b. String -> Initial s b
IError (String -> Initial Any b) -> m String -> m (Initial Any b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
err) Any -> m b
forall a. HasCallStack => a
undefined

-- Note: The default implementations of "some" and "many" loop infinitely
-- because of the strict pattern match on both the arguments in applicative and
-- alternative. With the direct style parser type we cannot use the mutually
-- recursive definitions of "some" and "many".
--
-- Note: With the direct style parser type, the list in "some" and "many" is
-- accumulated strictly, it cannot be consumed lazily.

-- | 'Alternative' instance using 'alt'.
--
-- Note: The implementation of '<|>' is not lazy in the second
-- argument. The following code will fail:
--
-- >>> Stream.parse (Parser.satisfy (> 0) <|> undefined) $ Stream.fromList [1..10]
-- 1
--
instance MonadCatch m => Alternative (Parser m a) where
    {-# INLINE empty #-}
    empty :: Parser m a a
empty = String -> Parser m a a
forall (m :: * -> *) a b. MonadThrow m => String -> Parser m a b
die String
"empty"

    {-# INLINE (<|>) #-}
    <|> :: Parser m a a -> Parser m a a -> Parser m a 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 :: Parser m a a -> Parser m a [a]
many = (Parser m a a -> Fold m a [a] -> Parser m a [a])
-> Fold m a [a] -> Parser m a a -> Parser m a [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser m a a -> Fold m a [a] -> Parser m a [a]
forall (m :: * -> *) a b c.
MonadCatch m =>
Parser m a b -> Fold m b c -> Parser m a c
splitMany Fold m a [a]
forall (m :: * -> *) a. Monad m => Fold m a [a]
toList

    {-# INLINE some #-}
    some :: Parser m a a -> Parser m a [a]
some = (Parser m a a -> Fold m a [a] -> Parser m a [a])
-> Fold m a [a] -> Parser m a a -> Parser m a [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser m a a -> Fold m a [a] -> Parser m a [a]
forall (m :: * -> *) a b c.
MonadCatch m =>
Parser m a b -> Fold m b c -> Parser m a c
splitSome Fold m a [a]
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)

-- | See 'Streamly.Internal.Data.Parser.concatMap'.
--
-- /Pre-release/
--
{-# INLINE concatMap #-}
concatMap :: MonadThrow m =>
    (b -> Parser m a c) -> Parser m a b -> Parser m a c
concatMap :: (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) = (ConcatParseState s m a c
 -> a -> m (Step (ConcatParseState s m a c) c))
-> m (Initial (ConcatParseState s m a c) c)
-> (ConcatParseState s m a c -> 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 ConcatParseState s m a c
-> a -> m (Step (ConcatParseState s m a c) c)
step m (Initial (ConcatParseState s m a c) c)
initial ConcatParseState s m a c -> m c
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
        Initial (ConcatParseState sl m a b) b
-> m (Initial (ConcatParseState sl m a b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (ConcatParseState sl m a b) b
 -> m (Initial (ConcatParseState sl m a b) b))
-> Initial (ConcatParseState sl m a b) b
-> m (Initial (ConcatParseState sl m a b) b)
forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
            IPartial s
sr -> ConcatParseState sl m a b -> Initial (ConcatParseState sl m a b) b
forall s b. s -> Initial s b
IPartial (ConcatParseState sl m a b
 -> Initial (ConcatParseState sl m a b) b)
-> ConcatParseState sl m a b
-> Initial (ConcatParseState sl m a b) b
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatParseState sl m 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 -> b -> Initial (ConcatParseState sl m a b) b
forall s b. b -> Initial s b
IDone b
br
            IError String
err -> String -> Initial (ConcatParseState sl m a b) b
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 -> Initial (ConcatParseState s m a c) c
-> m (Initial (ConcatParseState s m a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (ConcatParseState s m a c) c
 -> m (Initial (ConcatParseState s m a c) c))
-> Initial (ConcatParseState s m a c) c
-> m (Initial (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ ConcatParseState s m a c -> Initial (ConcatParseState s m a c) c
forall s b. s -> Initial s b
IPartial (ConcatParseState s m a c -> Initial (ConcatParseState s m a c) c)
-> ConcatParseState s m a c -> Initial (ConcatParseState s m a c) c
forall a b. (a -> b) -> a -> b
$ s -> ConcatParseState s m a c
forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s
            IDone b
b -> Parser m a c -> m (Initial (ConcatParseState s m a c) c)
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 -> Initial (ConcatParseState s m a c) c
-> m (Initial (ConcatParseState s m a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (ConcatParseState s m a c) c
 -> m (Initial (ConcatParseState s m a c) c))
-> Initial (ConcatParseState s m a c) c
-> m (Initial (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ String -> Initial (ConcatParseState s m a c) c
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
        Step (ConcatParseState sl m a b) b
-> m (Step (ConcatParseState sl m a b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState sl m a b) b
 -> m (Step (ConcatParseState sl m a b) b))
-> Step (ConcatParseState sl m a b) b
-> m (Step (ConcatParseState sl m a b) b)
forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
            IPartial s
sr -> Int
-> ConcatParseState sl m a b -> Step (ConcatParseState sl m a b) b
forall s b. Int -> s -> Step s b
Continue Int
n (ConcatParseState sl m a b -> Step (ConcatParseState sl m a b) b)
-> ConcatParseState sl m a b -> Step (ConcatParseState sl m a b) b
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatParseState sl m 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 -> Int -> b -> Step (ConcatParseState sl m a b) b
forall s b. Int -> b -> Step s b
Done Int
n b
br
            IError String
err -> String -> Step (ConcatParseState sl m a b) b
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 -> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState s m a c) c
 -> m (Step (ConcatParseState s m a c) c))
-> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ Int
-> ConcatParseState s m a c -> Step (ConcatParseState s m a c) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> ConcatParseState s m a c
forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s)
            Continue Int
n s
s -> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState s m a c) c
 -> m (Step (ConcatParseState s m a c) c))
-> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ Int
-> ConcatParseState s m a c -> Step (ConcatParseState s m a c) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> ConcatParseState s m a c
forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s)
            Done Int
n b
b -> Int -> Parser m a c -> m (Step (ConcatParseState s m a c) c)
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 -> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState s m a c) c
 -> m (Step (ConcatParseState s m a c) c))
-> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (ConcatParseState s m a c) c
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
        Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState s m a c) c
 -> m (Step (ConcatParseState s m a c) c))
-> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Partial Int
n s
s -> Int
-> ConcatParseState s m a c -> Step (ConcatParseState s m a c) c
forall s b. Int -> s -> Step s b
Partial Int
n (ConcatParseState s m a c -> Step (ConcatParseState s m a c) c)
-> ConcatParseState s m a c -> Step (ConcatParseState s m a c) c
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s c))
-> s -> (s -> m c) -> ConcatParseState s m a c
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 -> Int
-> ConcatParseState s m a c -> Step (ConcatParseState s m a c) c
forall s b. Int -> s -> Step s b
Continue Int
n (ConcatParseState s m a c -> Step (ConcatParseState s m a c) c)
-> ConcatParseState s m a c -> Step (ConcatParseState s m a c) c
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s c))
-> s -> (s -> m c) -> ConcatParseState s m a c
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 -> Int -> c -> Step (ConcatParseState s m a c) c
forall s b. Int -> b -> Step s b
Done Int
n c
b
            Error String
err -> String -> Step (ConcatParseState s m a c) c
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 -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
            IError String
err -> 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

    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 m b -> (b -> m c) -> m c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser m a c -> m c
forall (m :: * -> *) a b. MonadThrow m => Parser m a b -> m b
extractP (Parser m a c -> m c) -> (b -> Parser m a c) -> b -> m c
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 :: (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) =
    (ConcatParseState s m a c
 -> a -> m (Step (ConcatParseState s m a c) c))
-> m (Initial (ConcatParseState s m a c) c)
-> (ConcatParseState s m a c -> 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 ConcatParseState s m a c
-> a -> m (Step (ConcatParseState s m a c) c)
step m (Initial (ConcatParseState s m a c) c)
initial ConcatParseState s m a c -> m c
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
        Initial (ConcatParseState sl m a b) b
-> m (Initial (ConcatParseState sl m a b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (ConcatParseState sl m a b) b
 -> m (Initial (ConcatParseState sl m a b) b))
-> Initial (ConcatParseState sl m a b) b
-> m (Initial (ConcatParseState sl m a b) b)
forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
            IPartial s
sr -> ConcatParseState sl m a b -> Initial (ConcatParseState sl m a b) b
forall s b. s -> Initial s b
IPartial (ConcatParseState sl m a b
 -> Initial (ConcatParseState sl m a b) b)
-> ConcatParseState sl m a b
-> Initial (ConcatParseState sl m a b) b
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatParseState sl m 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 -> b -> Initial (ConcatParseState sl m a b) b
forall s b. b -> Initial s b
IDone b
br
            IError String
err -> String -> Initial (ConcatParseState sl m a b) b
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 -> Initial (ConcatParseState s m a c) c
-> m (Initial (ConcatParseState s m a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (ConcatParseState s m a c) c
 -> m (Initial (ConcatParseState s m a c) c))
-> Initial (ConcatParseState s m a c) c
-> m (Initial (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ ConcatParseState s m a c -> Initial (ConcatParseState s m a c) c
forall s b. s -> Initial s b
IPartial (ConcatParseState s m a c -> Initial (ConcatParseState s m a c) c)
-> ConcatParseState s m a c -> Initial (ConcatParseState s m a c) c
forall a b. (a -> b) -> a -> b
$ s -> ConcatParseState s m a c
forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s
            IDone b
b -> Parser m a c -> m (Initial (ConcatParseState s m a c) c)
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 -> Initial (ConcatParseState s m a c) c
-> m (Initial (ConcatParseState s m a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (ConcatParseState s m a c) c
 -> m (Initial (ConcatParseState s m a c) c))
-> Initial (ConcatParseState s m a c) c
-> m (Initial (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ String -> Initial (ConcatParseState s m a c) c
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
        Step (ConcatParseState sl m a b) b
-> m (Step (ConcatParseState sl m a b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState sl m a b) b
 -> m (Step (ConcatParseState sl m a b) b))
-> Step (ConcatParseState sl m a b) b
-> m (Step (ConcatParseState sl m a b) b)
forall a b. (a -> b) -> a -> b
$ case Initial s b
resR of
            IPartial s
sr -> Int
-> ConcatParseState sl m a b -> Step (ConcatParseState sl m a b) b
forall s b. Int -> s -> Step s b
Partial Int
n (ConcatParseState sl m a b -> Step (ConcatParseState sl m a b) b)
-> ConcatParseState sl m a b -> Step (ConcatParseState sl m a b) b
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatParseState sl m 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 -> Int -> b -> Step (ConcatParseState sl m a b) b
forall s b. Int -> b -> Step s b
Done Int
n b
br
            IError String
err -> String -> Step (ConcatParseState sl m a b) b
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 -> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState s m a c) c
 -> m (Step (ConcatParseState s m a c) c))
-> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ Int
-> ConcatParseState s m a c -> Step (ConcatParseState s m a c) c
forall s b. Int -> s -> Step s b
Partial Int
n (s -> ConcatParseState s m a c
forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s)
            Continue Int
n s
s -> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState s m a c) c
 -> m (Step (ConcatParseState s m a c) c))
-> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ Int
-> ConcatParseState s m a c -> Step (ConcatParseState s m a c) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> ConcatParseState s m a c
forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s)
            Done Int
n b
b -> Int -> Parser m a c -> m (Step (ConcatParseState s m a c) c)
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 -> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState s m a c) c
 -> m (Step (ConcatParseState s m a c) c))
-> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (ConcatParseState s m a c) c
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
        Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState s m a c) c
 -> m (Step (ConcatParseState s m a c) c))
-> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Partial Int
n s
s -> Int
-> ConcatParseState s m a c -> Step (ConcatParseState s m a c) c
forall s b. Int -> s -> Step s b
Partial Int
n (ConcatParseState s m a c -> Step (ConcatParseState s m a c) c)
-> ConcatParseState s m a c -> Step (ConcatParseState s m a c) c
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s c))
-> s -> (s -> m c) -> ConcatParseState s m a c
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 -> Int
-> ConcatParseState s m a c -> Step (ConcatParseState s m a c) c
forall s b. Int -> s -> Step s b
Continue Int
n (ConcatParseState s m a c -> Step (ConcatParseState s m a c) c)
-> ConcatParseState s m a c -> Step (ConcatParseState s m a c) c
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s c))
-> s -> (s -> m c) -> ConcatParseState s m a c
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 -> Int -> c -> Step (ConcatParseState s m a c) c
forall s b. Int -> b -> Step s b
Done Int
n c
b
            Error String
err -> String -> Step (ConcatParseState s m a c) c
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 -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
            IError String
err -> 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

    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 m b -> (b -> m c) -> m c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser m a c -> m c
forall (m :: * -> *) a b. MonadThrow m => Parser m a b -> m b
extractP (Parser m a c -> m c) -> (b -> Parser m a c) -> b -> m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Parser m a c
func

-- Note: The monad instance has quadratic performance complexity. It works fine
-- for small number of compositions but for a scalable implementation we need a
-- CPS version.

-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.
--
instance MonadThrow m => Monad (Parser m a) where
    {-# INLINE return #-}
    return :: a -> Parser m a a
return = a -> Parser m a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    {-# INLINE (>>=) #-}
    >>= :: Parser m a a -> (a -> Parser m a b) -> Parser m a b
(>>=) = ((a -> Parser m a b) -> Parser m a a -> Parser m 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 (a -> Parser m a b) -> Parser m a a -> Parser m a b
forall (m :: * -> *) b a c.
MonadThrow m =>
(b -> Parser m a c) -> Parser m a b -> Parser m a c
concatMap

    {-# INLINE (>>) #-}
    >> :: Parser m a a -> Parser m a b -> Parser m 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
(*>)

-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.
--
instance MonadCatch m => MonadPlus (Parser m a) where
    {-# INLINE mzero #-}
    mzero :: Parser m a a
mzero = String -> Parser m a a
forall (m :: * -> *) a b. MonadThrow m => String -> Parser m a b
die String
"mzero"

    {-# INLINE mplus #-}
    mplus :: Parser m a a -> Parser m a a -> Parser m a a
mplus = 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