{-# LANGUAGE CPP #-}
-- |
-- 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 is 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.
--
-- = Optimizing backtracking
--
-- == Applicative Composition
--
-- If a parser once returned 'Partial' it can never fail after that. This is
-- used to reduce the buffering. A 'Partial' results in dropping the buffer and
-- we cannot backtrack before that point.
--
-- Parsers can be composed using an Alternative, if we are in an alternative
-- composition we may have to backtrack to try the other branch.  When we
-- compose two parsers using applicative @f <$> p1 <*> p2@ we can return a
-- 'Partial' result only after both the parsers have succeeded. While running
-- @p1@ we have to ensure that the input is not dropped until we have run @p2@,
-- therefore we have to return a Continue instead of a Partial.
--
-- However, if we know they both cannot fail then we know that the composed
-- parser can never fail.  For this reason we should have "backtracking folds"
-- as a separate type so that we can compose them in an efficient manner. In p1
-- itself we can drop the buffer as soon as a 'Partial' result arrives. In
-- fact, there is no Alternative composition for folds because they cannot
-- fail.
--
-- == Alternative Composition
--
-- In @p1 <|> p2@ as soon as the parser p1 returns 'Partial' we know that it
-- will not fail and we can immediately drop the buffer.
--
-- If we are not using the parser in an alternative composition we can
-- downgrade the parser to a backtracking fold and use the "backtracking
-- fold"'s applicative for more efficient implementation. To downgrade we can
-- translate the "Error" of parser to an exception.  This gives us best of both
-- worlds, the applicative as well as alternative would have optimal
-- backtracking buffer.
--
-- The "many" for parsers would be different than "many" for folds. In case of
-- folds an error would be propagated. In case of parsers the error would be
-- ignored.
--
-- = Implementation Approach
--
-- Backtracking folds have an issue with tee style composition because each
-- fold can backtrack independently, we will need independent buffers. Though
-- this may be possible to implement it may not be efficient especially for
-- folds that do not backtrack at all. Three types are possible, optimized for
-- different use cases:
--
-- * Non-backtracking folds: efficient Tee
-- * Backtracking folds: efficient applicative
-- * Parsers: alternative
--
-- Downgrade parsers to backtracking folds for applicative used without
-- alternative.  Upgrade backtracking folds to parsers when we have to use them
-- as the last alternative.
--
-- = 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).
--
-- == Naming
--
-- As far as possible, try that the names of the combinators in this module are
-- consistent with:
--
-- * <https://hackage.haskell.org/package/base/docs/Text-ParserCombinators-ReadP.html base/Text.ParserCombinators.ReadP>
-- * <http://hackage.haskell.org/package/parser-combinators parser-combinators>
-- * <http://hackage.haskell.org/package/megaparsec megaparsec>
-- * <http://hackage.haskell.org/package/attoparsec attoparsec>
-- * <http://hackage.haskell.org/package/parsec parsec>

module Streamly.Internal.Data.Parser.Type
    (
    -- * Types
      Initial (..)
    , Step (..)
    , extractStep
    , bimapOverrideCount
    , Parser (..)
    , ParseError (..)
    , rmapM

    -- * Constructors

    , fromPure
    , fromEffect
    , splitWith
    , split_

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

    -- * Input transformation
    , lmap
    , lmapM
    , filter

    , noErrorUnsafeSplitWith
    , noErrorUnsafeSplit_
    , noErrorUnsafeConcatMap
    )
where

#include "inline.hs"
#include "assert.hs"

#if !MIN_VERSION_base(4,18,0)
import Control.Applicative (liftA2)
#endif
import Control.Applicative (Alternative(..))
import Control.Exception (Exception(..))
-- import Control.Monad (MonadPlus(..), (>=>))
import Control.Monad ((>=>))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bifunctor (Bifunctor(..))
import Fusion.Plugin.Types (Fuse(..))
import Streamly.Internal.Data.Fold.Type (Fold(..), toList)

import qualified Control.Monad.Fail as Fail
import qualified Streamly.Internal.Data.Fold.Type as FL

import Prelude hiding (concatMap, filter)

#include "DocTestDataParser.hs"

-- 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 :: forall a b c d. (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

-- | Maps a function over the result held by 'IDone'.
--
-- >>> fmap = second
--
-- /Internal/
--
instance Functor (Initial s) where
    {-# INLINE fmap #-}
    fmap :: forall a b. (a -> b) -> Initial s a -> Initial s b
fmap = (a -> b) -> Initial s a -> Initial s b
forall b c a. (b -> c) -> Initial a b -> Initial a c
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
-- several 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 count state@. The following hold on Partial result:
    --
    -- 1. @extract@ on @state@ would succeed and give a result.
    -- 2. Input stream position is reset to @current position - count@.
    -- 3. All input before the new position is dropped. The parser can
    -- never backtrack beyond this position.

    | Continue !Int !s
    -- ^ @Continue count state@. The following hold on a Continue result:
    --
    -- 1. If there was a 'Partial' result in past, @extract@ on @state@ would
    -- give that result as 'Done' otherwise it may return 'Error' or
    -- 'Continue'.
    -- 2. Input stream position is reset to @current position - count@.
    -- 3. the input is retained in a backtrack buffer.

    | 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.

-- | Map first function over the state and second over the result.
instance Bifunctor Step where
    {-# INLINE bimap #-}
    bimap :: forall a b c d. (a -> b) -> (c -> d) -> Step a c -> Step b d
bimap a -> b
f c -> d
g Step a c
step =
        case Step a c
step of
            Partial Int
n a
s -> Int -> b -> Step b d
forall s b. Int -> s -> Step s b
Partial Int
n (a -> b
f a
s)
            Continue Int
n a
s -> Int -> b -> Step b d
forall s b. Int -> s -> Step s b
Continue Int
n (a -> b
f a
s)
            Done Int
n c
b -> Int -> d -> Step b d
forall s b. Int -> b -> Step s b
Done Int
n (c -> d
g c
b)
            Error String
err -> String -> Step b d
forall s b. String -> Step s b
Error String
err

-- | Bimap discarding the count, and using the supplied count instead.
bimapOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1
bimapOverrideCount :: forall s s1 b b1.
Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1
bimapOverrideCount Int
n s -> s1
f b -> b1
g Step s b
step =
    case Step s b
step of
        Partial Int
_ s
s -> Int -> s1 -> Step s1 b1
forall s b. Int -> s -> Step s b
Partial Int
n (s -> s1
f s
s)
        Continue Int
_ s
s -> Int -> s1 -> Step s1 b1
forall s b. Int -> s -> Step s b
Continue Int
n (s -> s1
f s
s)
        Done Int
_ b
b -> Int -> b1 -> Step s1 b1
forall s b. Int -> b -> Step s b
Done Int
n (b -> b1
g b
b)
        Error String
err -> String -> Step s1 b1
forall s b. String -> Step s b
Error String
err

-- | fmap = second
instance Functor (Step s) where
    {-# INLINE fmap #-}
    fmap :: forall a b. (a -> b) -> Step s a -> Step s b
fmap = (a -> b) -> Step s a -> Step s b
forall b c a. (b -> c) -> Step a b -> Step a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second

{-# INLINE assertStepCount #-}
assertStepCount :: Int -> Step s b -> Step s b
assertStepCount :: forall s b. Int -> Step s b -> Step s b
assertStepCount Int
i Step s b
step =
    case Step s b
step of
        Partial Int
n s
_ -> Bool -> Step s b -> Step s b
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) Step s b
step
        Continue Int
n s
_ -> Bool -> Step s b -> Step s b
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) Step s b
step
        Done Int
n b
_ -> Bool -> Step s b -> Step s b
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) Step s b
step
        Error String
_ -> Step s b
step

-- | Map an extract function over the state of Step
--
{-# INLINE extractStep #-}
extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b)
extractStep :: forall (m :: * -> *) s s1 b.
Monad m =>
(s -> m (Step s1 b)) -> Step s b -> m (Step s1 b)
extractStep s -> m (Step s1 b)
f Step s b
res =
    case Step s b
res of
        Partial Int
n s
s1 -> Int -> Step s1 b -> Step s1 b
forall s b. Int -> Step s b -> Step s b
assertStepCount Int
n (Step s1 b -> Step s1 b) -> m (Step s1 b) -> m (Step s1 b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Step s1 b)
f s
s1
        Done Int
n b
b -> Step s1 b -> m (Step s1 b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s1 b -> m (Step s1 b)) -> Step s1 b -> m (Step s1 b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step s1 b
forall s b. Int -> b -> Step s b
Done Int
n b
b
        Continue Int
n s
s1 -> Int -> Step s1 b -> Step s1 b
forall s b. Int -> Step s b -> Step s b
assertStepCount Int
n (Step s1 b -> Step s1 b) -> m (Step s1 b) -> m (Step s1 b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (Step s1 b)
f s
s1
        Error String
err -> Step s1 b -> m (Step s1 b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s1 b -> m (Step s1 b)) -> Step s1 b -> m (Step s1 b)
forall a b. (a -> b) -> a -> b
$ String -> Step s1 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 :: forall (m :: * -> *) a b s.
Applicative m =>
(a -> m b) -> Step s a -> m (Step s b)
mapMStep a -> m b
f Step s a
res =
    case Step s a
res of
        Partial Int
n s
s -> Step s b -> m (Step s b)
forall a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 a m b =
    forall s. Parser
        (s -> a -> m (Step s b))
        -- Initial cannot return "Partial/Done n" or "Continue". Continue 0 is
        -- same as Partial 0. In other words it cannot backtrack.
        (m (Initial s b))
        -- Extract can only return Partial or Continue n. In other words it can
        -- only backtrack or return partial result/error. But we do not return
        -- result in Partial, therefore, we have to use Done instead of Partial.
        (s -> m (Step s b))

-- | This exception is used when a parser ultimately fails, the user of the
-- parser is intimated via this exception.
--
-- /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
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> ShowS
showList :: [ParseError] -> ShowS
Show

instance Exception ParseError where
    displayException :: ParseError -> String
displayException (ParseError String
err) = String
err

-- | Map a function on the result i.e. on @b@ in @Parser a m b@.
instance Functor m => Functor (Parser a m) where
    {-# INLINE fmap #-}
    fmap :: forall a b. (a -> b) -> Parser a m a -> Parser a m b
fmap a -> b
f (Parser s -> a -> m (Step s a)
step1 m (Initial s a)
initial1 s -> m (Step s a)
extract) =
        (s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser s -> a -> m (Step s b)
step m (Initial s b)
initial ((a -> b) -> (s -> m (Step s a)) -> s -> m (Step s b)
forall {f :: * -> *} {f :: * -> *} {f :: * -> *} {a} {b}.
(Functor f, Functor f, Functor f) =>
(a -> b) -> f (f (f a)) -> f (f (f b))
fmap3 a -> b
f s -> m (Step s 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 a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
g)
        fmap3 :: (a -> b) -> f (f (f a)) -> f (f (f b))
fmap3 a -> b
g = (f a -> f b) -> f (f (f a)) -> f (f (f b))
forall {f :: * -> *} {f :: * -> *} {a} {b}.
(Functor f, Functor f) =>
(a -> b) -> f (f a) -> f (f b)
fmap2 ((a -> b) -> f a -> f b
forall a b. (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
------------------------------------------------------------------------------

-- | @rmapM f parser@ maps the monadic function @f@ on the output of the parser.
--
-- >>> rmap = fmap
{-# INLINE rmapM #-}
rmapM :: Monad m => (b -> m c) -> Parser a m b -> Parser a m c
rmapM :: forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Parser a m b -> Parser a m c
rmapM b -> m c
f (Parser s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m (Step s b)
extract) =
    (s -> a -> m (Step s c))
-> m (Initial s c) -> (s -> m (Step s c)) -> Parser a m c
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser s -> a -> m (Step s c)
step1 m (Initial s c)
initial1 (s -> m (Step s b)
extract (s -> m (Step s b))
-> (Step s b -> m (Step s c)) -> s -> m (Step s c)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (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)

    where

    initial1 :: m (Initial s c)
initial1 = do
        Initial s b
res <- m (Initial s b)
initial
        -- this is mapM f over result
        case Initial s b
res of
            IPartial s
x -> Initial s c -> m (Initial s c)
forall a. a -> m a
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 a. a -> m a
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 a b. m a -> (a -> m b) -> m b
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

-- | A parser that always yields a pure value without consuming any input.
--
{-# INLINE_NORMAL fromPure #-}
fromPure :: Monad m => b -> Parser a m b
fromPure :: forall (m :: * -> *) b a. Monad m => b -> Parser a m b
fromPure b
b = (Any -> a -> m (Step Any b))
-> m (Initial Any b) -> (Any -> m (Step Any b)) -> Parser a m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser Any -> a -> m (Step Any b)
forall a. (?callStack::CallStack) => a
undefined (Initial Any b -> m (Initial Any b)
forall a. a -> m a
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 (Step Any b)
forall a. (?callStack::CallStack) => a
undefined

-- | A parser that always yields the result of an effectful action without
-- consuming any input.
--
{-# INLINE fromEffect #-}
fromEffect :: Monad m => m b -> Parser a m b
fromEffect :: forall (m :: * -> *) b a. Monad m => m b -> Parser a m b
fromEffect m b
b = (Any -> a -> m (Step Any b))
-> m (Initial Any b) -> (Any -> m (Step Any b)) -> Parser a m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser Any -> a -> m (Step Any b)
forall a. (?callStack::CallStack) => 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 (Step Any b)
forall a. (?callStack::CallStack) => a
undefined

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

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

-- Note: this implementation of splitWith 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.
--
-- Note: This is a parsing dual of appending streams using
-- 'Streamly.Data.Stream.append', it splits the streams using two parsers and
-- zips the results.

-- | Sequential parser application. Apply two parsers sequentially to an input
-- stream. The first parser runs and processes the input, the remaining input
-- is then passed to the second parser. If both parsers succeed, their outputs
-- are combined using the supplied function. If either parser fails, the
-- operation fails.
--
-- This combinator delivers high performance by stream fusion but it comes with
-- some limitations. For those cases use the 'Applicative' instance of
-- 'Streamly.Data.ParserK.ParserK'.
--
-- CAVEAT 1: NO RECURSION. This function is strict in both arguments. As a
-- result, if a parser is defined recursively using this, it may cause an
-- infintie loop. The following example checks the strictness:
--
-- >>> p = Parser.splitWith const (Parser.satisfy (> 0)) undefined
-- >>> Stream.parse p $ Stream.fromList [1]
-- *** Exception: Prelude.undefined
-- ...
--
-- CAVEAT 2: QUADRATIC TIME COMPLEXITY. Static composition is fast due to
-- stream fusion, but it works well only for limited (e.g. up to 8)
-- compositions, use "Streamly.Data.ParserK" for larger compositions.
--
-- Below are some common idioms that can be expressed using 'splitWith':
--
-- >>> span p f1 f2 = Parser.splitWith (,) (Parser.takeWhile p f1) (Parser.fromFold f2)
-- >>> spanBy eq f1 f2 = Parser.splitWith (,) (Parser.groupBy eq f1) (Parser.fromFold f2)
--
-- /Pre-release/
--
{-# INLINE splitWith #-}
splitWith :: Monad m
    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c
splitWith :: forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c
splitWith a -> b -> c
func (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m (Step s a)
extractL)
               (Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m (Step s 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 (Step (SeqParseState s (b -> c) s) c))
-> Parser x m c
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m 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 (Step (SeqParseState s (b -> c) s) c)
extract

    where

    initial :: m (Initial (SeqParseState s (b -> c) s) c)
initial = do
        -- XXX We can use bimap here if we make this a Step type
        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 a. a -> m a
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
                -- XXX We can use bimap here if we make this a Step type
                Initial (SeqParseState s (b -> c) s) c
-> m (Initial (SeqParseState s (b -> c) s) c)
forall a. a -> m a
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 a. a -> m a
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
        -- Important: Please do not use Applicative here. See
        -- https://github.com/composewell/streamly/issues/1033 and the problem
        -- defined in split_ for more info.
        -- XXX Use bimap
        Step s a
resL <- s -> x -> m (Step s a)
stepL s
st x
a
        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 -> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a. a -> m a
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)
            Continue Int
n s
s -> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a. a -> m a
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
                -- XXX Use bimap if we make this a Step type
                -- fmap (bimap (SeqParseR (func b)) (func b)) initialR
                Initial s b
initR <- m (Initial s b)
initialR
                Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a. a -> m a
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
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 -> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a. a -> m a
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 = (Step s b -> Step (SeqParseState s (b -> c) s) c)
-> m (Step s b) -> m (Step (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> SeqParseState s (b -> c) s)
-> (b -> c) -> Step s b -> Step (SeqParseState s (b -> c) s) c
forall a b c d. (a -> b) -> (c -> d) -> Step a c -> Step b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((b -> c) -> s -> SeqParseState s (b -> c) s
forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR b -> c
f) b -> c
f) (s -> x -> m (Step s b)
stepR s
st x
a)

    extract :: SeqParseState s (b -> c) s
-> m (Step (SeqParseState s (b -> c) s) c)
extract (SeqParseR b -> c
f s
sR) = (Step s b -> Step (SeqParseState s (b -> c) s) c)
-> m (Step s b) -> m (Step (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> SeqParseState s (b -> c) s)
-> (b -> c) -> Step s b -> Step (SeqParseState s (b -> c) s) c
forall a b c d. (a -> b) -> (c -> d) -> Step a c -> Step b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((b -> c) -> s -> SeqParseState s (b -> c) s
forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR b -> c
f) b -> c
f) (s -> m (Step s b)
extractR s
sR)
    extract (SeqParseL s
sL) = do
        -- XXX Use bimap here
        Step s a
rL <- s -> m (Step s a)
extractL s
sL
        case Step s a
rL of
            Done Int
n a
bL -> do
                -- XXX Use bimap here if we use Step type in Initial
                Initial s b
iR <- m (Initial s b)
initialR
                case Initial s b
iR of
                    IPartial s
sR -> do
                        (Step s b -> Step (SeqParseState s (b -> c) s) c)
-> m (Step s b) -> m (Step (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                            ((s -> SeqParseState s (b -> c) s)
-> (b -> c) -> Step s b -> Step (SeqParseState s (b -> c) s) c
forall a b c d. (a -> b) -> (c -> d) -> Step a c -> Step b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((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)) (a -> b -> c
func a
bL))
                            (s -> m (Step s b)
extractR s
sR)
                    IDone b
bR -> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a. a -> m a
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 -> c -> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> b -> Step s b
Done Int
n (c -> Step (SeqParseState s (b -> c) s) c)
-> c -> Step (SeqParseState s (b -> c) s) c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
func a
bL b
bR
                    IError String
err -> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a. a -> m a
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
            Error String
err -> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a. a -> m a
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
            Partial Int
_ s
_ -> String -> m (Step (SeqParseState s (b -> c) s) c)
forall a. (?callStack::CallStack) => String -> a
error String
"Bug: splitWith extract 'Partial'"
            Continue Int
n s
s -> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a. a -> m a
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)

-------------------------------------------------------------------------------
-- Sequential applicative for backtracking folds
-------------------------------------------------------------------------------

-- XXX Create a newtype for nonfailing parsers and downgrade the parser to that
-- type before this operation and then upgrade.
--
-- We can do an inspection testing to reject unwanted constructors at compile
-- time.
--
-- We can use the compiler to automatically annotate accumulators, terminating
-- folds, non-failing parsers and failing parsers.

-- | Better performance 'splitWith' for non-failing parsers.
--
-- Does not work correctly for parsers that can fail.
--
-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.
--
{-# INLINE noErrorUnsafeSplitWith #-}
noErrorUnsafeSplitWith :: Monad m
    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c
noErrorUnsafeSplitWith :: forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c
noErrorUnsafeSplitWith a -> b -> c
func (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m (Step s a)
extractL)
               (Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m (Step s 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 (Step (SeqParseState s (b -> c) s) c))
-> Parser x m c
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m 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 (Step (SeqParseState s (b -> c) s) c)
extract

    where

    errMsg :: String -> a
errMsg String
e = String -> a
forall a. (?callStack::CallStack) => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"noErrorUnsafeSplitWith: unreachable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e

    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 a. a -> m a
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 a. a -> m a
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
$ (s -> SeqParseState s (b -> c) s)
-> (b -> c)
-> Initial s b
-> Initial (SeqParseState s (b -> c) s) c
forall a b c d. (a -> b) -> (c -> d) -> Initial a c -> Initial b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((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)) (a -> b -> c
func a
bl) Initial s b
resR
            IError String
err -> String -> m (Initial (SeqParseState s (b -> c) s) c)
forall {a}. String -> a
errMsg 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 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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 {a}. String -> a
errMsg String
err
            Error String
err -> String -> m (Step (SeqParseState s (b -> c) s) c)
forall {a}. String -> a
errMsg String
err

    step (SeqParseR b -> c
f s
st) x
a = (Step s b -> Step (SeqParseState s (b -> c) s) c)
-> m (Step s b) -> m (Step (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> SeqParseState s (b -> c) s)
-> (b -> c) -> Step s b -> Step (SeqParseState s (b -> c) s) c
forall a b c d. (a -> b) -> (c -> d) -> Step a c -> Step b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((b -> c) -> s -> SeqParseState s (b -> c) s
forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR b -> c
f) b -> c
f) (s -> x -> m (Step s b)
stepR s
st x
a)

    extract :: SeqParseState s (b -> c) s
-> m (Step (SeqParseState s (b -> c) s) c)
extract (SeqParseR b -> c
f s
sR) = (Step s b -> Step (SeqParseState s (b -> c) s) c)
-> m (Step s b) -> m (Step (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> SeqParseState s (b -> c) s)
-> (b -> c) -> Step s b -> Step (SeqParseState s (b -> c) s) c
forall a b c d. (a -> b) -> (c -> d) -> Step a c -> Step b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((b -> c) -> s -> SeqParseState s (b -> c) s
forall sl f sr. f -> sr -> SeqParseState sl f sr
SeqParseR b -> c
f) b -> c
f) (s -> m (Step s b)
extractR s
sR)

    extract (SeqParseL s
sL) = do
        Step s a
rL <- s -> m (Step s a)
extractL s
sL
        case Step s a
rL of
            Done Int
n a
bL -> do
                Initial s b
iR <- m (Initial s b)
initialR
                case Initial s b
iR of
                    IPartial s
sR -> do
                        Step s b
rR <- s -> m (Step s b)
extractR s
sR
                        Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a. a -> m a
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
-> (s -> SeqParseState s (b -> c) s)
-> (b -> c)
-> Step s b
-> Step (SeqParseState s (b -> c) s) c
forall s s1 b b1.
Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1
bimapOverrideCount
                                Int
n ((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)) (a -> b -> c
func a
bL) Step s b
rR
                    IDone b
bR -> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a. a -> m a
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 -> c -> Step (SeqParseState s (b -> c) s) c
forall s b. Int -> b -> Step s b
Done Int
n (c -> Step (SeqParseState s (b -> c) s) c)
-> c -> Step (SeqParseState s (b -> c) s) c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
func a
bL b
bR
                    IError String
err -> String -> m (Step (SeqParseState s (b -> c) s) c)
forall {a}. String -> a
errMsg String
err
            Error String
err -> String -> m (Step (SeqParseState s (b -> c) s) c)
forall {a}. String -> a
errMsg String
err
            Partial Int
_ s
_ -> String -> m (Step (SeqParseState s (b -> c) s) c)
forall {a}. String -> a
errMsg String
"Partial"
            Continue Int
n s
s -> Step (SeqParseState s (b -> c) s) c
-> m (Step (SeqParseState s (b -> c) s) c)
forall a. a -> m a
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)

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

-- This turns out to be slightly faster than splitWith

-- | Sequential parser application ignoring the output of the first parser.
-- Apply two parsers sequentially to an input stream.  The input is provided to
-- the first parser, when it is done the remaining input is provided to the
-- second parser. The output of the parser is the output of the second parser.
-- The operation fails if any of the parsers fail.
--
-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.
--
-- This implementation is strict in the second argument, therefore, the
-- following will fail:
--
-- >>> Stream.parse (Parser.split_ (Parser.satisfy (> 0)) undefined) $ Stream.fromList [1]
-- *** Exception: Prelude.undefined
-- ...
--
-- /Pre-release/
--
{-# INLINE split_ #-}
split_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b
split_ :: forall (m :: * -> *) x a b.
Monad m =>
Parser x m a -> Parser x m b -> Parser x m b
split_ (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m (Step s a)
extractL) (Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m (Step s b)
extractR) =
    (SeqAState s s -> x -> m (Step (SeqAState s s) b))
-> m (Initial (SeqAState s s) b)
-> (SeqAState s s -> m (Step (SeqAState s s) b))
-> Parser x m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser SeqAState s s -> x -> m (Step (SeqAState s s) b)
step m (Initial (SeqAState s s) b)
initial SeqAState s s -> m (Step (SeqAState s s) 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 a. a -> m a
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 a. a -> m a
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
$ (s -> SeqAState s s) -> Initial s b -> Initial (SeqAState s s) b
forall a b c. (a -> b) -> Initial a c -> Initial b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR Initial s b
resR
            IError String
err -> Initial (SeqAState s s) b -> m (Initial (SeqAState s s) b)
forall a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 = (s -> SeqAState s s) -> Step s b -> Step (SeqAState s s) b
forall a b c. (a -> b) -> Step a c -> Step b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR (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 (Step (SeqAState s s) b)
extract (SeqAR s
sR) = (Step s b -> Step (SeqAState s s) b)
-> m (Step s b) -> m (Step (SeqAState s s) b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> SeqAState s s) -> Step s b -> Step (SeqAState s s) b
forall a b c. (a -> b) -> Step a c -> Step b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR) (s -> m (Step s b)
extractR s
sR)
    extract (SeqAL s
sL) = do
        Step s a
rL <- s -> m (Step s a)
extractL s
sL
        case Step s a
rL of
            Done Int
n a
_ -> do
                Initial s b
iR <- m (Initial s b)
initialR
                -- XXX For initial we can have a bimap with leftover.
                case Initial s b
iR of
                    IPartial s
sR ->
                        (Step s b -> Step (SeqAState s s) b)
-> m (Step s b) -> m (Step (SeqAState s s) b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
-> (s -> SeqAState s s)
-> (b -> b)
-> Step s b
-> Step (SeqAState s s) b
forall s s1 b b1.
Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1
bimapOverrideCount Int
n s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR b -> b
forall a. a -> a
id) (s -> m (Step s b)
extractR s
sR)
                    IDone b
bR -> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a. a -> m a
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 -> b -> Step (SeqAState s s) b
forall s b. Int -> b -> Step s b
Done Int
n b
bR
                    IError String
err -> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a. a -> m a
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
            Error String
err -> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a. a -> m a
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
            Partial Int
_ s
_ -> String -> m (Step (SeqAState s s) b)
forall a. (?callStack::CallStack) => String -> a
error String
"split_: Partial"
            Continue Int
n s
s -> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a. a -> m a
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)

-- | Better performance 'split_' for non-failing parsers.
--
-- Does not work correctly for parsers that can fail.
--
-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.
--
{-# INLINE noErrorUnsafeSplit_ #-}
noErrorUnsafeSplit_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b
noErrorUnsafeSplit_ :: forall (m :: * -> *) x a b.
Monad m =>
Parser x m a -> Parser x m b -> Parser x m b
noErrorUnsafeSplit_
    (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m (Step s a)
extractL) (Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m (Step s b)
extractR) =
    (SeqAState s s -> x -> m (Step (SeqAState s s) b))
-> m (Initial (SeqAState s s) b)
-> (SeqAState s s -> m (Step (SeqAState s s) b))
-> Parser x m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser SeqAState s s -> x -> m (Step (SeqAState s s) b)
step m (Initial (SeqAState s s) b)
initial SeqAState s s -> m (Step (SeqAState s s) b)
extract

    where

    errMsg :: String -> a
errMsg String
e = String -> a
forall a. (?callStack::CallStack) => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"noErrorUnsafeSplit_: unreachable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e

    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 a. a -> m a
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 a. a -> m a
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
$ (s -> SeqAState s s) -> Initial s b -> Initial (SeqAState s s) b
forall a b c. (a -> b) -> Initial a c -> Initial b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR Initial s b
resR
            IError String
err -> String -> m (Initial (SeqAState s s) b)
forall {a}. String -> a
errMsg 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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 {a}. String -> a
errMsg String
err
            Error String
err -> String -> m (Step (SeqAState s s) b)
forall {a}. String -> a
errMsg String
err

    step (SeqAR s
st) x
a = (s -> SeqAState s s) -> Step s b -> Step (SeqAState s s) b
forall a b c. (a -> b) -> Step a c -> Step b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR (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 (Step (SeqAState s s) b)
extract (SeqAR s
sR) = (Step s b -> Step (SeqAState s s) b)
-> m (Step s b) -> m (Step (SeqAState s s) b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> SeqAState s s) -> Step s b -> Step (SeqAState s s) b
forall a b c. (a -> b) -> Step a c -> Step b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR) (s -> m (Step s b)
extractR s
sR)
    extract (SeqAL s
sL) = do
        Step s a
rL <- s -> m (Step s a)
extractL s
sL
        case Step s a
rL of
            Done Int
n a
_ -> do
                Initial s b
iR <- m (Initial s b)
initialR
                case Initial s b
iR of
                    IPartial s
sR -> do
                        (Step s b -> Step (SeqAState s s) b)
-> m (Step s b) -> m (Step (SeqAState s s) b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
-> (s -> SeqAState s s)
-> (b -> b)
-> Step s b
-> Step (SeqAState s s) b
forall s s1 b b1.
Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1
bimapOverrideCount Int
n s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR b -> b
forall a. a -> a
id) (s -> m (Step s b)
extractR s
sR)
                    IDone b
bR -> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a. a -> m a
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 -> b -> Step (SeqAState s s) b
forall s b. Int -> b -> Step s b
Done Int
n b
bR
                    IError String
err -> String -> m (Step (SeqAState s s) b)
forall {a}. String -> a
errMsg String
err
            Error String
err -> String -> m (Step (SeqAState s s) b)
forall {a}. String -> a
errMsg String
err
            Partial Int
_ s
_ -> String -> m (Step (SeqAState s s) b)
forall a. (?callStack::CallStack) => String -> a
error String
"split_: Partial"
            Continue Int
n s
s -> Step (SeqAState s s) b -> m (Step (SeqAState s s) b)
forall a. a -> m a
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)

-- | READ THE CAVEATS in 'splitWith' before using this instance.
--
-- >>> pure = Parser.fromPure
-- >>> (<*>) = Parser.splitWith id
-- >>> (*>) = Parser.split_
instance Monad m => Applicative (Parser a m) where
    {-# INLINE pure #-}
    pure :: forall a. a -> Parser a m a
pure = a -> Parser a m a
forall (m :: * -> *) b a. Monad m => b -> Parser a m b
fromPure

    {-# INLINE (<*>) #-}
    <*> :: forall a b. Parser a m (a -> b) -> Parser a m a -> Parser a m b
(<*>) = ((a -> b) -> a -> b)
-> Parser a m (a -> b) -> Parser a m a -> Parser a m b
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c
splitWith (a -> b) -> a -> b
forall a. a -> a
id

    {-# INLINE (*>) #-}
    *> :: forall a b. Parser a m a -> Parser a m b -> Parser a m b
(*>) = Parser a m a -> Parser a m b -> Parser a m b
forall (m :: * -> *) x a b.
Monad m =>
Parser x m a -> Parser x m b -> Parser x m b
split_

    {-# INLINE liftA2 #-}
    liftA2 :: forall a b c.
(a -> b -> c) -> Parser a m a -> Parser a m b -> Parser a m c
liftA2 a -> b -> c
f Parser a m a
x = Parser a m (b -> c) -> Parser a m b -> Parser a m c
forall a b. Parser a m (a -> b) -> Parser a m a -> Parser a m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ((a -> b -> c) -> Parser a m a -> Parser a m (b -> c)
forall a b. (a -> b) -> Parser a m a -> Parser a m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b -> c
f Parser a m a
x)

-------------------------------------------------------------------------------
-- 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

-- | Sequential alternative. The input is first passed to the first parser,
-- if it succeeds, the result is returned. However, if the first parser fails,
-- the parser driver backtracks and tries the same input on the second
-- (alternative) parser, returning the result if it succeeds.
--
-- This combinator delivers high performance by stream fusion but it comes with
-- some limitations. For those cases use the 'Alternative' instance of
-- 'Streamly.Data.ParserK.ParserK'.
--
-- CAVEAT 1: NO RECURSION. This function is strict in both arguments. As a
-- result, if a parser is defined recursively using this, it may cause an
-- infintie loop. The following example checks the strictness:
--
-- >>> p = Parser.satisfy (> 0) `Parser.alt` undefined
-- >>> Stream.parse p $ Stream.fromList [1..10]
-- *** Exception: Prelude.undefined
--
-- CAVEAT 2: QUADRATIC TIME COMPLEXITY. Static composition is fast due to
-- stream fusion, but it works well only for limited (e.g. up to 8)
-- compositions, use "Streamly.Data.ParserK" for larger compositions.
--
-- /Time Complexity:/ O(n^2) where n is the number of compositions.
--
-- /Pre-release/
--
{-# INLINE alt #-}
alt :: Monad m => Parser x m a -> Parser x m a -> Parser x m a
alt :: forall (m :: * -> *) x a.
Monad m =>
Parser x m a -> Parser x m a -> Parser x m a
alt (Parser s -> x -> m (Step s a)
stepL m (Initial s a)
initialL s -> m (Step s a)
extractL) (Parser s -> x -> m (Step s a)
stepR m (Initial s a)
initialR s -> m (Step s a)
extractR) =
    (AltParseState s s -> x -> m (Step (AltParseState s s) a))
-> m (Initial (AltParseState s s) a)
-> (AltParseState s s -> m (Step (AltParseState s s) a))
-> Parser x m a
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser AltParseState s s -> x -> m (Step (AltParseState s s) a)
step m (Initial (AltParseState s s) a)
initial AltParseState s s -> m (Step (AltParseState s s) 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 a. a -> m 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 a. a -> m 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 a. a -> m 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. XXX Can we detect and flag this?
    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 a. a -> m 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
                assertM(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)
                Step (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall a. a -> m 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 a. a -> m 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 a. a -> m 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 a. a -> m 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 (Step (AltParseState s s) a)
extract (AltParseR s
sR) = (Step s a -> Step (AltParseState s s) a)
-> m (Step s a) -> m (Step (AltParseState s s) a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> AltParseState s s) -> Step s a -> Step (AltParseState s s) a
forall a b c. (a -> b) -> Step a c -> Step b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first s -> AltParseState s s
forall sl sr. sr -> AltParseState sl sr
AltParseR) (s -> m (Step s a)
extractR s
sR)

    extract (AltParseL Int
cnt s
sL) = do
        Step s a
rL <- s -> m (Step s a)
extractL s
sL
        case Step s a
rL of
            Done Int
n a
b -> Step (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall a. a -> m 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 a. a -> m 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 (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 a
b
                          IError String
err -> String -> Step (AltParseState s s) a
forall s b. String -> Step s b
Error String
err
            Partial Int
_ s
_ -> String -> m (Step (AltParseState s s) a)
forall a. (?callStack::CallStack) => String -> a
error String
"Bug: alt: extractL 'Partial'"
            Continue Int
n s
s -> do
                assertM(Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cnt)
                Step (AltParseState s s) a -> m (Step (AltParseState s s) a)
forall a. a -> m 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
0 s
s)

{-# ANN type Fused3 Fuse #-}
data Fused3 a b c = Fused3 !a !b !c

-- | See documentation of 'Streamly.Internal.Data.Parser.many'.
--
-- /Pre-release/
--
{-# INLINE splitMany #-}
splitMany :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
splitMany :: forall (m :: * -> *) a b c.
Monad m =>
Parser a m b -> Fold m b c -> Parser a m c
splitMany (Parser s -> a -> m (Step s b)
step1 m (Initial s b)
initial1 s -> m (Step s b)
extract1) (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
_ s -> m c
ffinal) =
    (Fused3 s Int s -> a -> m (Step (Fused3 s Int s) c))
-> m (Initial (Fused3 s Int s) c)
-> (Fused3 s Int s -> m (Step (Fused3 s Int s) c))
-> Parser a m c
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser Fused3 s Int s -> a -> m (Step (Fused3 s Int s) c)
step m (Initial (Fused3 s Int s) c)
initial Fused3 s Int s -> m (Step (Fused3 s Int s) c)
forall {b}. Num b => Fused3 s Int s -> m (Step (Fused3 s b s) c)
extract

    where

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

    handleCollect :: (Fused3 s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect Fused3 s b s -> b
partial c -> b
done Step s c
fres =
        case Step s c
fres of
            FL.Partial s
fs -> do
                Initial s b
pres <- m (Initial s b)
initial1
                case Initial s b
pres of
                    IPartial s
ps -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ Fused3 s b s -> b
partial (Fused3 s b s -> b) -> Fused3 s b s -> b
forall a b. (a -> b) -> a -> b
$ s -> b -> s -> Fused3 s b s
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
ps b
0 s
fs
                    IDone b
pb ->
                        (Step s c -> m b) -> s -> b -> m b
forall {b}. (Step s c -> m b) -> s -> b -> m b
runCollectorWith ((Fused3 s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect Fused3 s b s -> b
partial c -> b
done) s
fs b
pb
                    IError String
_ -> c -> b
done (c -> b) -> m c -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
ffinal s
fs
            FL.Done c
fb -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ c -> b
done c
fb

    runCollectorWith :: (Step s c -> m b) -> s -> b -> m b
runCollectorWith Step s c -> m b
cont s
fs b
pb = s -> b -> m (Step s c)
fstep s
fs b
pb m (Step s c) -> (Step s c -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Step s c -> m b
cont

    -- See notes in Fold.many for the reason why the parser must be initialized
    -- right away instead of on first input.
    initial :: m (Initial (Fused3 s Int s) c)
initial = m (Step s c)
finitial m (Step s c)
-> (Step s c -> m (Initial (Fused3 s Int s) c))
-> m (Initial (Fused3 s Int s) c)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Fused3 s Int s -> Initial (Fused3 s Int s) c)
-> (c -> Initial (Fused3 s Int s) c)
-> Step s c
-> m (Initial (Fused3 s Int s) c)
forall {b} {b}.
Num b =>
(Fused3 s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect Fused3 s Int s -> Initial (Fused3 s Int s) c
forall s b. s -> Initial s b
IPartial c -> Initial (Fused3 s Int s) c
forall s b. b -> Initial s b
IDone

    {-# INLINE step #-}
    step :: Fused3 s Int s -> a -> m (Step (Fused3 s Int s) c)
step (Fused3 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
                assertM(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)
                Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c))
-> Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c)
forall a b. (a -> b) -> a -> b
$ Int -> Fused3 s Int s -> Step (Fused3 s Int s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> s -> Fused3 s Int s
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
s (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
fs)
            Continue Int
n s
s -> do
                assertM(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)
                Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c))
-> Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c)
forall a b. (a -> b) -> a -> b
$ Int -> Fused3 s Int s -> Step (Fused3 s Int s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> s -> Fused3 s Int s
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
s (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
fs)
            Done Int
n b
b -> do
                assertM(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)
                s -> b -> m (Step s c)
fstep s
fs b
b m (Step s c)
-> (Step s c -> m (Step (Fused3 s Int s) c))
-> m (Step (Fused3 s Int s) c)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Fused3 s Int s -> Step (Fused3 s Int s) c)
-> (c -> Step (Fused3 s Int s) c)
-> Step s c
-> m (Step (Fused3 s Int s) c)
forall {b} {b}.
Num b =>
(Fused3 s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect (Int -> Fused3 s Int s -> Step (Fused3 s Int s) c
forall s b. Int -> s -> Step s b
Partial Int
n) (Int -> c -> Step (Fused3 s Int s) c
forall s b. Int -> b -> Step s b
Done Int
n)
            Error String
_ -> do
                c
xs <- s -> m c
ffinal s
fs
                Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c))
-> Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (Fused3 s Int s) c
forall s b. Int -> b -> Step s b
Done Int
cnt c
xs

    extract :: Fused3 s Int s -> m (Step (Fused3 s b s) c)
extract (Fused3 s
_ Int
0 s
fs) = (c -> Step (Fused3 s b s) c) -> m c -> m (Step (Fused3 s b s) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> c -> Step (Fused3 s b s) c
forall s b. Int -> b -> Step s b
Done Int
0) (s -> m c
ffinal s
fs)
    extract (Fused3 s
s Int
cnt s
fs) = do
        Step s b
r <- s -> m (Step s b)
extract1 s
s
        case Step s b
r of
            Error String
_ -> (c -> Step (Fused3 s b s) c) -> m c -> m (Step (Fused3 s b s) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> c -> Step (Fused3 s b s) c
forall s b. Int -> b -> Step s b
Done Int
cnt) (s -> m c
ffinal s
fs)
            Done Int
n b
b -> do
                assertM(Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cnt)
                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 -> (c -> Step (Fused3 s b s) c) -> m c -> m (Step (Fused3 s b s) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> c -> Step (Fused3 s b s) c
forall s b. Int -> b -> Step s b
Done Int
n) (s -> m c
ffinal s
s1)
                    FL.Done c
b1 -> Step (Fused3 s b s) c -> m (Step (Fused3 s b s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Step (Fused3 s b s) c
forall s b. Int -> b -> Step s b
Done Int
n c
b1)
            Partial Int
_ s
_ -> String -> m (Step (Fused3 s b s) c)
forall a. (?callStack::CallStack) => String -> a
error String
"splitMany: Partial in extract"
            Continue Int
n s
s1 -> do
                assertM(Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cnt)
                Step (Fused3 s b s) c -> m (Step (Fused3 s b s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fused3 s b s -> Step (Fused3 s b s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> b -> s -> Fused3 s b s
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
s1 b
0 s
fs))

-- | Like splitMany, but inner fold emits an output at the end even if no input
-- is received.
--
-- /Internal/
--
{-# INLINE splitManyPost #-}
splitManyPost :: Monad m =>  Parser a m b -> Fold m b c -> Parser a m c
splitManyPost :: forall (m :: * -> *) a b c.
Monad m =>
Parser a m b -> Fold m b c -> Parser a m c
splitManyPost (Parser s -> a -> m (Step s b)
step1 m (Initial s b)
initial1 s -> m (Step s b)
extract1) (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
_ s -> m c
ffinal) =
    (Fused3 s Int s -> a -> m (Step (Fused3 s Int s) c))
-> m (Initial (Fused3 s Int s) c)
-> (Fused3 s Int s -> m (Step (Fused3 s Int s) c))
-> Parser a m c
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser Fused3 s Int s -> a -> m (Step (Fused3 s Int s) c)
step m (Initial (Fused3 s Int s) c)
initial Fused3 s Int s -> m (Step (Fused3 s Int s) c)
forall {b}. Num b => Fused3 s Int s -> m (Step (Fused3 s b s) c)
extract

    where

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

    handleCollect :: (Fused3 s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect Fused3 s b s -> b
partial c -> b
done Step s c
fres =
        case Step s c
fres of
            FL.Partial s
fs -> do
                Initial s b
pres <- m (Initial s b)
initial1
                case Initial s b
pres of
                    IPartial s
ps -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ Fused3 s b s -> b
partial (Fused3 s b s -> b) -> Fused3 s b s -> b
forall a b. (a -> b) -> a -> b
$ s -> b -> s -> Fused3 s b s
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
ps b
0 s
fs
                    IDone b
pb ->
                        (Step s c -> m b) -> s -> b -> m b
forall {b}. (Step s c -> m b) -> s -> b -> m b
runCollectorWith ((Fused3 s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect Fused3 s b s -> b
partial c -> b
done) s
fs b
pb
                    IError String
_ -> c -> b
done (c -> b) -> m c -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
ffinal s
fs
            FL.Done c
fb -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ c -> b
done c
fb

    runCollectorWith :: (Step s c -> m b) -> s -> b -> m b
runCollectorWith Step s c -> m b
cont s
fs b
pb = s -> b -> m (Step s c)
fstep s
fs b
pb m (Step s c) -> (Step s c -> m b) -> m b
forall a b. m a -> (a -> 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 (Fused3 s Int s) c)
initial = m (Step s c)
finitial m (Step s c)
-> (Step s c -> m (Initial (Fused3 s Int s) c))
-> m (Initial (Fused3 s Int s) c)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Fused3 s Int s -> Initial (Fused3 s Int s) c)
-> (c -> Initial (Fused3 s Int s) c)
-> Step s c
-> m (Initial (Fused3 s Int s) c)
forall {b} {b}.
Num b =>
(Fused3 s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect Fused3 s Int s -> Initial (Fused3 s Int s) c
forall s b. s -> Initial s b
IPartial c -> Initial (Fused3 s Int s) c
forall s b. b -> Initial s b
IDone

    {-# INLINE step #-}
    step :: Fused3 s Int s -> a -> m (Step (Fused3 s Int s) c)
step (Fused3 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
                assertM(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)
                Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c))
-> Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c)
forall a b. (a -> b) -> a -> b
$ Int -> Fused3 s Int s -> Step (Fused3 s Int s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> s -> Fused3 s Int s
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
s (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
fs)
            Continue Int
n s
s -> do
                assertM(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)
                Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c))
-> Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c)
forall a b. (a -> b) -> a -> b
$ Int -> Fused3 s Int s -> Step (Fused3 s Int s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> s -> Fused3 s Int s
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
s (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
fs)
            Done Int
n b
b -> do
                assertM(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)
                s -> b -> m (Step s c)
fstep s
fs b
b m (Step s c)
-> (Step s c -> m (Step (Fused3 s Int s) c))
-> m (Step (Fused3 s Int s) c)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Fused3 s Int s -> Step (Fused3 s Int s) c)
-> (c -> Step (Fused3 s Int s) c)
-> Step s c
-> m (Step (Fused3 s Int s) c)
forall {b} {b}.
Num b =>
(Fused3 s b s -> b) -> (c -> b) -> Step s c -> m b
handleCollect (Int -> Fused3 s Int s -> Step (Fused3 s Int s) c
forall s b. Int -> s -> Step s b
Partial Int
n) (Int -> c -> Step (Fused3 s Int s) c
forall s b. Int -> b -> Step s b
Done Int
n)
            Error String
_ -> do
                c
xs <- s -> m c
ffinal s
fs
                Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c))
-> Step (Fused3 s Int s) c -> m (Step (Fused3 s Int s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (Fused3 s Int s) c
forall s b. Int -> b -> Step s b
Done Int
cnt1 c
xs

    extract :: Fused3 s Int s -> m (Step (Fused3 s b s) c)
extract (Fused3 s
s Int
cnt s
fs) = do
        Step s b
r <- s -> m (Step s b)
extract1 s
s
        case Step s b
r of
            Error String
_ -> (c -> Step (Fused3 s b s) c) -> m c -> m (Step (Fused3 s b s) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> c -> Step (Fused3 s b s) c
forall s b. Int -> b -> Step s b
Done Int
cnt) (s -> m c
ffinal s
fs)
            Done Int
n b
b -> do
                assertM(Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cnt)
                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 -> (c -> Step (Fused3 s b s) c) -> m c -> m (Step (Fused3 s b s) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> c -> Step (Fused3 s b s) c
forall s b. Int -> b -> Step s b
Done Int
n) (s -> m c
ffinal s
s1)
                    FL.Done c
b1 -> Step (Fused3 s b s) c -> m (Step (Fused3 s b s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Step (Fused3 s b s) c
forall s b. Int -> b -> Step s b
Done Int
n c
b1)
            Partial Int
_ s
_ -> String -> m (Step (Fused3 s b s) c)
forall a. (?callStack::CallStack) => String -> a
error String
"splitMany: Partial in extract"
            Continue Int
n s
s1 -> do
                assertM(Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cnt)
                Step (Fused3 s b s) c -> m (Step (Fused3 s b s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fused3 s b s -> Step (Fused3 s b s) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> b -> s -> Fused3 s b s
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
s1 b
0 s
fs))

-- | See documentation of 'Streamly.Internal.Data.Parser.some'.
--
-- /Pre-release/
--
{-# INLINE splitSome #-}
splitSome :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
splitSome :: forall (m :: * -> *) a b c.
Monad m =>
Parser a m b -> Fold m b c -> Parser a m c
splitSome (Parser s -> a -> m (Step s b)
step1 m (Initial s b)
initial1 s -> m (Step s b)
extract1) (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
_ s -> m c
ffinal) =
    (Fused3 s Int (Either s s)
 -> a -> m (Step (Fused3 s Int (Either s s)) c))
-> m (Initial (Fused3 s Int (Either s s)) c)
-> (Fused3 s Int (Either s s)
    -> m (Step (Fused3 s Int (Either s s)) c))
-> Parser a m c
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser Fused3 s Int (Either s s)
-> a -> m (Step (Fused3 s Int (Either s s)) c)
step m (Initial (Fused3 s Int (Either s s)) c)
initial Fused3 s Int (Either s s) -> m (Step (Fused3 s Int (Either s s)) c)
forall {b}.
Num b =>
Fused3 s Int (Either s s) -> m (Step (Fused3 s b (Either s s)) c)
extract

    where

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

    handleCollect :: (Fused3 s b (Either a s) -> b) -> (c -> b) -> Step s c -> m b
handleCollect Fused3 s b (Either a s) -> b
partial c -> b
done Step s c
fres =
        case Step s c
fres of
            FL.Partial s
fs -> do
                Initial s b
pres <- m (Initial s b)
initial1
                case Initial s b
pres of
                    IPartial s
ps -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ Fused3 s b (Either a s) -> b
partial (Fused3 s b (Either a s) -> b) -> Fused3 s b (Either a s) -> b
forall a b. (a -> b) -> a -> b
$ s -> b -> Either a s -> Fused3 s b (Either a s)
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
ps b
0 (Either a s -> Fused3 s b (Either a s))
-> Either a s -> Fused3 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 b) -> s -> b -> m b
forall {b}. (Step s c -> m b) -> s -> b -> m b
runCollectorWith ((Fused3 s b (Either a s) -> b) -> (c -> b) -> Step s c -> m b
handleCollect Fused3 s b (Either a s) -> b
partial c -> b
done) s
fs b
pb
                    IError String
_ -> c -> b
done (c -> b) -> m c -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
ffinal s
fs
            FL.Done c
fb -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ c -> b
done c
fb

    runCollectorWith :: (Step s c -> m b) -> s -> b -> m b
runCollectorWith Step s c -> m b
cont s
fs b
pb = s -> b -> m (Step s c)
fstep s
fs b
pb m (Step s c) -> (Step s c -> m b) -> m b
forall a b. m a -> (a -> 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 (Fused3 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 (Fused3 s Int (Either s s)) c
-> m (Initial (Fused3 s Int (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Fused3 s Int (Either s s)) c
 -> m (Initial (Fused3 s Int (Either s s)) c))
-> Initial (Fused3 s Int (Either s s)) c
-> m (Initial (Fused3 s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ Fused3 s Int (Either s s) -> Initial (Fused3 s Int (Either s s)) c
forall s b. s -> Initial s b
IPartial (Fused3 s Int (Either s s)
 -> Initial (Fused3 s Int (Either s s)) c)
-> Fused3 s Int (Either s s)
-> Initial (Fused3 s Int (Either s s)) c
forall a b. (a -> b) -> a -> b
$ s -> Int -> Either s s -> Fused3 s Int (Either s s)
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
ps Int
0 (Either s s -> Fused3 s Int (Either s s))
-> Either s s -> Fused3 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 (Fused3 s Int (Either s s)) c))
-> s -> b -> m (Initial (Fused3 s Int (Either s s)) c)
forall {b}. (Step s c -> m b) -> s -> b -> m b
runCollectorWith ((Fused3 s Int (Either s s)
 -> Initial (Fused3 s Int (Either s s)) c)
-> (c -> Initial (Fused3 s Int (Either s s)) c)
-> Step s c
-> m (Initial (Fused3 s Int (Either s s)) c)
forall {b} {a} {b}.
Num b =>
(Fused3 s b (Either a s) -> b) -> (c -> b) -> Step s c -> m b
handleCollect Fused3 s Int (Either s s) -> Initial (Fused3 s Int (Either s s)) c
forall s b. s -> Initial s b
IPartial c -> Initial (Fused3 s Int (Either s s)) c
forall s b. b -> Initial s b
IDone) s
fs b
pb
                    IError String
err -> Initial (Fused3 s Int (Either s s)) c
-> m (Initial (Fused3 s Int (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Fused3 s Int (Either s s)) c
 -> m (Initial (Fused3 s Int (Either s s)) c))
-> Initial (Fused3 s Int (Either s s)) c
-> m (Initial (Fused3 s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ String -> Initial (Fused3 s Int (Either s s)) c
forall s b. String -> Initial s b
IError String
err
            FL.Done c
_ ->
                Initial (Fused3 s Int (Either s s)) c
-> m (Initial (Fused3 s Int (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Initial (Fused3 s Int (Either s s)) c
 -> m (Initial (Fused3 s Int (Either s s)) c))
-> Initial (Fused3 s Int (Either s s)) c
-> m (Initial (Fused3 s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ String -> Initial (Fused3 s Int (Either s s)) c
forall s b. String -> Initial s b
IError
                    (String -> Initial (Fused3 s Int (Either s s)) c)
-> String -> Initial (Fused3 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 :: Fused3 s Int (Either s s)
-> a -> m (Step (Fused3 s Int (Either s s)) c)
step (Fused3 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
                assertM(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)
                Step (Fused3 s Int (Either s s)) c
-> m (Step (Fused3 s Int (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fused3 s Int (Either s s)) c
 -> m (Step (Fused3 s Int (Either s s)) c))
-> Step (Fused3 s Int (Either s s)) c
-> m (Step (Fused3 s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ Int
-> Fused3 s Int (Either s s) -> Step (Fused3 s Int (Either s s)) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> Either s s -> Fused3 s Int (Either s s)
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 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
                assertM(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)
                Step (Fused3 s Int (Either s s)) c
-> m (Step (Fused3 s Int (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fused3 s Int (Either s s)) c
 -> m (Step (Fused3 s Int (Either s s)) c))
-> Step (Fused3 s Int (Either s s)) c
-> m (Step (Fused3 s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ Int
-> Fused3 s Int (Either s s) -> Step (Fused3 s Int (Either s s)) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> Either s s -> Fused3 s Int (Either s s)
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 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
                assertM(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)
                s -> b -> m (Step s c)
fstep s
fs b
b m (Step s c)
-> (Step s c -> m (Step (Fused3 s Int (Either s s)) c))
-> m (Step (Fused3 s Int (Either s s)) c)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Fused3 s Int (Either s s) -> Step (Fused3 s Int (Either s s)) c)
-> (c -> Step (Fused3 s Int (Either s s)) c)
-> Step s c
-> m (Step (Fused3 s Int (Either s s)) c)
forall {b} {a} {b}.
Num b =>
(Fused3 s b (Either a s) -> b) -> (c -> b) -> Step s c -> m b
handleCollect (Int
-> Fused3 s Int (Either s s) -> Step (Fused3 s Int (Either s s)) c
forall s b. Int -> s -> Step s b
Partial Int
n) (Int -> c -> Step (Fused3 s Int (Either s s)) c
forall s b. Int -> b -> Step s b
Done Int
n)
            Error String
err -> Step (Fused3 s Int (Either s s)) c
-> m (Step (Fused3 s Int (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fused3 s Int (Either s s)) c
 -> m (Step (Fused3 s Int (Either s s)) c))
-> Step (Fused3 s Int (Either s s)) c
-> m (Step (Fused3 s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (Fused3 s Int (Either s s)) c
forall s b. String -> Step s b
Error String
err
    step (Fused3 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
                assertM(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)
                Step (Fused3 s Int (Either s s)) c
-> m (Step (Fused3 s Int (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fused3 s Int (Either s s)) c
 -> m (Step (Fused3 s Int (Either s s)) c))
-> Step (Fused3 s Int (Either s s)) c
-> m (Step (Fused3 s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ Int
-> Fused3 s Int (Either s s) -> Step (Fused3 s Int (Either s s)) c
forall s b. Int -> s -> Step s b
Partial Int
n (s -> Int -> Either s s -> Fused3 s Int (Either s s)
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 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
                assertM(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)
                Step (Fused3 s Int (Either s s)) c
-> m (Step (Fused3 s Int (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Fused3 s Int (Either s s)) c
 -> m (Step (Fused3 s Int (Either s s)) c))
-> Step (Fused3 s Int (Either s s)) c
-> m (Step (Fused3 s Int (Either s s)) c)
forall a b. (a -> b) -> a -> b
$ Int
-> Fused3 s Int (Either s s) -> Step (Fused3 s Int (Either s s)) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> Int -> Either s s -> Fused3 s Int (Either s s)
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 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
                assertM(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)
                s -> b -> m (Step s c)
fstep s
fs b
b m (Step s c)
-> (Step s c -> m (Step (Fused3 s Int (Either s s)) c))
-> m (Step (Fused3 s Int (Either s s)) c)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Fused3 s Int (Either s s) -> Step (Fused3 s Int (Either s s)) c)
-> (c -> Step (Fused3 s Int (Either s s)) c)
-> Step s c
-> m (Step (Fused3 s Int (Either s s)) c)
forall {b} {a} {b}.
Num b =>
(Fused3 s b (Either a s) -> b) -> (c -> b) -> Step s c -> m b
handleCollect (Int
-> Fused3 s Int (Either s s) -> Step (Fused3 s Int (Either s s)) c
forall s b. Int -> s -> Step s b
Partial Int
n) (Int -> c -> Step (Fused3 s Int (Either s s)) c
forall s b. Int -> b -> Step s b
Done Int
n)
            Error String
_ -> Int -> c -> Step (Fused3 s Int (Either s s)) c
forall s b. Int -> b -> Step s b
Done Int
cnt1 (c -> Step (Fused3 s Int (Either s s)) c)
-> m c -> m (Step (Fused3 s Int (Either s s)) c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
ffinal s
fs

    extract :: Fused3 s Int (Either s s) -> m (Step (Fused3 s b (Either s s)) c)
extract (Fused3 s
s Int
cnt (Left s
fs)) = do
        Step s b
r <- s -> m (Step s b)
extract1 s
s
        case Step s b
r of
            Error String
err -> Step (Fused3 s b (Either s s)) c
-> m (Step (Fused3 s b (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Step (Fused3 s b (Either s s)) c
forall s b. String -> Step s b
Error String
err)
            Done Int
n b
b -> do
                assertM(Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cnt)
                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 -> (c -> Step (Fused3 s b (Either s s)) c)
-> m c -> m (Step (Fused3 s b (Either s s)) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> c -> Step (Fused3 s b (Either s s)) c
forall s b. Int -> b -> Step s b
Done Int
n) (s -> m c
ffinal s
s1)
                    FL.Done c
b1 -> Step (Fused3 s b (Either s s)) c
-> m (Step (Fused3 s b (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Step (Fused3 s b (Either s s)) c
forall s b. Int -> b -> Step s b
Done Int
n c
b1)
            Partial Int
_ s
_ -> String -> m (Step (Fused3 s b (Either s s)) c)
forall a. (?callStack::CallStack) => String -> a
error String
"splitSome: Partial in extract"
            Continue Int
n s
s1 -> do
                assertM(Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cnt)
                Step (Fused3 s b (Either s s)) c
-> m (Step (Fused3 s b (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fused3 s b (Either s s) -> Step (Fused3 s b (Either s s)) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> b -> Either s s -> Fused3 s b (Either s s)
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
s1 b
0 (s -> Either s s
forall a b. a -> Either a b
Left s
fs)))
    extract (Fused3 s
s Int
cnt (Right s
fs)) = do
        Step s b
r <- s -> m (Step s b)
extract1 s
s
        case Step s b
r of
            Error String
_ -> (c -> Step (Fused3 s b (Either s s)) c)
-> m c -> m (Step (Fused3 s b (Either s s)) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> c -> Step (Fused3 s b (Either s s)) c
forall s b. Int -> b -> Step s b
Done Int
cnt) (s -> m c
ffinal s
fs)
            Done Int
n b
b -> do
                assertM(Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cnt)
                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 -> (c -> Step (Fused3 s b (Either s s)) c)
-> m c -> m (Step (Fused3 s b (Either s s)) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> c -> Step (Fused3 s b (Either s s)) c
forall s b. Int -> b -> Step s b
Done Int
n) (s -> m c
ffinal s
s1)
                    FL.Done c
b1 -> Step (Fused3 s b (Either s s)) c
-> m (Step (Fused3 s b (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Step (Fused3 s b (Either s s)) c
forall s b. Int -> b -> Step s b
Done Int
n c
b1)
            Partial Int
_ s
_ -> String -> m (Step (Fused3 s b (Either s s)) c)
forall a. (?callStack::CallStack) => String -> a
error String
"splitSome: Partial in extract"
            Continue Int
n s
s1 -> do
                assertM(Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cnt)
                Step (Fused3 s b (Either s s)) c
-> m (Step (Fused3 s b (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fused3 s b (Either s s) -> Step (Fused3 s b (Either s s)) c
forall s b. Int -> s -> Step s b
Continue Int
n (s -> b -> Either s s -> Fused3 s b (Either s s)
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
s1 b
0 (s -> Either s s
forall a b. b -> Either a b
Right s
fs)))

-- | A parser that always fails with an error message without consuming
-- any input.
--
{-# INLINE_NORMAL die #-}
die :: Monad m => String -> Parser a m b
die :: forall (m :: * -> *) a b. Monad m => String -> Parser a m b
die String
err = (Any -> a -> m (Step Any b))
-> m (Initial Any b) -> (Any -> m (Step Any b)) -> Parser a m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser Any -> a -> m (Step Any b)
forall a. (?callStack::CallStack) => a
undefined (Initial Any b -> m (Initial Any b)
forall a. a -> m a
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 (Step Any b)
forall a. (?callStack::CallStack) => a
undefined

-- | A parser that always fails with an effectful error message and without
-- consuming any input.
--
-- /Pre-release/
--
{-# INLINE dieM #-}
dieM :: Monad m => m String -> Parser a m b
dieM :: forall (m :: * -> *) a b. Monad m => m String -> Parser a m b
dieM m String
err = (Any -> a -> m (Step Any b))
-> m (Initial Any b) -> (Any -> m (Step Any b)) -> Parser a m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser Any -> a -> m (Step Any b)
forall a. (?callStack::CallStack) => 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 (Step Any b)
forall a. (?callStack::CallStack) => 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.

-- | READ THE CAVEATS in 'alt' before using this instance.
--
-- >>> empty = Parser.die "empty"
-- >>> (<|>) = Parser.alt
-- >>> many = flip Parser.many Fold.toList
-- >>> some = flip Parser.some Fold.toList
instance Monad m => Alternative (Parser a m) where
    {-# INLINE empty #-}
    empty :: forall a. Parser a m a
empty = String -> Parser a m a
forall (m :: * -> *) a b. Monad m => String -> Parser a m b
die String
"empty"

    {-# INLINE (<|>) #-}
    <|> :: forall a. Parser a m a -> Parser a m a -> Parser a m a
(<|>) = Parser a m a -> Parser a m a -> Parser a m a
forall (m :: * -> *) x a.
Monad m =>
Parser x m a -> Parser x m a -> Parser x m a
alt

    {-# INLINE many #-}
    many :: forall a. Parser a m a -> Parser a m [a]
many = (Parser a m a -> Fold m a [a] -> Parser a m [a])
-> Fold m a [a] -> Parser a m a -> Parser a m [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser a m a -> Fold m a [a] -> Parser a m [a]
forall (m :: * -> *) a b c.
Monad m =>
Parser a m b -> Fold m b c -> Parser a m c
splitMany Fold m a [a]
forall (m :: * -> *) a. Monad m => Fold m a [a]
toList

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

-- XXX Does it fuse completely? Check and update, it cannot fuse the
-- dynamically generated parser.

-- | Map a 'Parser' returning function on the result of a 'Parser'.
--
-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.
--
-- /Pre-release/
--
{-# INLINE concatMap #-}
concatMap :: Monad m =>
    (b -> Parser a m c) -> Parser a m b -> Parser a m c
concatMap :: forall (m :: * -> *) b a c.
Monad m =>
(b -> Parser a m c) -> Parser a m b -> Parser a m c
concatMap b -> Parser a m c
func (Parser s -> a -> m (Step s b)
stepL m (Initial s b)
initialL s -> m (Step s 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 (Step (ConcatParseState s m a c) c))
-> Parser a m c
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m 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 (Step (ConcatParseState s m a c) c)
extract

    where

    {-# INLINE initializeR #-}
    initializeR :: Parser a m 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 (Step s 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 a. a -> m a
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 (Step s b)) -> ConcatParseState sl m a b
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
sr s -> m (Step s 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 a. a -> m a
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 a m c -> m (Initial (ConcatParseState s m a c) c)
forall {m :: * -> *} {a} {b} {sl}.
Monad m =>
Parser a m b -> m (Initial (ConcatParseState sl m a b) b)
initializeR (b -> Parser a m c
func b
b)
            IError String
err -> Initial (ConcatParseState s m a c) c
-> m (Initial (ConcatParseState s m a c) c)
forall a. a -> m a
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 a m 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 (Step s 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 a. a -> m a
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 (Step s b)) -> ConcatParseState sl m a b
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
sr s -> m (Step s 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 a. a -> m a
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 a. a -> m a
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 a m c -> m (Step (ConcatParseState s m a c) c)
forall {m :: * -> *} {a} {b} {sl}.
Monad m =>
Int -> Parser a m b -> m (Step (ConcatParseState sl m a b) b)
initializeRL Int
n (b -> Parser a m c
func b
b)
            Error String
err -> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a. a -> m a
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 (Step s 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 a. a -> m a
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 (Step s c)) -> ConcatParseState s m a c
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m (Step s 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 (Step s c)) -> ConcatParseState s m a c
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m (Step s 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 :: Int -> Parser a m b -> m (Step (ConcatParseState sl m a b) b)
extractP Int
n (Parser s -> a -> m (Step s b)
stepR m (Initial s b)
initialR s -> m (Step s b)
extractR) = do
        Initial s b
res <- m (Initial s b)
initialR
        case Initial s b
res of
            IPartial s
s ->
                (Step s b -> Step (ConcatParseState sl m a b) b)
-> m (Step s b) -> m (Step (ConcatParseState sl m a b) b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                    ((s -> ConcatParseState sl m a b)
-> Step s b -> Step (ConcatParseState sl m a b) b
forall a b c. (a -> b) -> Step a c -> Step b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\s
s1 -> (s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
s1 s -> m (Step s b)
extractR))
                    (s -> m (Step s b)
extractR s
s)
            IDone b
b -> Step (ConcatParseState sl m a b) b
-> m (Step (ConcatParseState sl m a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> b -> Step (ConcatParseState sl m a b) b
forall s b. Int -> b -> Step s b
Done Int
n b
b)
            IError String
err -> Step (ConcatParseState sl m a b) b
-> m (Step (ConcatParseState sl m a b) b)
forall a. a -> m a
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
$ String -> Step (ConcatParseState sl m a b) b
forall s b. String -> Step s b
Error String
err

    extract :: ConcatParseState s m a c -> m (Step (ConcatParseState s m a c) c)
extract (ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m (Step s c)
extractR) =
        (Step s c -> Step (ConcatParseState s m a c) c)
-> m (Step s c) -> m (Step (ConcatParseState s m a c) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> ConcatParseState s m a c)
-> Step s c -> Step (ConcatParseState s m a c) c
forall a b c. (a -> b) -> Step a c -> Step b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\s
s1 -> (s -> a -> m (Step s c))
-> s -> (s -> m (Step s c)) -> ConcatParseState s m a c
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s1 s -> m (Step s c)
extractR)) (s -> m (Step s c)
extractR s
s)
    extract (ConcatParseL s
sL) = do
        Step s b
rL <- s -> m (Step s b)
extractL s
sL
        case Step s b
rL of
            Error String
err -> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a. a -> m a
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
            Done Int
n b
b -> Int -> Parser a m c -> m (Step (ConcatParseState s m a c) c)
forall {m :: * -> *} {a} {b} {sl}.
Monad m =>
Int -> Parser a m b -> m (Step (ConcatParseState sl m a b) b)
extractP Int
n (Parser a m c -> m (Step (ConcatParseState s m a c) c))
-> Parser a m c -> m (Step (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ b -> Parser a m c
func b
b
            Partial Int
_ s
_ -> String -> m (Step (ConcatParseState s m a c) c)
forall a. (?callStack::CallStack) => String -> a
error String
"concatMap: extract Partial"
            Continue Int
n s
s -> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a. a -> m a
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)

-- | Better performance 'concatMap' for non-failing parsers.
--
-- Does not work correctly for parsers that can fail.
--
-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.
--
{-# INLINE noErrorUnsafeConcatMap #-}
noErrorUnsafeConcatMap :: Monad m =>
    (b -> Parser a m c) -> Parser a m b -> Parser a m c
noErrorUnsafeConcatMap :: forall (m :: * -> *) b a c.
Monad m =>
(b -> Parser a m c) -> Parser a m b -> Parser a m c
noErrorUnsafeConcatMap b -> Parser a m c
func (Parser s -> a -> m (Step s b)
stepL m (Initial s b)
initialL s -> m (Step s 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 (Step (ConcatParseState s m a c) c))
-> Parser a m c
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m 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 (Step (ConcatParseState s m a c) c)
extract

    where

    {-# INLINE initializeR #-}
    initializeR :: Parser a m 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 (Step s 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 a. a -> m a
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 (Step s b)) -> ConcatParseState sl m a b
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
sr s -> m (Step s 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 a. a -> m a
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 a m c -> m (Initial (ConcatParseState s m a c) c)
forall {m :: * -> *} {a} {b} {sl}.
Monad m =>
Parser a m b -> m (Initial (ConcatParseState sl m a b) b)
initializeR (b -> Parser a m c
func b
b)
            IError String
err -> Initial (ConcatParseState s m a c) c
-> m (Initial (ConcatParseState s m a c) c)
forall a. a -> m a
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 a m 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 (Step s 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 a. a -> m a
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 (Step s b)) -> ConcatParseState sl m a b
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
sr s -> m (Step s 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 a. a -> m a
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 a. a -> m a
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 a m c -> m (Step (ConcatParseState s m a c) c)
forall {m :: * -> *} {a} {b} {sl}.
Monad m =>
Int -> Parser a m b -> m (Step (ConcatParseState sl m a b) b)
initializeRL Int
n (b -> Parser a m c
func b
b)
            Error String
err -> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a. a -> m a
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 (Step s 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 a. a -> m a
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 (Step s c)) -> ConcatParseState s m a c
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m (Step s 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 (Step s c)) -> ConcatParseState s m a c
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m (Step s 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 :: Int -> Parser a m b -> m (Step (ConcatParseState sl m a b) b)
extractP Int
n (Parser s -> a -> m (Step s b)
stepR m (Initial s b)
initialR s -> m (Step s b)
extractR) = do
        Initial s b
res <- m (Initial s b)
initialR
        case Initial s b
res of
            IPartial s
s ->
                (Step s b -> Step (ConcatParseState sl m a b) b)
-> m (Step s b) -> m (Step (ConcatParseState sl m a b) b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                    ((s -> ConcatParseState sl m a b)
-> Step s b -> Step (ConcatParseState sl m a b) b
forall a b c. (a -> b) -> Step a c -> Step b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\s
s1 -> (s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
s1 s -> m (Step s b)
extractR))
                    (s -> m (Step s b)
extractR s
s)
            IDone b
b -> Step (ConcatParseState sl m a b) b
-> m (Step (ConcatParseState sl m a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> b -> Step (ConcatParseState sl m a b) b
forall s b. Int -> b -> Step s b
Done Int
n b
b)
            IError String
err -> Step (ConcatParseState sl m a b) b
-> m (Step (ConcatParseState sl m a b) b)
forall a. a -> m a
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
$ String -> Step (ConcatParseState sl m a b) b
forall s b. String -> Step s b
Error String
err

    extract :: ConcatParseState s m a c -> m (Step (ConcatParseState s m a c) c)
extract (ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m (Step s c)
extractR) =
        (Step s c -> Step (ConcatParseState s m a c) c)
-> m (Step s c) -> m (Step (ConcatParseState s m a c) c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> ConcatParseState s m a c)
-> Step s c -> Step (ConcatParseState s m a c) c
forall a b c. (a -> b) -> Step a c -> Step b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\s
s1 -> (s -> a -> m (Step s c))
-> s -> (s -> m (Step s c)) -> ConcatParseState s m a c
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Step s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s1 s -> m (Step s c)
extractR)) (s -> m (Step s c)
extractR s
s)
    extract (ConcatParseL s
sL) = do
        Step s b
rL <- s -> m (Step s b)
extractL s
sL
        case Step s b
rL of
            Error String
err -> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a. a -> m a
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
            Done Int
n b
b -> Int -> Parser a m c -> m (Step (ConcatParseState s m a c) c)
forall {m :: * -> *} {a} {b} {sl}.
Monad m =>
Int -> Parser a m b -> m (Step (ConcatParseState sl m a b) b)
extractP Int
n (Parser a m c -> m (Step (ConcatParseState s m a c) c))
-> Parser a m c -> m (Step (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ b -> Parser a m c
func b
b
            Partial Int
_ s
_ -> String -> m (Step (ConcatParseState s m a c) c)
forall a. (?callStack::CallStack) => String -> a
error String
"concatMap: extract Partial"
            Continue Int
n s
s -> Step (ConcatParseState s m a c) c
-> m (Step (ConcatParseState s m a c) c)
forall a. a -> m a
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)

-- 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.

-- | READ THE CAVEATS in 'concatMap' before using this instance.
--
-- >>> (>>=) = flip Parser.concatMap
--
instance Monad m => Monad (Parser a m) where
    {-# INLINE return #-}
    return :: forall a. a -> Parser a m a
return = a -> Parser a m a
forall a. a -> Parser a m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    {-# INLINE (>>=) #-}
    >>= :: forall a b. Parser a m a -> (a -> Parser a m b) -> Parser a m b
(>>=) = ((a -> Parser a m b) -> Parser a m a -> Parser a m b)
-> Parser a m a -> (a -> Parser a m b) -> Parser a m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Parser a m b) -> Parser a m a -> Parser a m b
forall (m :: * -> *) b a c.
Monad m =>
(b -> Parser a m c) -> Parser a m b -> Parser a m c
concatMap

    {-# INLINE (>>) #-}
    >> :: forall a b. Parser a m a -> Parser a m b -> Parser a m b
(>>) = Parser a m a -> Parser a m b -> Parser a m b
forall a b. Parser a m a -> Parser a m b -> Parser a m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

-- | >>> fail = Parser.die
instance Monad m => Fail.MonadFail (Parser a m) where
    {-# INLINE fail #-}
    fail :: forall a. String -> Parser a m a
fail = String -> Parser a m a
forall (m :: * -> *) a b. Monad m => String -> Parser a m b
die

{-
-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.
--
instance Monad m => MonadPlus (Parser a m) where
    {-# INLINE mzero #-}
    mzero = die "mzero"

    {-# INLINE mplus #-}
    mplus = alt
-}

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

------------------------------------------------------------------------------
-- Mapping on input
------------------------------------------------------------------------------

-- | @lmap f parser@ maps the function @f@ on the input of the parser.
--
-- >>> Stream.parse (Parser.lmap (\x -> x * x) (Parser.fromFold Fold.sum)) (Stream.enumerateFromTo 1 100)
-- Right 338350
--
-- > lmap = Parser.lmapM return
--
{-# INLINE lmap #-}
lmap :: (a -> b) -> Parser b m r -> Parser a m r
lmap :: forall a b (m :: * -> *) r.
(a -> b) -> Parser b m r -> Parser a m r
lmap a -> b
f (Parser s -> b -> m (Step s r)
step m (Initial s r)
begin s -> m (Step s r)
done) = (s -> a -> m (Step s r))
-> m (Initial s r) -> (s -> m (Step s r)) -> Parser a m r
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser s -> a -> m (Step s r)
step1 m (Initial s r)
begin s -> m (Step s r)
done

    where

    step1 :: s -> a -> m (Step s r)
step1 s
x a
a = s -> b -> m (Step s r)
step s
x (a -> b
f a
a)

-- | @lmapM f parser@ maps the monadic function @f@ on the input of the parser.
--
{-# INLINE lmapM #-}
lmapM :: Monad m => (a -> m b) -> Parser b m r -> Parser a m r
lmapM :: forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> Parser b m r -> Parser a m r
lmapM a -> m b
f (Parser s -> b -> m (Step s r)
step m (Initial s r)
begin s -> m (Step s r)
done) = (s -> a -> m (Step s r))
-> m (Initial s r) -> (s -> m (Step s r)) -> Parser a m r
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser s -> a -> m (Step s r)
step1 m (Initial s r)
begin s -> m (Step s r)
done

    where

    step1 :: s -> a -> m (Step s r)
step1 s
x a
a = a -> m b
f a
a m b -> (b -> m (Step s r)) -> m (Step s r)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> b -> m (Step s r)
step s
x

-- | Include only those elements that pass a predicate.
--
-- >>> Stream.parse (Parser.filter (> 5) (Parser.fromFold Fold.sum)) $ Stream.fromList [1..10]
-- Right 40
--
{-# INLINE filter #-}
filter :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
filter :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Parser a m b -> Parser a m b
filter a -> Bool
f (Parser s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m (Step s b)
extract) = (s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser s -> a -> m (Step s b)
step1 m (Initial s b)
initial s -> m (Step s b)
extract

    where

    step1 :: s -> a -> m (Step s b)
step1 s
x a
a = if a -> Bool
f a
a then s -> a -> m (Step s b)
step s
x a
a else Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Step s b
forall s b. Int -> s -> Step s b
Partial Int
0 s
x