{-# LANGUAGE UndecidableInstances #-}
#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.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader.Class (MonadReader, ask, local)
import Control.Monad.State.Class (MonadState, get, put)
import Control.Monad.Catch (MonadCatch, try, throwM, MonadThrow)
import Data.Bifunctor (Bifunctor(..))
import Fusion.Plugin.Types (Fuse(..))
import Streamly.Internal.Data.Fold.Type (Fold(..), toList)
import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))

import qualified Streamly.Internal.Data.Fold.Type as FL

import Prelude hiding (concatMap)
--
-- $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

-- XXX The only differences between Initial and Step types are:
--
-- * There are no backtracking counts in Initial
-- * Continue and Partial are the same. Ideally Partial should mean that an
-- empty result is valid and can be extracted; and Continue should mean that
-- empty would result in an error on extraction. We can possibly distinguish
-- the two cases.
--
-- If we ignore the backtracking counts we can represent the Initial type using
-- Step itself. That will also simplify the implementation of various parsers
-- where the processing in intiial is just a sepcial case of step, see
-- takeBetween for example.
--
-- | 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

-- We can simplify the Step type as follows:
--
-- Partial Int (Either s (s, b)) -- Left continue, right partial result
-- Done Int (Either String b)
--
-- In this case Error may also have a "leftover" return. This means that after
-- serveral successful partial results the last segment parsing failed and we
-- are returning the leftover of that. The driver may choose to restart from
-- the last segment where this parser failed or from the beginning.
--
-- Folds can only return the right values. Parsers can also return lefts.

-- | 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. If the parser hits the end of input 'extract' is called.
-- 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

instance (MonadThrow m, MonadReader r m, MonadCatch m) => MonadReader r (Parser m a) where
    {-# INLINE ask #-}
    ask :: Parser m a r
ask = m r -> Parser m a r
forall (m :: * -> *) b a. Monad m => m b -> Parser m a b
fromEffect m r
forall r (m :: * -> *). MonadReader r m => m r
ask
    {-# INLINE local #-}
    local :: (r -> r) -> Parser m a a -> Parser m a a
local r -> r
f (Parser s -> a -> m (Step s a)
step m (Initial s a)
init' s -> m a
extract) =
      (s -> a -> m (Step s a))
-> m (Initial s a) -> (s -> m a) -> Parser m a a
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
Parser (((r -> r) -> m (Step s a) -> m (Step s a)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (m (Step s a) -> m (Step s a))
-> (a -> m (Step s a)) -> a -> m (Step s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> m (Step s a)) -> a -> m (Step s a))
-> (s -> a -> m (Step s a)) -> s -> a -> m (Step s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> m (Step s a)
step)
             ((r -> r) -> m (Initial s a) -> m (Initial s a)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f m (Initial s a)
init')
             ((r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (m a -> m a) -> (s -> m a) -> s -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m a
extract)


instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where
    {-# INLINE get #-}
    get :: Parser m a s
get = m s -> Parser m a s
forall (m :: * -> *) b a. Monad m => m b -> Parser m a b
fromEffect m s
forall s (m :: * -> *). MonadState s m => m s
get
    {-# INLINE put #-}
    put :: s -> Parser m a ()
put = m () -> Parser m a ()
forall (m :: * -> *) b a. Monad m => m b -> Parser m a b
fromEffect (m () -> Parser m a ()) -> (s -> m ()) -> s -> Parser m a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put


instance (MonadThrow m, MonadIO m) => MonadIO (Parser m a) where
    {-# INLINE liftIO #-}
    liftIO :: IO a -> Parser m a a
liftIO = m a -> Parser m a a
forall (m :: * -> *) b a. Monad m => m b -> Parser m a b
fromEffect (m a -> Parser m a a) -> (IO a -> m a) -> IO a -> Parser m a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO