{-# LANGUAGE CPP #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
-- |
-- 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. 'SError': 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 @SError 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 @SError@. 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.
--
-- = SError Handling
--
-- When a parser's @step@ function is invoked it may terminate by either a
-- 'Done' or an 'SError' 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. 'SError' 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 "SError" 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 (..)
    -- (..) does not seem to export patterns yet the compiler complains it does.
    , Step(Partial, Continue, Done, Error, SPartial, SContinue, SDone, SError)
    , Final(..)
    , mapCount
    , bimapOverrideCount
    , bimapMorphOverrideCount
    , Parser (..)
    , ParseError (..)
    , ParseErrorPos (..)
    , rmapM

    -- * Constructors

    , fromPure
    , fromEffect
    , splitWith
    , split_

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

    -- * Input transformation
    , lmap
    , lmapM
    , filter

    , noErrorUnsafeSplitWith
    , noErrorUnsafeSplit_
    , noErrorUnsafeConcatMap

    , localReaderT
    )
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 Control.Monad.Trans.Reader (ReaderT, local)
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.

-- XXX IPartial indicates that the parser has a default result and cannot fail.
-- Such parsers should rather be written as Parslets? We should use IContinue
-- in initial.

-- | 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 SError 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.
--
-- /Result types/: The parser driver feeds the input stream to the parser one
-- element at a time, representing a parse 'Step'. If the step result
-- 'SPartial' indicates that a parse result is available and the parser can
-- accept more input, we can extract the result using the parser's extract
-- function and feed more input to the parser. If the result is 'SContinue', we
-- must feed more input in order to get a result. If the parser returns 'SDone'
-- then a result is available and the parser can no longer take any more input.
--
-- /Stream position/: The @n@ in @SPartial n@, @Scontinue n@ and @SDone n@ is a
-- count by which we adjust the current stream position after this step. If the
-- count is positive we move forward in the stream, if it is 0 then we stay
-- where we are, if it is negative then we move backward in the stream.
-- Essentially, if the input stream position was @pos@ before processing the
-- current element then the new stream position after processing the element
-- would be @pos + n@.
--
-- We can also think of this count as the number of items consumed by the
-- parser. If the current input item is consumed then n is 1, if the current
-- input item should be presented to the next parser step then n is 0. If @n@
-- is less than 0 then the parser backtracks by n elements before the current
-- element before the next parsing step is invoked. @n@ is not allowed to be
-- greater than 1 in the regular stream parsers, but it can be more than 1 in
-- an array parser because it can consume more than one elements from the
-- array.
--
-- /Backtracking/: If the parser result is 'SContinue', the parser driver
-- retains the input in a backtracking buffer, in case of failure the parser
-- can backtrack maximum up to the length of the backtracking buffer. Whenever
-- the result is `SPartial` the current backtracking buffer is discarded; this
-- means that we cannot backtrack beyond the currrent position in the stream.
-- The parser must ensure that the backtrack position is always within the
-- bounds of the backtracking buffer, otherwise a runtime error will occur.
--
-- /Failure/: If the parser is not yet done, we can use the @extract@ operation
-- on the @state@ of the parser to extract a result. If the parser never
-- yielded a result in the past, @extract@ fails with a 'ParseError' exception.
-- If the parser yielded a 'Partial' result in the past then extract returns
-- the latest partial result. Therefore, if a parser yields a partial result
-- once then it cannot fail later on.
--
-- /Pre-release/
--
{-# ANN type Step Fuse #-}
data Step s b =
        SPartial !Int !s
    -- ^ @SPartial count state@. The following statements hold on an SPartial
    -- result:
    --
    -- 1. @extract@ on @state@ would succeed and give a result.
    -- 2. Input stream position is updated to @current position + count@.
    -- 3. All buffered input before the new position is dropped. The parser can
    -- never backtrack before this position.

    | SContinue !Int !s
    -- ^ @SContinue count state@. The following statements hold on an SContinue
    -- result:
    --
    -- 1. If 'SPartial' result was returned in the past, @extract@ on @state@
    -- would give that result otherwise it will return 'SError' or 'SContinue'.
    -- 2. Input stream position is updated to @current position + count@.
    -- 3. the previous input is retained in a backtrack buffer.

    | SDone !Int !b
    -- ^ Done with leftover input count and result.
    --
    -- @SDone count result@ means the parser has finished, it will not accept
    -- any more input, the final stream position must be set to @current
    -- position + count@ and the result of the parser is in @result@.

    | SError !String
    -- ^ Parser failed without generating any output.
    --
    -- The parsing operation may backtrack to the beginning and try another
    -- alternative.
    deriving (Int -> Step s b -> ShowS
[Step s b] -> ShowS
Step s b -> String
(Int -> Step s b -> ShowS)
-> (Step s b -> String) -> ([Step s b] -> ShowS) -> Show (Step s b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s b. (Show s, Show b) => Int -> Step s b -> ShowS
forall s b. (Show s, Show b) => [Step s b] -> ShowS
forall s b. (Show s, Show b) => Step s b -> String
$cshowsPrec :: forall s b. (Show s, Show b) => Int -> Step s b -> ShowS
showsPrec :: Int -> Step s b -> ShowS
$cshow :: forall s b. (Show s, Show b) => Step s b -> String
show :: Step s b -> String
$cshowList :: forall s b. (Show s, Show b) => [Step s b] -> ShowS
showList :: [Step s b] -> ShowS
Show)

{-# ANN type Final Fuse #-}
data Final s b
    = FDone !Int !b      -- ^ Return a result right away without an input.
    | FContinue !Int !s
    | FError !String -- ^ Return an error right away without an input.

--------------------------------------------------------------------------------
-- Custom Patterns
--------------------------------------------------------------------------------

negateDirection :: Step s b -> Step s b
negateDirection :: forall s b. Step s b -> Step s b
negateDirection (SPartial Int
i s
s) = Int -> s -> Step s b
forall s b. Int -> s -> Step s b
SPartial (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) s
s
negateDirection (SContinue Int
i s
s) = Int -> s -> Step s b
forall s b. Int -> s -> Step s b
SContinue (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) s
s
negateDirection (SDone Int
i b
b) = Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) b
b
negateDirection (SError String
s) = String -> Step s b
forall s b. String -> Step s b
SError String
s

{-# DEPRECATED Error "Use @SError@ instead of @Error@" #-}
pattern Error :: String -> Step s b
pattern $mError :: forall {r} {s} {b}. Step s b -> (String -> r) -> ((# #) -> r) -> r
$bError :: forall s b. String -> Step s b
Error s = SError s

{-# DEPRECATED Partial "Use @SPartial (1 - n)@ instead of @Partial n@" #-}
pattern Partial :: Int -> s -> Step s b
pattern $mPartial :: forall {r} {s} {b}.
Step s b -> (Int -> s -> r) -> ((# #) -> r) -> r
$bPartial :: forall s b. Int -> s -> Step s b
Partial i s <- (negateDirection -> SPartial i s)
    where Partial Int
i s
s = Int -> s -> Step s b
forall s b. Int -> s -> Step s b
SPartial (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) s
s

{-# DEPRECATED Continue "Replace @Continue n@ with @SContinue (1 - n)@ in parser step and with @FContinue (-n)@ in parser extract" #-}
pattern Continue :: Int -> s -> Step s b
pattern $mContinue :: forall {r} {s} {b}.
Step s b -> (Int -> s -> r) -> ((# #) -> r) -> r
$bContinue :: forall s b. Int -> s -> Step s b
Continue i s <- (negateDirection -> SContinue i s)
    where Continue Int
i s
s = Int -> s -> Step s b
forall s b. Int -> s -> Step s b
SContinue (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) s
s

{-# DEPRECATED Done "Replace @Done n@ with @SDone (1 - n)@ in parser step and with @FDone (-n)@ in parser extract" #-}
pattern Done :: Int -> b -> Step s b
pattern $mDone :: forall {r} {b} {s}.
Step s b -> (Int -> b -> r) -> ((# #) -> r) -> r
$bDone :: forall b s. Int -> b -> Step s b
Done i b <- (negateDirection -> SDone i b)
    where Done Int
i b
b = Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) b
b

--------------------------------------------------------------------------------
-- Code
--------------------------------------------------------------------------------

-- | 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
            SPartial Int
n a
s -> Int -> b -> Step b d
forall s b. Int -> s -> Step s b
SPartial Int
n (a -> b
f a
s)
            SContinue Int
n a
s -> Int -> b -> Step b d
forall s b. Int -> s -> Step s b
SContinue Int
n (a -> b
f a
s)
            SDone Int
n c
b -> Int -> d -> Step b d
forall s b. Int -> b -> Step s b
SDone Int
n (c -> d
g c
b)
            SError String
err -> String -> Step b d
forall s b. String -> Step s b
SError String
err

instance Bifunctor Final where
    {-# INLINE bimap #-}
    bimap :: forall a b c d. (a -> b) -> (c -> d) -> Final a c -> Final b d
bimap a -> b
f c -> d
g Final a c
step =
        case Final a c
step of
            FContinue Int
n a
s -> Int -> b -> Final b d
forall s b. Int -> s -> Final s b
FContinue Int
n (a -> b
f a
s)
            FDone Int
n c
b -> Int -> d -> Final b d
forall s b. Int -> b -> Final s b
FDone Int
n (c -> d
g c
b)
            FError String
err -> String -> Final b d
forall s b. String -> Final s b
FError 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
        SPartial Int
_ s
s -> Int -> s1 -> Step s1 b1
forall s b. Int -> s -> Step s b
SPartial Int
n (s -> s1
f s
s)
        SContinue Int
_ s
s -> Int -> s1 -> Step s1 b1
forall s b. Int -> s -> Step s b
SContinue Int
n (s -> s1
f s
s)
        SDone Int
_ b
b -> Int -> b1 -> Step s1 b1
forall s b. Int -> b -> Step s b
SDone Int
n (b -> b1
g b
b)
        SError String
err -> String -> Step s1 b1
forall s b. String -> Step s b
SError String
err

bimapMorphOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Final s b -> Step s1 b1
bimapMorphOverrideCount :: forall s s1 b b1.
Int -> (s -> s1) -> (b -> b1) -> Final s b -> Step s1 b1
bimapMorphOverrideCount Int
n s -> s1
f b -> b1
g Final s b
step =
    case Final s b
step of
        FDone Int
_ b
b -> Int -> b1 -> Step s1 b1
forall s b. Int -> b -> Step s b
SDone Int
n (b -> b1
g b
b)
        FContinue Int
_ s
s -> Int -> s1 -> Step s1 b1
forall s b. Int -> s -> Step s b
SContinue Int
n (s -> s1
f s
s)
        FError String
err -> String -> Step s1 b1
forall s b. String -> Step s b
SError String
err

bimapFinalOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Final s b -> Final s1 b1
bimapFinalOverrideCount :: forall s s1 b b1.
Int -> (s -> s1) -> (b -> b1) -> Final s b -> Final s1 b1
bimapFinalOverrideCount Int
n s -> s1
f b -> b1
g Final s b
step =
    case Final s b
step of
        FContinue Int
_ s
s -> Int -> s1 -> Final s1 b1
forall s b. Int -> s -> Final s b
FContinue Int
n (s -> s1
f s
s)
        FDone Int
_ b
b -> Int -> b1 -> Final s1 b1
forall s b. Int -> b -> Final s b
FDone Int
n (b -> b1
g b
b)
        FError String
err -> String -> Final s1 b1
forall s b. String -> Final s b
FError 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

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

-- | Map a function over the count.
--
{-# INLINE mapCount #-}
mapCount :: (Int -> Int) -> Step s b -> Step s b
mapCount :: forall s b. (Int -> Int) -> Step s b -> Step s b
mapCount Int -> Int
f Step s b
res =
    case Step s b
res of
        SPartial Int
n s
s -> Int -> s -> Step s b
forall s b. Int -> s -> Step s b
SPartial (Int -> Int
f Int
n) s
s
        SDone Int
n b
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone (Int -> Int
f Int
n) b
b
        SContinue Int
n s
s -> Int -> s -> Step s b
forall s b. Int -> s -> Step s b
SContinue (Int -> Int
f Int
n) s
s
        SError String
err -> String -> Step s b
forall s b. String -> Step s b
SError 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
        SPartial 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
SPartial Int
n s
s
        SDone Int
n a
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone 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
        SContinue 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
SContinue Int
n s
s
        SError 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
SError String
err

{-# INLINE mapMFinal #-}
mapMFinal :: Applicative m => (a -> m b) -> Final s a -> m (Final s b)
mapMFinal :: forall (m :: * -> *) a b s.
Applicative m =>
(a -> m b) -> Final s a -> m (Final s b)
mapMFinal a -> m b
f Final s a
res =
    case Final s a
res of
        FDone Int
n a
b -> Int -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
n (b -> Final s b) -> m b -> m (Final s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
b
        FContinue Int
n s
s -> Final s b -> m (Final s b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Final s b -> m (Final s b)) -> Final s b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Final s b
forall s b. Int -> s -> Final s b
FContinue Int
n s
s
        FError String
err -> Final s b -> m (Final s b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Final s b -> m (Final s b)) -> Final s b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ String -> Final s b
forall s b. String -> Final s b
FError 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))
        (m (Initial s b))
        (s -> m (Final s b))

-- | This exception is used when a parser ultimately fails, the user of the
-- parser is intimated via this exception.
--
newtype ParseError = ParseError String
    deriving (ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
/= :: ParseError -> ParseError -> Bool
Eq, 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

-- | Like 'ParseError' but reports the stream position where the error ocurred.
-- The @Int@ is the position in the stream where the error ocurred. This
-- exception is used by position reporting parser drivers.
data ParseErrorPos = ParseErrorPos Int String
    deriving (ParseErrorPos -> ParseErrorPos -> Bool
(ParseErrorPos -> ParseErrorPos -> Bool)
-> (ParseErrorPos -> ParseErrorPos -> Bool) -> Eq ParseErrorPos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseErrorPos -> ParseErrorPos -> Bool
== :: ParseErrorPos -> ParseErrorPos -> Bool
$c/= :: ParseErrorPos -> ParseErrorPos -> Bool
/= :: ParseErrorPos -> ParseErrorPos -> Bool
Eq, Int -> ParseErrorPos -> ShowS
[ParseErrorPos] -> ShowS
ParseErrorPos -> String
(Int -> ParseErrorPos -> ShowS)
-> (ParseErrorPos -> String)
-> ([ParseErrorPos] -> ShowS)
-> Show ParseErrorPos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseErrorPos -> ShowS
showsPrec :: Int -> ParseErrorPos -> ShowS
$cshow :: ParseErrorPos -> String
show :: ParseErrorPos -> String
$cshowList :: [ParseErrorPos] -> ShowS
showList :: [ParseErrorPos] -> ShowS
Show)

instance Exception ParseErrorPos where
    displayException :: ParseErrorPos -> String
displayException (ParseErrorPos Int
pos String
err) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"At ", Int -> String
forall a. Show a => a -> String
show Int
pos, String
":", 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 (Final s a)
extract) =
        (s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b
Parser s -> a -> m (Step s b)
step m (Initial s b)
initial ((a -> b) -> (s -> m (Final s a)) -> s -> m (Final 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 (Final 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 (f a) -> f (f b)) -> f (f (f a)) -> f (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 ((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))

------------------------------------------------------------------------------
-- 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 (Final s b)
extract) =
    (s -> a -> m (Step s c))
-> m (Initial s c) -> (s -> m (Final s c)) -> Parser a m c
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b
Parser s -> a -> m (Step s c)
step1 m (Initial s c)
initial1 (s -> m (Final s b)
extract (s -> m (Final s b))
-> (Final s b -> m (Final s c)) -> s -> m (Final s c)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (b -> m c) -> Final s b -> m (Final s c)
forall (m :: * -> *) a b s.
Applicative m =>
(a -> m b) -> Final s a -> m (Final s b)
mapMFinal 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 (Final Any b)) -> Parser a m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b
Parser Any -> a -> m (Step Any b)
forall a. HasCallStack => 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 (Final Any b)
forall a. HasCallStack => 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 (Final Any b)) -> Parser a m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b
Parser Any -> a -> m (Step Any b)
forall a. HasCallStack => a
undefined (b -> Initial Any b
forall s b. b -> Initial s b
IDone (b -> Initial Any b) -> m b -> m (Initial Any b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
b) Any -> m (Final Any b)
forall a. HasCallStack => 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 (Final s a)
extractL)
               (Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m (Final 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 (Final (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 (Final 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 (Final (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.
            SPartial 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
SContinue Int
n (s -> SeqParseState s (b -> c) s
forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
s)
            SContinue 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
SContinue Int
n (s -> SeqParseState s (b -> c) s
forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
s)
            SDone 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
SContinue 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
SDone 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
SError String
err
            SError 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
SError 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 (Final (SeqParseState s (b -> c) s) c)
extract (SeqParseR b -> c
f s
sR) = (Final s b -> Final (SeqParseState s (b -> c) s) c)
-> m (Final s b) -> m (Final (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) -> Final s b -> Final (SeqParseState s (b -> c) s) c
forall a b c d. (a -> b) -> (c -> d) -> Final a c -> Final 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 (Final s b)
extractR s
sR)
    extract (SeqParseL s
sL) = do
        -- XXX Use bimap here
        Final s a
rL <- s -> m (Final s a)
extractL s
sL
        case Final s a
rL of
            FDone 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
                        (Final s b -> Final (SeqParseState s (b -> c) s) c)
-> m (Final s b) -> m (Final (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) -> Final s b -> Final (SeqParseState s (b -> c) s) c
forall a b c d. (a -> b) -> (c -> d) -> Final a c -> Final 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 (Final s b)
extractR s
sR)
                    IDone b
bR -> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SeqParseState s (b -> c) s) c
 -> m (Final (SeqParseState s (b -> c) s) c))
-> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Final (SeqParseState s (b -> c) s) c
forall s b. Int -> b -> Final s b
FDone Int
n (c -> Final (SeqParseState s (b -> c) s) c)
-> c -> Final (SeqParseState s (b -> c) s) c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
func a
bL b
bR
                    IError String
err -> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SeqParseState s (b -> c) s) c
 -> m (Final (SeqParseState s (b -> c) s) c))
-> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ String -> Final (SeqParseState s (b -> c) s) c
forall s b. String -> Final s b
FError String
err
            FError String
err -> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SeqParseState s (b -> c) s) c
 -> m (Final (SeqParseState s (b -> c) s) c))
-> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ String -> Final (SeqParseState s (b -> c) s) c
forall s b. String -> Final s b
FError String
err
            FContinue Int
n s
s -> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SeqParseState s (b -> c) s) c
 -> m (Final (SeqParseState s (b -> c) s) c))
-> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ Int
-> SeqParseState s (b -> c) s
-> Final (SeqParseState s (b -> c) s) c
forall s b. Int -> s -> Final s b
FContinue 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 (Final s a)
extractL)
               (Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m (Final 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 (Final (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 (Final 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 (Final (SeqParseState s (b -> c) s) c)
extract

    where

    errMsg :: String -> a
errMsg String
e = String -> a
forall a. HasCallStack => 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 SDone 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.
            SPartial 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
SPartial Int
n (s -> SeqParseState s (b -> c) s
forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
s)
            SContinue 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
SContinue Int
n (s -> SeqParseState s (b -> c) s
forall sl f sr. sl -> SeqParseState sl f sr
SeqParseL s
s)
            SDone 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
SPartial 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
SDone 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
            SError 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 (Final (SeqParseState s (b -> c) s) c)
extract (SeqParseR b -> c
f s
sR) = (Final s b -> Final (SeqParseState s (b -> c) s) c)
-> m (Final s b) -> m (Final (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) -> Final s b -> Final (SeqParseState s (b -> c) s) c
forall a b c d. (a -> b) -> (c -> d) -> Final a c -> Final 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 (Final s b)
extractR s
sR)

    extract (SeqParseL s
sL) = do
        Final s a
rL <- s -> m (Final s a)
extractL s
sL
        case Final s a
rL of
            FDone Int
n a
bL -> do
                Initial s b
iR <- m (Initial s b)
initialR
                case Initial s b
iR of
                    IPartial s
sR -> do
                        Final s b
rR <- s -> m (Final s b)
extractR s
sR
                        Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                            (Final (SeqParseState s (b -> c) s) c
 -> m (Final (SeqParseState s (b -> c) s) c))
-> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ Int
-> (s -> SeqParseState s (b -> c) s)
-> (b -> c)
-> Final s b
-> Final (SeqParseState s (b -> c) s) c
forall s s1 b b1.
Int -> (s -> s1) -> (b -> b1) -> Final s b -> Final s1 b1
bimapFinalOverrideCount
                                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) Final s b
rR
                    IDone b
bR -> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SeqParseState s (b -> c) s) c
 -> m (Final (SeqParseState s (b -> c) s) c))
-> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Final (SeqParseState s (b -> c) s) c
forall s b. Int -> b -> Final s b
FDone Int
n (c -> Final (SeqParseState s (b -> c) s) c)
-> c -> Final (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 (Final (SeqParseState s (b -> c) s) c)
forall {a}. String -> a
errMsg String
err
            FError String
err -> String -> m (Final (SeqParseState s (b -> c) s) c)
forall {a}. String -> a
errMsg String
err
            FContinue Int
n s
s -> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SeqParseState s (b -> c) s) c
 -> m (Final (SeqParseState s (b -> c) s) c))
-> Final (SeqParseState s (b -> c) s) c
-> m (Final (SeqParseState s (b -> c) s) c)
forall a b. (a -> b) -> a -> b
$ Int
-> SeqParseState s (b -> c) s
-> Final (SeqParseState s (b -> c) s) c
forall s b. Int -> s -> Final s b
FContinue 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 (Final s a)
extractL) (Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m (Final s b)
extractR) =
    (SeqAState s s -> x -> m (Step (SeqAState s s) b))
-> m (Initial (SeqAState s s) b)
-> (SeqAState s s -> m (Final (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 (Final 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 (Final (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 SDone 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.
            SPartial 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
SContinue Int
n (s -> SeqAState s s
forall sl sr. sl -> SeqAState sl sr
SeqAL s
s)
            SContinue 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
SContinue Int
n (s -> SeqAState s s
forall sl sr. sl -> SeqAState sl sr
SeqAL s
s)
            SDone 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
SContinue 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
SDone Int
n b
b
                    IError String
err -> String -> Step (SeqAState s s) b
forall s b. String -> Step s b
SError String
err
            SError 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
SError 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 (Final (SeqAState s s) b)
extract (SeqAR s
sR) = (Final s b -> Final (SeqAState s s) b)
-> m (Final s b) -> m (Final (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) -> Final s b -> Final (SeqAState s s) b
forall a b c. (a -> b) -> Final a c -> Final 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 (Final s b)
extractR s
sR)
    extract (SeqAL s
sL) = do
        Final s a
rL <- s -> m (Final s a)
extractL s
sL
        case Final s a
rL of
            FDone 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 ->
                        (Final s b -> Final (SeqAState s s) b)
-> m (Final s b) -> m (Final (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)
-> Final s b
-> Final (SeqAState s s) b
forall s s1 b b1.
Int -> (s -> s1) -> (b -> b1) -> Final s b -> Final s1 b1
bimapFinalOverrideCount Int
n s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR b -> b
forall a. a -> a
id) (s -> m (Final s b)
extractR s
sR)
                    IDone b
bR -> Final (SeqAState s s) b -> m (Final (SeqAState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SeqAState s s) b -> m (Final (SeqAState s s) b))
-> Final (SeqAState s s) b -> m (Final (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Final (SeqAState s s) b
forall s b. Int -> b -> Final s b
FDone Int
n b
bR
                    IError String
err -> Final (SeqAState s s) b -> m (Final (SeqAState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SeqAState s s) b -> m (Final (SeqAState s s) b))
-> Final (SeqAState s s) b -> m (Final (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ String -> Final (SeqAState s s) b
forall s b. String -> Final s b
FError String
err
            FError String
err -> Final (SeqAState s s) b -> m (Final (SeqAState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SeqAState s s) b -> m (Final (SeqAState s s) b))
-> Final (SeqAState s s) b -> m (Final (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ String -> Final (SeqAState s s) b
forall s b. String -> Final s b
FError String
err
            FContinue Int
n s
s -> Final (SeqAState s s) b -> m (Final (SeqAState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SeqAState s s) b -> m (Final (SeqAState s s) b))
-> Final (SeqAState s s) b -> m (Final (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ Int -> SeqAState s s -> Final (SeqAState s s) b
forall s b. Int -> s -> Final s b
FContinue 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 (Final s a)
extractL) (Parser s -> x -> m (Step s b)
stepR m (Initial s b)
initialR s -> m (Final s b)
extractR) =
    (SeqAState s s -> x -> m (Step (SeqAState s s) b))
-> m (Initial (SeqAState s s) b)
-> (SeqAState s s -> m (Final (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 (Final 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 (Final (SeqAState s s) b)
extract

    where

    errMsg :: String -> a
errMsg String
e = String -> a
forall a. HasCallStack => 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 SDone 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
            SPartial 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
SPartial Int
n (s -> SeqAState s s
forall sl sr. sl -> SeqAState sl sr
SeqAL s
s)
            SContinue 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
SContinue Int
n (s -> SeqAState s s
forall sl sr. sl -> SeqAState sl sr
SeqAL s
s)
            SDone 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
SPartial 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
SDone Int
n b
b
                    IError String
err -> String -> Step (SeqAState s s) b
forall {a}. String -> a
errMsg String
err
            SError 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 (Final (SeqAState s s) b)
extract (SeqAR s
sR) = (Final s b -> Final (SeqAState s s) b)
-> m (Final s b) -> m (Final (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) -> Final s b -> Final (SeqAState s s) b
forall a b c. (a -> b) -> Final a c -> Final 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 (Final s b)
extractR s
sR)
    extract (SeqAL s
sL) = do
        Final s a
rL <- s -> m (Final s a)
extractL s
sL
        case Final s a
rL of
            FDone Int
n a
_ -> do
                Initial s b
iR <- m (Initial s b)
initialR
                case Initial s b
iR of
                    IPartial s
sR -> do
                        (Final s b -> Final (SeqAState s s) b)
-> m (Final s b) -> m (Final (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)
-> Final s b
-> Final (SeqAState s s) b
forall s s1 b b1.
Int -> (s -> s1) -> (b -> b1) -> Final s b -> Final s1 b1
bimapFinalOverrideCount Int
n s -> SeqAState s s
forall sl sr. sr -> SeqAState sl sr
SeqAR b -> b
forall a. a -> a
id) (s -> m (Final s b)
extractR s
sR)
                    IDone b
bR -> Final (SeqAState s s) b -> m (Final (SeqAState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SeqAState s s) b -> m (Final (SeqAState s s) b))
-> Final (SeqAState s s) b -> m (Final (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Final (SeqAState s s) b
forall s b. Int -> b -> Final s b
FDone Int
n b
bR
                    IError String
err -> String -> m (Final (SeqAState s s) b)
forall {a}. String -> a
errMsg String
err
            FError String
err -> String -> m (Final (SeqAState s s) b)
forall {a}. String -> a
errMsg String
err
            FContinue Int
n s
s -> Final (SeqAState s s) b -> m (Final (SeqAState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SeqAState s s) b -> m (Final (SeqAState s s) b))
-> Final (SeqAState s s) b -> m (Final (SeqAState s s) b)
forall a b. (a -> b) -> a -> b
$ Int -> SeqAState s s -> Final (SeqAState s s) b
forall s b. Int -> s -> Final s b
FContinue 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 (Final s a)
extractL) (Parser s -> x -> m (Step s a)
stepR m (Initial s a)
initialR s -> m (Final s a)
extractR) =
    (AltParseState s s -> x -> m (Step (AltParseState s s) a))
-> m (Initial (AltParseState s s) a)
-> (AltParseState s s -> m (Final (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 (Final 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 (Final (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
            SPartial 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
SPartial Int
n (Int -> s -> AltParseState s s
forall sl sr. Int -> sl -> AltParseState sl sr
AltParseL Int
0 s
s)
            SContinue Int
n s
s -> do
                assertM(Int
cnt 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
SContinue 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
n) s
s)
            SDone 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
SDone Int
n a
b
            SError 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
SContinue (Int -> Int
forall a. Num a => a -> a
negate 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
SDone (Int -> Int
forall a. Num a => a -> a
negate Int
cnt) a
b
                          IError String
err -> String -> Step (AltParseState s s) a
forall s b. String -> Step s b
SError 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
            SPartial Int
n s
s -> Int -> AltParseState s s -> Step (AltParseState s s) a
forall s b. Int -> s -> Step s b
SPartial Int
n (s -> AltParseState s s
forall sl sr. sr -> AltParseState sl sr
AltParseR s
s)
            SContinue Int
n s
s -> Int -> AltParseState s s -> Step (AltParseState s s) a
forall s b. Int -> s -> Step s b
SContinue Int
n (s -> AltParseState s s
forall sl sr. sr -> AltParseState sl sr
AltParseR s
s)
            SDone Int
n a
b -> Int -> a -> Step (AltParseState s s) a
forall s b. Int -> b -> Step s b
SDone Int
n a
b
            SError String
err -> String -> Step (AltParseState s s) a
forall s b. String -> Step s b
SError String
err

    extract :: AltParseState s s -> m (Final (AltParseState s s) a)
extract (AltParseR s
sR) = (Final s a -> Final (AltParseState s s) a)
-> m (Final s a) -> m (Final (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)
-> Final s a -> Final (AltParseState s s) a
forall a b c. (a -> b) -> Final a c -> Final 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 (Final s a)
extractR s
sR)

    extract (AltParseL Int
cnt s
sL) = do
        Final s a
rL <- s -> m (Final s a)
extractL s
sL
        case Final s a
rL of
            FDone Int
n a
b -> Final (AltParseState s s) a -> m (Final (AltParseState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (AltParseState s s) a -> m (Final (AltParseState s s) a))
-> Final (AltParseState s s) a -> m (Final (AltParseState s s) a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> Final (AltParseState s s) a
forall s b. Int -> b -> Final s b
FDone Int
n a
b
            FError String
_ -> do
                Initial s a
res <- m (Initial s a)
initialR
                Final (AltParseState s s) a -> m (Final (AltParseState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Final (AltParseState s s) a -> m (Final (AltParseState s s) a))
-> Final (AltParseState s s) a -> m (Final (AltParseState s s) a)
forall a b. (a -> b) -> a -> b
$ case Initial s a
res of
                          IPartial s
rR -> Int -> AltParseState s s -> Final (AltParseState s s) a
forall s b. Int -> s -> Final s b
FContinue (- Int
cnt) (s -> AltParseState s s
forall sl sr. sr -> AltParseState sl sr
AltParseR s
rR)
                          IDone a
b -> Int -> a -> Final (AltParseState s s) a
forall s b. Int -> b -> Final s b
FDone (- Int
cnt) a
b
                          IError String
err -> String -> Final (AltParseState s s) a
forall s b. String -> Final s b
FError String
err
            FContinue Int
n s
s -> do
                assertM(Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (- Int
cnt))
                Final (AltParseState s s) a -> m (Final (AltParseState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (AltParseState s s) a -> m (Final (AltParseState s s) a))
-> Final (AltParseState s s) a -> m (Final (AltParseState s s) a)
forall a b. (a -> b) -> a -> b
$ Int -> AltParseState s s -> Final (AltParseState s s) a
forall s b. Int -> s -> Final s b
FContinue 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 (Final 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 (Final (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 (Final 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 (Final (Fused3 s Int s) c)
forall {b}. Num b => Fused3 s Int s -> m (Final (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
        case Step s b
r of
            SPartial Int
n s
s -> do
                assertM(Int
cnt 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
SContinue Int
n (s -> Int -> s -> Fused3 s Int s
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
s (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs)
            SContinue Int
n s
s -> do
                assertM(Int
cnt 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
SContinue Int
n (s -> Int -> s -> Fused3 s Int s
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
s (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs)
            SDone Int
n b
b -> do
                assertM(Int
cnt 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
SPartial Int
n) (Int -> c -> Step (Fused3 s Int s) c
forall s b. Int -> b -> Step s b
SDone Int
n)
            SError String
_ -> do
                c
xs <- s -> m c
ffinal s
fs
                -- XXX review, need a test for this
                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
SDone (- Int
cnt) c
xs

    extract :: Fused3 s Int s -> m (Final (Fused3 s b s) c)
extract (Fused3 s
_ Int
0 s
fs) = (c -> Final (Fused3 s b s) c) -> m c -> m (Final (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 -> Final (Fused3 s b s) c
forall s b. Int -> b -> Final s b
FDone Int
0) (s -> m c
ffinal s
fs)
    extract (Fused3 s
s Int
cnt s
fs) = do
        Final s b
r <- s -> m (Final s b)
extract1 s
s
        case Final s b
r of
            FError String
_ -> (c -> Final (Fused3 s b s) c) -> m c -> m (Final (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 -> Final (Fused3 s b s) c
forall s b. Int -> b -> Final s b
FDone (- Int
cnt)) (s -> m c
ffinal s
fs)
            FDone 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 -> Final (Fused3 s b s) c) -> m c -> m (Final (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 -> Final (Fused3 s b s) c
forall s b. Int -> b -> Final s b
FDone Int
n) (s -> m c
ffinal s
s1)
                    FL.Done c
b1 -> Final (Fused3 s b s) c -> m (Final (Fused3 s b s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Final (Fused3 s b s) c
forall s b. Int -> b -> Final s b
FDone Int
n c
b1)
            FContinue Int
n s
s1 -> do
                assertM((- Int
n) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cnt)
                Final (Fused3 s b s) c -> m (Final (Fused3 s b s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fused3 s b s -> Final (Fused3 s b s) c
forall s b. Int -> s -> Final s b
FContinue 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 (Final 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 (Final (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 (Final 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 (Final (Fused3 s Int s) c)
forall {b}. Num b => Fused3 s Int s -> m (Final (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
        case Step s b
r of
            SPartial Int
n s
s -> do
                assertM(Int
cnt 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
SContinue Int
n (s -> Int -> s -> Fused3 s Int s
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
s (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs)
            SContinue Int
n s
s -> do
                assertM(Int
cnt 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
SContinue Int
n (s -> Int -> s -> Fused3 s Int s
forall a b c. a -> b -> c -> Fused3 a b c
Fused3 s
s (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs)
            SDone Int
n b
b -> do
                assertM(Int
cnt 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
SPartial Int
n) (Int -> c -> Step (Fused3 s Int s) c
forall s b. Int -> b -> Step s b
SDone Int
n)
            SError 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
SDone (- Int
cnt) c
xs

    extract :: Fused3 s Int s -> m (Final (Fused3 s b s) c)
extract (Fused3 s
s Int
cnt s
fs) = do
        Final s b
r <- s -> m (Final s b)
extract1 s
s
        case Final s b
r of
            FError String
_ -> (c -> Final (Fused3 s b s) c) -> m c -> m (Final (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 -> Final (Fused3 s b s) c
forall s b. Int -> b -> Final s b
FDone (- Int
cnt)) (s -> m c
ffinal s
fs)
            FDone 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 -> Final (Fused3 s b s) c) -> m c -> m (Final (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 -> Final (Fused3 s b s) c
forall s b. Int -> b -> Final s b
FDone Int
n) (s -> m c
ffinal s
s1)
                    FL.Done c
b1 -> Final (Fused3 s b s) c -> m (Final (Fused3 s b s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Final (Fused3 s b s) c
forall s b. Int -> b -> Final s b
FDone Int
n c
b1)
            FContinue Int
n s
s1 -> do
                assertM((- Int
n) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cnt)
                Final (Fused3 s b s) c -> m (Final (Fused3 s b s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fused3 s b s -> Final (Fused3 s b s) c
forall s b. Int -> s -> Final s b
FContinue 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 (Final 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 (Final (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 (Final 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 (Final (Fused3 s Int (Either s s)) c)
forall {b}.
Num b =>
Fused3 s Int (Either s s) -> m (Final (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
        case Step s b
r of
            SPartial Int
n s
s -> do
                assertM(Int
cnt 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
SContinue 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
cnt 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))
            SContinue Int
n s
s -> do
                assertM(Int
cnt 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
SContinue 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
cnt 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))
            SDone Int
n b
b -> do
                assertM(Int
cnt 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
SPartial Int
n) (Int -> c -> Step (Fused3 s Int (Either s s)) c
forall s b. Int -> b -> Step s b
SDone Int
n)
            SError 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
SError 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
        case Step s b
r of
            SPartial Int
n s
s -> do
                assertM(Int
cnt 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
SPartial 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
cnt 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))
            SContinue Int
n s
s -> do
                assertM(Int
cnt 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
SContinue 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
cnt 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))
            SDone Int
n b
b -> do
                assertM(Int
cnt 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
SPartial Int
n) (Int -> c -> Step (Fused3 s Int (Either s s)) c
forall s b. Int -> b -> Step s b
SDone Int
n)
            SError String
_ -> Int -> c -> Step (Fused3 s Int (Either s s)) c
forall s b. Int -> b -> Step s b
SDone (- Int
cnt) (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 (Final (Fused3 s b (Either s s)) c)
extract (Fused3 s
s Int
cnt (Left s
fs)) = do
        Final s b
r <- s -> m (Final s b)
extract1 s
s
        case Final s b
r of
            FError String
err -> Final (Fused3 s b (Either s s)) c
-> m (Final (Fused3 s b (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Final (Fused3 s b (Either s s)) c
forall s b. String -> Final s b
FError String
err)
            FDone 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 -> Final (Fused3 s b (Either s s)) c)
-> m c -> m (Final (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 -> Final (Fused3 s b (Either s s)) c
forall s b. Int -> b -> Final s b
FDone Int
n) (s -> m c
ffinal s
s1)
                    FL.Done c
b1 -> Final (Fused3 s b (Either s s)) c
-> m (Final (Fused3 s b (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Final (Fused3 s b (Either s s)) c
forall s b. Int -> b -> Final s b
FDone Int
n c
b1)
            FContinue Int
n s
s1 -> do
                assertM((- Int
n) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cnt)
                Final (Fused3 s b (Either s s)) c
-> m (Final (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) -> Final (Fused3 s b (Either s s)) c
forall s b. Int -> s -> Final s b
FContinue 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
        Final s b
r <- s -> m (Final s b)
extract1 s
s
        case Final s b
r of
            FError String
_ -> (c -> Final (Fused3 s b (Either s s)) c)
-> m c -> m (Final (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 -> Final (Fused3 s b (Either s s)) c
forall s b. Int -> b -> Final s b
FDone (- Int
cnt)) (s -> m c
ffinal s
fs)
            FDone 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 -> Final (Fused3 s b (Either s s)) c)
-> m c -> m (Final (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 -> Final (Fused3 s b (Either s s)) c
forall s b. Int -> b -> Final s b
FDone Int
n) (s -> m c
ffinal s
s1)
                    FL.Done c
b1 -> Final (Fused3 s b (Either s s)) c
-> m (Final (Fused3 s b (Either s s)) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Final (Fused3 s b (Either s s)) c
forall s b. Int -> b -> Final s b
FDone Int
n c
b1)
            FContinue Int
n s
s1 -> do
                assertM((- Int
n) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cnt)
                Final (Fused3 s b (Either s s)) c
-> m (Final (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) -> Final (Fused3 s b (Either s s)) c
forall s b. Int -> s -> Final s b
FContinue 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 (Final Any b)) -> Parser a m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b
Parser Any -> a -> m (Step Any b)
forall a. HasCallStack => 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 (Final Any b)
forall a. HasCallStack => 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 (Final Any b)) -> Parser a m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b
Parser Any -> a -> m (Step Any b)
forall a. HasCallStack => a
undefined (String -> Initial Any b
forall s b. String -> Initial s b
IError (String -> Initial Any b) -> m String -> m (Initial Any b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
err) Any -> m (Final Any b)
forall a. HasCallStack => a
undefined

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

-- | 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 (Final 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 (Final 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 (Final (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 (Final 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 (Final (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 (Final 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 (Final s b)) -> ConcatParseState sl m a b
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Final s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
sr s -> m (Final 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 (Final 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
SContinue 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 (Final s b)) -> ConcatParseState sl m a b
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Final s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
sr s -> m (Final s b)
extractR
            IDone b
br -> Int -> b -> Step (ConcatParseState sl m a b) b
forall s b. Int -> b -> Step s b
SDone Int
n b
br
            IError String
err -> String -> Step (ConcatParseState sl m a b) b
forall s b. String -> Step s b
SError 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
            SPartial 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
SContinue Int
n (s -> ConcatParseState s m a c
forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s)
            SContinue 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
SContinue Int
n (s -> ConcatParseState s m a c
forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s)
            SDone 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)
            SError 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
SError String
err

    step (ConcatParseR s -> a -> m (Step s c)
stepR s
st s -> m (Final 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
            SPartial 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
SPartial 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 (Final s c)) -> ConcatParseState s m a c
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Final s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m (Final s c)
extractR
            SContinue 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
SContinue 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 (Final s c)) -> ConcatParseState s m a c
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Final s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m (Final s c)
extractR
            SDone Int
n c
b -> Int -> c -> Step (ConcatParseState s m a c) c
forall s b. Int -> b -> Step s b
SDone Int
n c
b
            SError String
err -> String -> Step (ConcatParseState s m a c) c
forall s b. String -> Step s b
SError String
err

    {-# INLINE extractP #-}
    extractP :: Int -> Parser a m b -> m (Final (ConcatParseState sl m a b) b)
extractP Int
n (Parser s -> a -> m (Step s b)
stepR m (Initial s b)
initialR s -> m (Final s b)
extractR) = do
        Initial s b
res <- m (Initial s b)
initialR
        case Initial s b
res of
            IPartial s
s ->
                (Final s b -> Final (ConcatParseState sl m a b) b)
-> m (Final s b) -> m (Final (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)
-> Final s b -> Final (ConcatParseState sl m a b) b
forall a b c. (a -> b) -> Final a c -> Final 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 (Final s b)) -> ConcatParseState sl m a b
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Final s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
s1 s -> m (Final s b)
extractR))
                    (s -> m (Final s b)
extractR s
s)
            IDone b
b -> Final (ConcatParseState sl m a b) b
-> m (Final (ConcatParseState sl m a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> b -> Final (ConcatParseState sl m a b) b
forall s b. Int -> b -> Final s b
FDone Int
n b
b)
            IError String
err -> Final (ConcatParseState sl m a b) b
-> m (Final (ConcatParseState sl m a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (ConcatParseState sl m a b) b
 -> m (Final (ConcatParseState sl m a b) b))
-> Final (ConcatParseState sl m a b) b
-> m (Final (ConcatParseState sl m a b) b)
forall a b. (a -> b) -> a -> b
$ String -> Final (ConcatParseState sl m a b) b
forall s b. String -> Final s b
FError String
err

    extract :: ConcatParseState s m a c -> m (Final (ConcatParseState s m a c) c)
extract (ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m (Final s c)
extractR) =
        (Final s c -> Final (ConcatParseState s m a c) c)
-> m (Final s c) -> m (Final (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)
-> Final s c -> Final (ConcatParseState s m a c) c
forall a b c. (a -> b) -> Final a c -> Final 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 (Final s c)) -> ConcatParseState s m a c
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Final s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s1 s -> m (Final s c)
extractR)) (s -> m (Final s c)
extractR s
s)
    extract (ConcatParseL s
sL) = do
        Final s b
rL <- s -> m (Final s b)
extractL s
sL
        case Final s b
rL of
            FError String
err -> Final (ConcatParseState s m a c) c
-> m (Final (ConcatParseState s m a c) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (ConcatParseState s m a c) c
 -> m (Final (ConcatParseState s m a c) c))
-> Final (ConcatParseState s m a c) c
-> m (Final (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ String -> Final (ConcatParseState s m a c) c
forall s b. String -> Final s b
FError String
err
            FDone Int
n b
b -> Int -> Parser a m c -> m (Final (ConcatParseState s m a c) c)
forall {m :: * -> *} {a} {b} {sl}.
Monad m =>
Int -> Parser a m b -> m (Final (ConcatParseState sl m a b) b)
extractP Int
n (Parser a m c -> m (Final (ConcatParseState s m a c) c))
-> Parser a m c -> m (Final (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ b -> Parser a m c
func b
b
            FContinue Int
n s
s -> Final (ConcatParseState s m a c) c
-> m (Final (ConcatParseState s m a c) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (ConcatParseState s m a c) c
 -> m (Final (ConcatParseState s m a c) c))
-> Final (ConcatParseState s m a c) c
-> m (Final (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ Int
-> ConcatParseState s m a c -> Final (ConcatParseState s m a c) c
forall s b. Int -> s -> Final s b
FContinue 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 (Final 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 (Final (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 (Final 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 (Final (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 (Final 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 (Final s b)) -> ConcatParseState sl m a b
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Final s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
sr s -> m (Final 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 (Final 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
SPartial 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 (Final s b)) -> ConcatParseState sl m a b
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Final s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
sr s -> m (Final s b)
extractR
            IDone b
br -> Int -> b -> Step (ConcatParseState sl m a b) b
forall s b. Int -> b -> Step s b
SDone Int
n b
br
            IError String
err -> String -> Step (ConcatParseState sl m a b) b
forall s b. String -> Step s b
SError 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
            SPartial 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
SPartial Int
n (s -> ConcatParseState s m a c
forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s)
            SContinue 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
SContinue Int
n (s -> ConcatParseState s m a c
forall sl (m :: * -> *) a b. sl -> ConcatParseState sl m a b
ConcatParseL s
s)
            SDone 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)
            SError 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
SError String
err

    step (ConcatParseR s -> a -> m (Step s c)
stepR s
st s -> m (Final 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
            SPartial 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
SPartial 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 (Final s c)) -> ConcatParseState s m a c
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Final s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m (Final s c)
extractR
            SContinue 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
SContinue 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 (Final s c)) -> ConcatParseState s m a c
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Final s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m (Final s c)
extractR
            SDone Int
n c
b -> Int -> c -> Step (ConcatParseState s m a c) c
forall s b. Int -> b -> Step s b
SDone Int
n c
b
            SError String
err -> String -> Step (ConcatParseState s m a c) c
forall s b. String -> Step s b
SError String
err

    {-# INLINE extractP #-}
    extractP :: Int -> Parser a m b -> m (Final (ConcatParseState sl m a b) b)
extractP Int
n (Parser s -> a -> m (Step s b)
stepR m (Initial s b)
initialR s -> m (Final s b)
extractR) = do
        Initial s b
res <- m (Initial s b)
initialR
        case Initial s b
res of
            IPartial s
s ->
                (Final s b -> Final (ConcatParseState sl m a b) b)
-> m (Final s b) -> m (Final (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)
-> Final s b -> Final (ConcatParseState sl m a b) b
forall a b c. (a -> b) -> Final a c -> Final 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 (Final s b)) -> ConcatParseState sl m a b
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Final s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s b)
stepR s
s1 s -> m (Final s b)
extractR))
                    (s -> m (Final s b)
extractR s
s)
            IDone b
b -> Final (ConcatParseState sl m a b) b
-> m (Final (ConcatParseState sl m a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> b -> Final (ConcatParseState sl m a b) b
forall s b. Int -> b -> Final s b
FDone Int
n b
b)
            IError String
err -> Final (ConcatParseState sl m a b) b
-> m (Final (ConcatParseState sl m a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (ConcatParseState sl m a b) b
 -> m (Final (ConcatParseState sl m a b) b))
-> Final (ConcatParseState sl m a b) b
-> m (Final (ConcatParseState sl m a b) b)
forall a b. (a -> b) -> a -> b
$ String -> Final (ConcatParseState sl m a b) b
forall s b. String -> Final s b
FError String
err

    extract :: ConcatParseState s m a c -> m (Final (ConcatParseState s m a c) c)
extract (ConcatParseR s -> a -> m (Step s c)
stepR s
s s -> m (Final s c)
extractR) =
        (Final s c -> Final (ConcatParseState s m a c) c)
-> m (Final s c) -> m (Final (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)
-> Final s c -> Final (ConcatParseState s m a c) c
forall a b c. (a -> b) -> Final a c -> Final 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 (Final s c)) -> ConcatParseState s m a c
forall sl (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> s -> (s -> m (Final s b)) -> ConcatParseState sl m a b
ConcatParseR s -> a -> m (Step s c)
stepR s
s1 s -> m (Final s c)
extractR)) (s -> m (Final s c)
extractR s
s)
    extract (ConcatParseL s
sL) = do
        Final s b
rL <- s -> m (Final s b)
extractL s
sL
        case Final s b
rL of
            FError String
err -> Final (ConcatParseState s m a c) c
-> m (Final (ConcatParseState s m a c) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (ConcatParseState s m a c) c
 -> m (Final (ConcatParseState s m a c) c))
-> Final (ConcatParseState s m a c) c
-> m (Final (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ String -> Final (ConcatParseState s m a c) c
forall s b. String -> Final s b
FError String
err
            FDone Int
n b
b -> Int -> Parser a m c -> m (Final (ConcatParseState s m a c) c)
forall {m :: * -> *} {a} {b} {sl}.
Monad m =>
Int -> Parser a m b -> m (Final (ConcatParseState sl m a b) b)
extractP Int
n (Parser a m c -> m (Final (ConcatParseState s m a c) c))
-> Parser a m c -> m (Final (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ b -> Parser a m c
func b
b
            FContinue Int
n s
s -> Final (ConcatParseState s m a c) c
-> m (Final (ConcatParseState s m a c) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (ConcatParseState s m a c) c
 -> m (Final (ConcatParseState s m a c) c))
-> Final (ConcatParseState s m a c) c
-> m (Final (ConcatParseState s m a c) c)
forall a b. (a -> b) -> a -> b
$ Int
-> ConcatParseState s m a c -> Final (ConcatParseState s m a c) c
forall s b. Int -> s -> Final s b
FContinue 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 (Final s r)
done) = (s -> a -> m (Step s r))
-> m (Initial s r) -> (s -> m (Final s r)) -> Parser a m r
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b
Parser s -> a -> m (Step s r)
step1 m (Initial s r)
begin s -> m (Final 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 (Final s r)
done) = (s -> a -> m (Step s r))
-> m (Initial s r) -> (s -> m (Final s r)) -> Parser a m r
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b
Parser s -> a -> m (Step s r)
step1 m (Initial s r)
begin s -> m (Final 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 (Final s b)
extract) = (s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b
Parser s -> a -> m (Step s b)
step1 m (Initial s b)
initial s -> m (Final 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
SPartial Int
1 s
x

-- XXX move this to ParserD.Transformer

-- | Modify the environment of the underlying ReaderT monad.
{-# INLINE localReaderT #-}
localReaderT ::
    (r -> r) -> Parser a (ReaderT r m) b -> Parser a (ReaderT r m) b
localReaderT :: forall r a (m :: * -> *) b.
(r -> r) -> Parser a (ReaderT r m) b -> Parser a (ReaderT r m) b
localReaderT r -> r
f (Parser s -> a -> ReaderT r m (Step s b)
step ReaderT r m (Initial s b)
initial s -> ReaderT r m (Final s b)
extract) =
    (s -> a -> ReaderT r m (Step s b))
-> ReaderT r m (Initial s b)
-> (s -> ReaderT r m (Final s b))
-> Parser a (ReaderT r m) b
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b
Parser
        (((r -> r) -> ReaderT r m (Step s b) -> ReaderT r m (Step s b)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local r -> r
f (ReaderT r m (Step s b) -> ReaderT r m (Step s b))
-> (a -> ReaderT r m (Step s b)) -> a -> ReaderT r m (Step s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> ReaderT r m (Step s b)) -> a -> ReaderT r m (Step s b))
-> (s -> a -> ReaderT r m (Step s b))
-> s
-> a
-> ReaderT r m (Step s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> ReaderT r m (Step s b)
step)
        ((r -> r) -> ReaderT r m (Initial s b) -> ReaderT r m (Initial s b)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local r -> r
f ReaderT r m (Initial s b)
initial)
        ((r -> r) -> ReaderT r m (Final s b) -> ReaderT r m (Final s b)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local r -> r
f (ReaderT r m (Final s b) -> ReaderT r m (Final s b))
-> (s -> ReaderT r m (Final s b)) -> s -> ReaderT r m (Final s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> ReaderT r m (Final s b)
extract)