{-# LANGUAGE CPP #-}
{-# LANGUAGE NoMonoLocalBinds #-}
-- |
-- Module      : Streamly.Internal.Data.Parser
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC

module Streamly.Internal.Data.Parser
    (
    -- * Setup
    -- | To execute the code examples provided in this module in ghci, please
    -- run the following commands first.
    --
    -- $setup

      module Streamly.Internal.Data.Parser.Type
    --, module Streamly.Internal.Data.Parser.Tee

    -- * Downgrade to Fold
    , toFold

    -- First order parsers
    -- * Accumulators
    , fromFold
    , fromFoldMaybe

    -- * Map on input
    , postscan

    -- * Element parsers
    , peek

    -- All of these can be expressed in terms of either
    , one
    , oneEq
    , oneNotEq
    , oneOf
    , noneOf
    , eof
    , satisfy
    , maybe
    , either

    -- * Sequence parsers (tokenizers)
    --
    -- | Parsers chained in series, if one parser terminates the composition
    -- terminates. Currently we are using folds to collect the output of the
    -- parsers but we can use Parsers instead of folds to make the composition
    -- more powerful. For example, we can do:
    --
    -- takeEndByOrMax cond n p = takeEndBy cond (take n p)
    -- takeEndByBetween cond m n p = takeEndBy cond (takeBetween m n p)
    -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
    , lookAhead

    -- ** By length
    -- | Grab a sequence of input elements without inspecting them
    , takeBetween
    -- , take -- takeBetween 0 n
    , takeEQ -- takeBetween n n
    , takeGE -- takeBetween n maxBound
    -- , takeGE1 -- take1 -- takeBetween 1 n
    , takeP

    -- Grab a sequence of input elements by inspecting them
    -- ** Exact match
    , listEq
    , listEqBy
    , streamEqBy
    , subsequenceBy

    -- ** By predicate
    , takeWhile
    , takeWhileP
    , takeWhile1
    , dropWhile

    -- ** Separated by elements
    -- | Separator could be in prefix postion ('takeBeginBy'), or suffix
    -- position ('takeEndBy'). See 'deintercalate', 'sepBy' etc for infix
    -- separator parsing, also see 'intersperseQuotedBy' fold.

    -- These can be implemented modularly with refolds, using takeWhile and
    -- satisfy.
    , takeEndBy
    , takeEndBy_
    , takeEndByEsc
    -- , takeEndByEsc_
    , takeBeginBy
    , takeBeginBy_
    , takeEitherSepBy
    , wordBy

    -- ** Grouped by element comparison
    , groupBy
    , groupByRolling
    , groupByRollingEither

    -- ** Framed by elements
    -- | Also see 'intersperseQuotedBy' fold.
    -- Framed by a one or more ocurrences of a separator around a word like
    -- spaces or quotes. No nesting.
    , wordFramedBy -- XXX Remove this? Covered by wordWithQuotes?
    , wordWithQuotes
    , wordKeepQuotes
    , wordProcessQuotes

    -- Framed by separate start and end characters, potentially nested.
    -- blockWithQuotes allows quotes inside a block. However,
    -- takeFramedByGeneric can be used to express takeBeginBy, takeEndBy and
    -- block with escaping.
    -- , takeFramedBy
    , takeFramedBy_
    , takeFramedByEsc_
    , takeFramedByGeneric
    , blockWithQuotes

    -- Matching strings
    -- , prefixOf -- match any prefix of a given string
    -- , suffixOf -- match any suffix of a given string
    -- , infixOf -- match any substring of a given string

    -- ** Spanning
    , span
    , spanBy
    , spanByRolling

    -- Second order parsers (parsers using parsers)
    -- * Binary Combinators
    {-
    -- ** Parallel Applicatives
    , teeWith
    , teeWithFst
    , teeWithMin
    -- , teeTill -- like manyTill but parallel
    -}

    {-
    -- ** Parallel Alternatives
    , shortest
    , longest
    -- , fastest
    -}

    -- * N-ary Combinators
    -- ** Sequential Collection
    , sequence

    -- ** Sequential Repetition
    , count
    , countBetween
    -- , countBetweenTill
    , manyP
    , many
    , some

    -- ** Interleaved Repetition
    -- Use two folds, run a primary parser, its rejected values go to the
    -- secondary parser.
    , deintercalate
    , deintercalate1
    , deintercalateAll
    -- , deintercalatePrefix
    -- , deintercalateSuffix

    -- *** Special cases
    -- | TODO: traditional implmentations of these may be of limited use. For
    -- example, consider parsing lines separated by @\\r\\n@. The main parser
    -- will have to detect and exclude the sequence @\\r\\n@ anyway so that we
    -- can apply the "sep" parser.
    --
    -- We can instead implement these as special cases of deintercalate.
    --
    -- @
    -- , endBy
    -- , sepEndBy
    -- , beginBy
    -- , sepBeginBy
    -- , sepAroundBy
    -- @
    , sepBy1
    , sepBy
    , sepByAll

    , manyTillP
    , manyTill
    , manyThen

    -- -- * Distribution
    --
    -- A simple and stupid impl would be to just convert the stream to an array
    -- and give the array reference to all consumers. The array can be grown on
    -- demand by any consumer and truncated when nonbody needs it.
    --
    -- -- ** Distribute to collection
    -- -- ** Distribute to repetition

    -- ** Interleaved collection
    -- |
    --
    -- 1. Round robin
    -- 2. Priority based
    , roundRobin

    -- -- ** Interleaved repetition
    -- repeat one parser and when it fails run an error recovery parser
    -- e.g. to find a key frame in the stream after an error

    -- ** Collection of Alternatives
    -- | Unimplemented
    --
    -- @
    -- , shortestN
    -- , longestN
    -- , fastestN -- first N successful in time
    -- , choiceN  -- first N successful in position
    -- @
    -- , choice   -- first successful in position

    -- ** Repeated Alternatives
    , retryMaxTotal
    , retryMaxSuccessive
    , retry

    -- ** Zipping Input
    , zipWithM
    , zip
    , indexed
    , makeIndexFilter
    , sampleFromthen

     -- * Deprecated
    , next
    , takeStartBy
    , takeStartBy_
    )
where

#include "inline.hs"
#include "deprecation.h"
#include "assert.hs"

import Data.Bifunctor (first)
import Fusion.Plugin.Types (Fuse(..))
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.SVar.Type (defState)
import Streamly.Internal.Data.Either.Strict (Either'(..))
import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
import Streamly.Internal.Data.Stream.Type (Stream)

import qualified Data.Foldable as Foldable
import qualified Streamly.Internal.Data.Fold.Type as FL
import qualified Streamly.Internal.Data.Stream.Type as D
import qualified Streamly.Internal.Data.Stream.Generate as D

import Streamly.Internal.Data.Parser.Type
--import Streamly.Internal.Data.Parser.Tee -- It's empty

import Prelude hiding
       (any, all, take, takeWhile, sequence, concatMap, maybe, either, span
       , zip, filter, dropWhile)

#include "DocTestDataParser.hs"

-------------------------------------------------------------------------------
-- Downgrade a parser to a Fold
-------------------------------------------------------------------------------

-- | Make a 'Fold' from a 'Parser'. The fold just throws an exception if the
-- parser fails or tries to backtrack.
--
-- This can be useful in combinators that accept a Fold and we know that a
-- Parser cannot fail or failure exception is acceptable as there is no way to
-- recover.
--
-- /Pre-release/
--
{-# INLINE toFold #-}
toFold :: Monad m => Parser a m b -> Fold m a b
toFold :: forall (m :: * -> *) a b. Monad m => Parser a m b -> Fold m a b
toFold (Parser s -> a -> m (Step s b)
pstep m (Initial s b)
pinitial s -> m (Final s b)
pextract) = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step m (Step s b)
initial s -> m b
forall {a}. a
extract s -> m b
final

    where

    initial :: m (Step s b)
initial = do
        Initial s b
r <- m (Initial s b)
pinitial
        case Initial s b
r of
            IPartial s
s -> 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
$ s -> Step s b
forall s b. s -> Step s b
FL.Partial s
s
            IDone b
b -> 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
$ b -> Step s b
forall s b. b -> Step s b
FL.Done b
b
            IError String
err ->
                String -> m (Step s b)
forall a. HasCallStack => String -> a
error (String -> m (Step s b)) -> String -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ String
"toFold: parser throws error in initial" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err

    perror :: a -> a
perror a
n = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"toFold: parser backtracks in SPartial: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n
    cerror :: a -> a
cerror a
n = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"toFold: parser backtracks in SContinue: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n
    derror :: a -> a
derror a
n = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"toFold: parser backtracks in SDone: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n
    eerror :: String -> a
eerror String
err = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"toFold: parser throws error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err

    step :: s -> a -> m (Step s b)
step s
st a
a = do
        Step s b
r <- s -> a -> m (Step s b)
pstep s
st a
a
        case Step s b
r of
            SPartial Int
1 s
s -> 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
$ s -> Step s b
forall s b. s -> Step s b
FL.Partial s
s
            SContinue Int
1 s
s -> 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
$ s -> Step s b
forall s b. s -> Step s b
FL.Partial s
s
            SDone Int
1 b
b -> 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
$ b -> Step s b
forall s b. b -> Step s b
FL.Done b
b
            SPartial Int
n s
_ -> Int -> m (Step s b)
forall {a} {a}. Show a => a -> a
perror Int
n
            SContinue Int
n s
_ -> Int -> m (Step s b)
forall {a} {a}. Show a => a -> a
cerror Int
n
            SDone Int
n b
_ -> Int -> m (Step s b)
forall {a} {a}. Show a => a -> a
derror Int
n
            SError String
err -> String -> m (Step s b)
forall {a}. String -> a
eerror String
err

    extract :: a
extract = String -> a
forall a. HasCallStack => String -> a
error String
"toFold: parser cannot be used for scanning"

    final :: s -> m b
final s
st = do
        Final s b
r <- s -> m (Final s b)
pextract s
st
        case Final s b
r of
            FDone Int
0 b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
            FContinue Int
n s
_ -> Int -> m b
forall {a} {a}. Show a => a -> a
cerror Int
n
            FDone Int
n b
_ -> Int -> m b
forall {a} {a}. Show a => a -> a
derror Int
n
            FError String
err -> String -> m b
forall {a}. String -> a
eerror String
err

-------------------------------------------------------------------------------
-- Upgrade folds to parses
-------------------------------------------------------------------------------

-- | Make a 'Parser' from a 'Fold'. This parser sends all of its input to the
-- fold.
--
{-# INLINE fromFold #-}
fromFold :: Monad m => Fold m a b -> Parser a m b
fromFold :: forall (m :: * -> *) a b. Monad m => Fold m a b -> Parser a m b
fromFold (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) = (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 s -> m (Final s b)
forall {s}. s -> m (Final s b)
extract

    where

    initial :: m (Initial s b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        Initial s b -> m (Initial s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Initial s b -> m (Initial s b)) -> Initial s b -> m (Initial s b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
s1 -> s -> Initial s b
forall s b. s -> Initial s b
IPartial s
s1
                  FL.Done b
b -> b -> Initial s b
forall s b. b -> Initial s b
IDone b
b

    step :: s -> a -> m (Step s b)
step s
s a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        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
$ case Step s b
res of
                  FL.Partial s
s1 -> Int -> s -> Step s b
forall s b. Int -> s -> Step s b
SPartial Int
1 s
s1
                  FL.Done b
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b

    extract :: s -> m (Final s b)
extract = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> (s -> m b) -> s -> m (Final s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m b
ffinal

-- | Convert a Maybe returning fold to an error returning parser. The first
-- argument is the error message that the parser would return when the fold
-- returns Nothing.
--
-- /Pre-release/
--
{-# INLINE fromFoldMaybe #-}
fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser a m b
fromFoldMaybe :: forall (m :: * -> *) a b.
Monad m =>
String -> Fold m a (Maybe b) -> Parser a m b
fromFoldMaybe String
errMsg (Fold s -> a -> m (Step s (Maybe b))
fstep m (Step s (Maybe b))
finitial s -> m (Maybe b)
_ s -> m (Maybe b)
ffinal) =
    (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 s -> m (Final s b)
forall {s}. s -> m (Final s b)
extract

    where

    initial :: m (Initial s b)
initial = do
        Step s (Maybe b)
res <- m (Step s (Maybe b))
finitial
        Initial s b -> m (Initial s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Initial s b -> m (Initial s b)) -> Initial s b -> m (Initial s b)
forall a b. (a -> b) -> a -> b
$ case Step s (Maybe b)
res of
                  FL.Partial s
s1 -> s -> Initial s b
forall s b. s -> Initial s b
IPartial s
s1
                  FL.Done Maybe b
b ->
                        case Maybe b
b of
                            Just b
x -> b -> Initial s b
forall s b. b -> Initial s b
IDone b
x
                            Maybe b
Nothing -> String -> Initial s b
forall s b. String -> Initial s b
IError String
errMsg

    step :: s -> a -> m (Step s b)
step s
s a
a = do
        Step s (Maybe b)
res <- s -> a -> m (Step s (Maybe b))
fstep s
s a
a
        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
$ case Step s (Maybe b)
res of
                  FL.Partial s
s1 -> Int -> s -> Step s b
forall s b. Int -> s -> Step s b
SPartial Int
1 s
s1
                  FL.Done Maybe b
b ->
                        case Maybe b
b of
                            Just b
x -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
1 b
x
                            Maybe b
Nothing -> String -> Step s b
forall s b. String -> Step s b
SError String
errMsg

    extract :: s -> m (Final s b)
extract s
s = do
        Maybe b
res <- s -> m (Maybe b)
ffinal s
s
        case Maybe b
res of
            Just b
x -> Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final s b -> m (Final s b)) -> Final s b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0 b
x
            Maybe b
Nothing -> Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
errMsg

-------------------------------------------------------------------------------
-- Failing Parsers
-------------------------------------------------------------------------------

-- | Peek the head element of a stream, without consuming it. Fails if it
-- encounters end of input.
--
-- >>> Stream.parse ((,) <$> Parser.peek <*> Parser.satisfy (> 0)) $ Stream.fromList [1]
-- Right (1,1)
--
-- @
-- peek = lookAhead (satisfy True)
-- @
--
{-# INLINE peek #-}
peek :: Monad m => Parser a m a
peek :: forall (m :: * -> *) a. Monad m => Parser a m a
peek = (() -> a -> m (Step () a))
-> m (Initial () a) -> (() -> m (Final () a)) -> Parser a 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 () -> a -> m (Step () a)
forall {m :: * -> *} {b} {s}. Monad m => () -> b -> m (Step s b)
step m (Initial () a)
forall {b}. m (Initial () b)
initial () -> m (Final () a)
forall {m :: * -> *} {s} {b}. Monad m => () -> m (Final s b)
extract

    where

    initial :: m (Initial () b)
initial = Initial () b -> m (Initial () b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial () b -> m (Initial () b))
-> Initial () b -> m (Initial () b)
forall a b. (a -> b) -> a -> b
$ () -> Initial () b
forall s b. s -> Initial s b
IPartial ()

    step :: () -> b -> m (Step s b)
step () b
a = 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 -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
0 b
a

    extract :: () -> m (Final s b)
extract () = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
"peek: end of input"

-- | Succeeds if we are at the end of input, fails otherwise.
--
-- >>> Stream.parse ((,) <$> Parser.satisfy (> 0) <*> Parser.eof) $ Stream.fromList [1]
-- Right (1,())
--
{-# INLINE eof #-}
eof :: Monad m => Parser a m ()
eof :: forall (m :: * -> *) a. Monad m => Parser a m ()
eof = (() -> a -> m (Step () ()))
-> m (Initial () ()) -> (() -> m (Final () ())) -> Parser a m ()
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 () -> a -> m (Step () ())
forall {m :: * -> *} {p} {s} {b}.
Monad m =>
() -> p -> m (Step s b)
step m (Initial () ())
forall {b}. m (Initial () b)
initial () -> m (Final () ())
forall {m :: * -> *} {s}. Monad m => () -> m (Final s ())
extract

    where

    initial :: m (Initial () b)
initial = Initial () b -> m (Initial () b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial () b -> m (Initial () b))
-> Initial () b -> m (Initial () b)
forall a b. (a -> b) -> a -> b
$ () -> Initial () b
forall s b. s -> Initial s b
IPartial ()

    step :: () -> p -> m (Step s b)
step () p
_ = 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
$ String -> Step s b
forall s b. String -> Step s b
SError String
"eof: not at end of input"

    extract :: () -> m (Final s ())
extract () = Final s () -> m (Final s ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final s () -> m (Final s ())) -> Final s () -> m (Final s ())
forall a b. (a -> b) -> a -> b
$ Int -> () -> Final s ()
forall s b. Int -> b -> Final s b
FDone Int
0 ()

-- | Return the next element of the input. Returns 'Nothing'
-- on end of input. Also known as 'head'.
--
-- /Pre-release/
--
{-# DEPRECATED next "Please use \"fromFold Fold.one\" instead" #-}
{-# INLINE next #-}
next :: Monad m => Parser a m (Maybe a)
next :: forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
next = (() -> a -> m (Step () (Maybe a)))
-> m (Initial () (Maybe a))
-> (() -> m (Final () (Maybe a)))
-> Parser a m (Maybe 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 () -> a -> m (Step () (Maybe a))
forall {f :: * -> *} {a} {s}.
Applicative f =>
() -> a -> f (Step s (Maybe a))
step m (Initial () (Maybe a))
forall {b}. m (Initial () b)
initial () -> m (Final () (Maybe a))
forall {f :: * -> *} {s} {a}.
Applicative f =>
() -> f (Final s (Maybe a))
extract

  where

  initial :: m (Initial () b)
initial = Initial () b -> m (Initial () b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Initial () b -> m (Initial () b))
-> Initial () b -> m (Initial () b)
forall a b. (a -> b) -> a -> b
$ () -> Initial () b
forall s b. s -> Initial s b
IPartial ()

  step :: () -> a -> f (Step s (Maybe a))
step () a
a = Step s (Maybe a) -> f (Step s (Maybe a))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step s (Maybe a) -> f (Step s (Maybe a)))
-> Step s (Maybe a) -> f (Step s (Maybe a))
forall a b. (a -> b) -> a -> b
$ Int -> Maybe a -> Step s (Maybe a)
forall s b. Int -> b -> Step s b
SDone Int
1 (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

  extract :: () -> f (Final s (Maybe a))
extract () = Final s (Maybe a) -> f (Final s (Maybe a))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Final s (Maybe a) -> f (Final s (Maybe a)))
-> Final s (Maybe a) -> f (Final s (Maybe a))
forall a b. (a -> b) -> a -> b
$ Int -> Maybe a -> Final s (Maybe a)
forall s b. Int -> b -> Final s b
FDone Int
0 Maybe a
forall a. Maybe a
Nothing

-- | Map an 'Either' returning function on the next element in the stream.  If
-- the function returns 'Left err', the parser fails with the error message
-- @err@ otherwise returns the 'Right' value.
--
-- /Pre-release/
--
{-# INLINE either #-}
either :: Monad m => (a -> Either String b) -> Parser a m b
either :: forall (m :: * -> *) a b.
Monad m =>
(a -> Either String b) -> Parser a m b
either a -> Either String b
f = (() -> a -> m (Step () b))
-> m (Initial () b) -> (() -> m (Final () 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 () -> a -> m (Step () b)
forall {m :: * -> *} {s}. Monad m => () -> a -> m (Step s b)
step m (Initial () b)
forall {b}. m (Initial () b)
initial () -> m (Final () b)
forall {m :: * -> *} {s} {b}. Monad m => () -> m (Final s b)
extract

    where

    initial :: m (Initial () b)
initial = Initial () b -> m (Initial () b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial () b -> m (Initial () b))
-> Initial () b -> m (Initial () b)
forall a b. (a -> b) -> a -> b
$ () -> Initial () b
forall s b. s -> Initial s b
IPartial ()

    step :: () -> a -> m (Step s b)
step () a
a = 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
$
        case a -> Either String b
f a
a of
            Right b
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b
            Left String
err -> String -> Step s b
forall s b. String -> Step s b
SError String
err

    extract :: () -> m (Final s b)
extract () = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
"end of input"

-- | Map a 'Maybe' returning function on the next element in the stream. The
-- parser fails if the function returns 'Nothing' otherwise returns the 'Just'
-- value.
--
-- >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right
-- >>> maybe f = Parser.either (toEither . f)
--
-- >>> maybe f = Parser.fromFoldMaybe "maybe: predicate failed" (Fold.maybe f)
--
-- /Pre-release/
--
{-# INLINE maybe #-}
maybe :: Monad m => (a -> Maybe b) -> Parser a m b
-- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)
maybe :: forall (m :: * -> *) a b. Monad m => (a -> Maybe b) -> Parser a m b
maybe a -> Maybe b
parserF = (() -> a -> m (Step () b))
-> m (Initial () b) -> (() -> m (Final () 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 () -> a -> m (Step () b)
forall {m :: * -> *} {s}. Monad m => () -> a -> m (Step s b)
step m (Initial () b)
forall {b}. m (Initial () b)
initial () -> m (Final () b)
forall {m :: * -> *} {s} {b}. Monad m => () -> m (Final s b)
extract

    where

    initial :: m (Initial () b)
initial = Initial () b -> m (Initial () b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial () b -> m (Initial () b))
-> Initial () b -> m (Initial () b)
forall a b. (a -> b) -> a -> b
$ () -> Initial () b
forall s b. s -> Initial s b
IPartial ()

    step :: () -> a -> m (Step s b)
step () a
a = 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
$
        case a -> Maybe b
parserF a
a of
            Just b
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b
            Maybe b
Nothing -> String -> Step s b
forall s b. String -> Step s b
SError String
"maybe: predicate failed"

    extract :: () -> m (Final s b)
extract () = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
"maybe: end of input"

-- | Returns the next element if it passes the predicate, fails otherwise.
--
-- >>> Stream.parse (Parser.satisfy (== 1)) $ Stream.fromList [1,0,1]
-- Right 1
--
-- >>> toMaybe f x = if f x then Just x else Nothing
-- >>> satisfy f = Parser.maybe (toMaybe f)
--
{-# INLINE satisfy #-}
satisfy :: Monad m => (a -> Bool) -> Parser a m a
-- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)
satisfy :: forall (m :: * -> *) a. Monad m => (a -> Bool) -> Parser a m a
satisfy a -> Bool
predicate = (() -> a -> m (Step () a))
-> m (Initial () a) -> (() -> m (Final () a)) -> Parser a 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 () -> a -> m (Step () a)
forall {m :: * -> *} {s}. Monad m => () -> a -> m (Step s a)
step m (Initial () a)
forall {b}. m (Initial () b)
initial () -> m (Final () a)
forall {m :: * -> *} {s} {b}. Monad m => () -> m (Final s b)
extract

    where

    initial :: m (Initial () b)
initial = Initial () b -> m (Initial () b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial () b -> m (Initial () b))
-> Initial () b -> m (Initial () b)
forall a b. (a -> b) -> a -> b
$ () -> Initial () b
forall s b. s -> Initial s b
IPartial ()

    step :: () -> a -> m (Step s a)
step () a
a = Step s a -> m (Step s a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s a -> m (Step s a)) -> Step s a -> m (Step s a)
forall a b. (a -> b) -> a -> b
$
        if a -> Bool
predicate a
a
        then Int -> a -> Step s a
forall s b. Int -> b -> Step s b
SDone Int
1 a
a
        else String -> Step s a
forall s b. String -> Step s b
SError String
"satisfy: predicate failed"

    extract :: () -> m (Final s b)
extract () = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
"satisfy: end of input"

-- | Consume one element from the head of the stream.  Fails if it encounters
-- end of input.
--
-- >>> one = Parser.satisfy $ const True
--
{-# INLINE one #-}
one :: Monad m => Parser a m a
one :: forall (m :: * -> *) a. Monad m => Parser a m a
one = (a -> Bool) -> Parser a m a
forall (m :: * -> *) a. Monad m => (a -> Bool) -> Parser a m a
satisfy ((a -> Bool) -> Parser a m a) -> (a -> Bool) -> Parser a m a
forall a b. (a -> b) -> a -> b
$ Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True

-- Alternate names: "only", "onlyThis".

-- | Match a specific element.
--
-- >>> oneEq x = Parser.satisfy (== x)
--
{-# INLINE oneEq #-}
oneEq :: (Monad m, Eq a) => a -> Parser a m a
oneEq :: forall (m :: * -> *) a. (Monad m, Eq a) => a -> Parser a m a
oneEq a
x = (a -> Bool) -> Parser a m a
forall (m :: * -> *) a. Monad m => (a -> Bool) -> Parser a m a
satisfy (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x)

-- Alternate names: "exclude", "notThis".

-- | Match anything other than the supplied element.
--
-- >>> oneNotEq x = Parser.satisfy (/= x)
--
{-# INLINE oneNotEq #-}
oneNotEq :: (Monad m, Eq a) => a -> Parser a m a
oneNotEq :: forall (m :: * -> *) a. (Monad m, Eq a) => a -> Parser a m a
oneNotEq a
x = (a -> Bool) -> Parser a m a
forall (m :: * -> *) a. Monad m => (a -> Bool) -> Parser a m a
satisfy (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x)

-- | Match any one of the elements in the supplied list.
--
-- >>> oneOf xs = Parser.satisfy (`Foldable.elem` xs)
--
-- When performance matters a pattern matching predicate could be more
-- efficient than a 'Foldable' datatype:
--
-- @
-- let p x =
--    case x of
--       'a' -> True
--       'e' -> True
--        _  -> False
-- in satisfy p
-- @
--
-- GHC may use a binary search instead of linear search in the list.
-- Alternatively, you can also use an array instead of list for storage and
-- search.
--
{-# INLINE oneOf #-}
oneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a
oneOf :: forall (m :: * -> *) a (f :: * -> *).
(Monad m, Eq a, Foldable f) =>
f a -> Parser a m a
oneOf f a
xs = (a -> Bool) -> Parser a m a
forall (m :: * -> *) a. Monad m => (a -> Bool) -> Parser a m a
satisfy (a -> f a -> Bool
forall a. Eq a => a -> f a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Foldable.elem` f a
xs)

-- | See performance notes in 'oneOf'.
--
-- >>> noneOf xs = Parser.satisfy (`Foldable.notElem` xs)
--
{-# INLINE noneOf #-}
noneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a
noneOf :: forall (m :: * -> *) a (f :: * -> *).
(Monad m, Eq a, Foldable f) =>
f a -> Parser a m a
noneOf f a
xs = (a -> Bool) -> Parser a m a
forall (m :: * -> *) a. Monad m => (a -> Bool) -> Parser a m a
satisfy (a -> f a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Foldable.notElem` f a
xs)

-------------------------------------------------------------------------------
-- Taking elements
-------------------------------------------------------------------------------

-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
{-# ANN type Tuple'Fused Fuse #-}
data Tuple'Fused a b = Tuple'Fused !a !b deriving Int -> Tuple'Fused a b -> String -> String
[Tuple'Fused a b] -> String -> String
Tuple'Fused a b -> String
(Int -> Tuple'Fused a b -> String -> String)
-> (Tuple'Fused a b -> String)
-> ([Tuple'Fused a b] -> String -> String)
-> Show (Tuple'Fused a b)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall a b.
(Show a, Show b) =>
Int -> Tuple'Fused a b -> String -> String
forall a b.
(Show a, Show b) =>
[Tuple'Fused a b] -> String -> String
forall a b. (Show a, Show b) => Tuple'Fused a b -> String
$cshowsPrec :: forall a b.
(Show a, Show b) =>
Int -> Tuple'Fused a b -> String -> String
showsPrec :: Int -> Tuple'Fused a b -> String -> String
$cshow :: forall a b. (Show a, Show b) => Tuple'Fused a b -> String
show :: Tuple'Fused a b -> String
$cshowList :: forall a b.
(Show a, Show b) =>
[Tuple'Fused a b] -> String -> String
showList :: [Tuple'Fused a b] -> String -> String
Show

-- | @takeBetween m n@ takes a minimum of @m@ and a maximum of @n@ input
-- elements and folds them using the supplied fold.
--
-- Stops after @n@ elements.
-- Fails if the stream ends before @m@ elements could be taken.
--
-- Examples: -
--
-- @
-- >>> :{
--   takeBetween' low high ls = Stream.parsePos prsr (Stream.fromList ls)
--     where prsr = Parser.takeBetween low high Fold.toList
-- :}
--
-- @
--
-- >>> takeBetween' 2 4 [1, 2, 3, 4, 5]
-- Right [1,2,3,4]
--
-- >>> takeBetween' 2 4 [1, 2]
-- Right [1,2]
--
-- >>> takeBetween' 2 4 [1]
-- Left (ParseErrorPos 1 "takeBetween: Expecting alteast 2 elements, got 1")
--
-- >>> takeBetween' 0 0 [1, 2]
-- Right []
--
-- >>> takeBetween' 0 1 []
-- Right []
--
-- @takeBetween@ is the most general take operation, other take operations can
-- be defined in terms of takeBetween. For example:
--
-- >>> take n = Parser.takeBetween 0 n
-- >>> takeEQ n = Parser.takeBetween n n
-- >>> takeGE n = Parser.takeBetween n maxBound
--
-- /Pre-release/
--
{-# INLINE takeBetween #-}
takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser a m b
takeBetween :: forall (m :: * -> *) a b.
Monad m =>
Int -> Int -> Fold m a b -> Parser a m b
takeBetween Int
low Int
high (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) =

    (Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b))
-> m (Initial (Tuple'Fused Int s) b)
-> (Tuple'Fused Int s -> m (Final (Tuple'Fused Int 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 Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b)
step m (Initial (Tuple'Fused Int s) b)
initial ((Int -> String)
-> Tuple'Fused Int s -> m (Final (Tuple'Fused Int s) b)
forall {s}. (Int -> String) -> Tuple'Fused Int s -> m (Final s b)
extract Int -> String
forall a. Show a => a -> String
streamErr)

    where

    streamErr :: a -> String
streamErr a
i =
           String
"takeBetween: Expecting alteast " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
low
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i

    invalidRange :: String
invalidRange =
        String
"takeBetween: lower bound - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
low
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is greater than higher bound - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
high

    foldErr :: Int -> String
    foldErr :: Int -> String
foldErr Int
i =
        String
"takeBetween: the collecting fold terminated after"
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" consuming" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements"
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" minimum" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
low String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements needed"

    -- Exactly the same as snext except different constructors, we can possibly
    -- deduplicate the two.
    {-# INLINE inext #-}
    inext :: Int -> Step s b -> m (Initial (Tuple'Fused Int s) b)
inext Int
i Step s b
res =
        let i1 :: Int
i1 = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        in case Step s b
res of
            FL.Partial s
s -> do
                let s1 :: Tuple'Fused Int s
s1 = Int -> s -> Tuple'Fused Int s
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused Int
i1 s
s
                if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
high
                -- XXX ideally this should be a Continue instead
                then Initial (Tuple'Fused Int s) b -> m (Initial (Tuple'Fused Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple'Fused Int s) b
 -> m (Initial (Tuple'Fused Int s) b))
-> Initial (Tuple'Fused Int s) b
-> m (Initial (Tuple'Fused Int s) b)
forall a b. (a -> b) -> a -> b
$ Tuple'Fused Int s -> Initial (Tuple'Fused Int s) b
forall s b. s -> Initial s b
IPartial Tuple'Fused Int s
s1
                else (Int -> String)
-> Tuple'Fused Int s -> m (Initial (Tuple'Fused Int s) b)
forall {s}. (Int -> String) -> Tuple'Fused Int s -> m (Initial s b)
iextract Int -> String
foldErr Tuple'Fused Int s
s1
            FL.Done b
b ->
                Initial (Tuple'Fused Int s) b -> m (Initial (Tuple'Fused Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Initial (Tuple'Fused Int s) b
 -> m (Initial (Tuple'Fused Int s) b))
-> Initial (Tuple'Fused Int s) b
-> m (Initial (Tuple'Fused Int s) b)
forall a b. (a -> b) -> a -> b
$ if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
low
                      then b -> Initial (Tuple'Fused Int s) b
forall s b. b -> Initial s b
IDone b
b
                      else String -> Initial (Tuple'Fused Int s) b
forall s b. String -> Initial s b
IError (Int -> String
foldErr Int
i1)

    -- In the case of Identity monad
    -- @
    -- when True (error invalidRange)
    -- @
    -- does not evaluate the @error invalidRange@ due to which no error occurs.
    initial :: m (Initial (Tuple'Fused Int s) b)
initial =
        if Int
low Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
high Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
low Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
high
        then String -> m (Initial (Tuple'Fused Int s) b)
forall a. HasCallStack => String -> a
error String
invalidRange
        else m (Step s b)
finitial m (Step s b)
-> (Step s b -> m (Initial (Tuple'Fused Int s) b))
-> m (Initial (Tuple'Fused Int s) b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Step s b -> m (Initial (Tuple'Fused Int s) b)
inext (-Int
1)

    -- Keep the impl same as inext
    {-# INLINE snext #-}
    snext :: Int -> Step s b -> m (Step (Tuple'Fused Int s) b)
snext Int
i Step s b
res =
        let i1 :: Int
i1 = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        in case Step s b
res of
            FL.Partial s
s -> do
                let s1 :: Tuple'Fused Int s
s1 = Int -> s -> Tuple'Fused Int s
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused Int
i1 s
s
                if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
low
                then Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b))
-> Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple'Fused Int s -> Step (Tuple'Fused Int s) b
forall s b. Int -> s -> Step s b
SContinue Int
1 Tuple'Fused Int s
s1
                else if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
high
                then Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b))
-> Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple'Fused Int s -> Step (Tuple'Fused Int s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 Tuple'Fused Int s
s1
                else (b -> Step (Tuple'Fused Int s) b)
-> m b -> m (Step (Tuple'Fused Int 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 -> b -> Step (Tuple'Fused Int s) b
forall s b. Int -> b -> Step s b
SDone Int
1) (s -> m b
ffinal s
s)
            FL.Done b
b ->
                Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b))
-> Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall a b. (a -> b) -> a -> b
$ if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
low
                      then Int -> b -> Step (Tuple'Fused Int s) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b
                      else String -> Step (Tuple'Fused Int s) b
forall s b. String -> Step s b
SError (Int -> String
foldErr Int
i1)

    step :: Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b)
step (Tuple'Fused Int
i s
s) a
a = s -> a -> m (Step s b)
fstep s
s a
a m (Step s b)
-> (Step s b -> m (Step (Tuple'Fused Int s) b))
-> m (Step (Tuple'Fused Int s) b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Step s b -> m (Step (Tuple'Fused Int s) b)
snext Int
i

    extract :: (Int -> String) -> Tuple'Fused Int s -> m (Final s b)
extract Int -> String
f (Tuple'Fused Int
i s
s)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
low Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
high = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (s -> m b
ffinal s
s)
        | Bool
otherwise = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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 (Int -> String
f Int
i)

    -- XXX Need to make Initial return type Step to deduplicate this
    iextract :: (Int -> String) -> Tuple'Fused Int s -> m (Initial s b)
iextract Int -> String
f (Tuple'Fused Int
i s
s)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
low Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
high = (b -> Initial s b) -> m b -> m (Initial s b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Initial s b
forall s b. b -> Initial s b
IDone (s -> m b
ffinal s
s)
        | Bool
otherwise = Initial s b -> m (Initial s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial s b -> m (Initial s b)) -> Initial s b -> m (Initial s b)
forall a b. (a -> b) -> a -> b
$ String -> Initial s b
forall s b. String -> Initial s b
IError (Int -> String
f Int
i)

-- | Stops after taking exactly @n@ input elements.
--
-- * Stops - after consuming @n@ elements.
-- * Fails - if the stream or the collecting fold ends before it can collect
--           exactly @n@ elements.
--
-- >>> Stream.parsePos (Parser.takeEQ 2 Fold.toList) $ Stream.fromList [1,0,1]
-- Right [1,0]
--
-- >>> Stream.parsePos (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1]
-- Left (ParseErrorPos 3 "takeEQ: Expecting exactly 4 elements, input terminated on 3")
--
{-# INLINE takeEQ #-}
takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b
takeEQ :: forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Parser a m b
takeEQ Int
n (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) = (Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b))
-> m (Initial (Tuple'Fused Int s) b)
-> (Tuple'Fused Int s -> m (Final (Tuple'Fused Int 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 Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b)
step m (Initial (Tuple'Fused Int s) b)
initial Tuple'Fused Int s -> m (Final (Tuple'Fused Int s) b)
forall {m :: * -> *} {a} {b} {s} {b}.
(Monad m, Show a, Num a) =>
Tuple'Fused a b -> m (Final s b)
extract

    where

    initial :: m (Initial (Tuple'Fused Int s) b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        case Step s b
res of
            FL.Partial s
s ->
                if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                then Initial (Tuple'Fused Int s) b -> m (Initial (Tuple'Fused Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple'Fused Int s) b
 -> m (Initial (Tuple'Fused Int s) b))
-> Initial (Tuple'Fused Int s) b
-> m (Initial (Tuple'Fused Int s) b)
forall a b. (a -> b) -> a -> b
$ Tuple'Fused Int s -> Initial (Tuple'Fused Int s) b
forall s b. s -> Initial s b
IPartial (Tuple'Fused Int s -> Initial (Tuple'Fused Int s) b)
-> Tuple'Fused Int s -> Initial (Tuple'Fused Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple'Fused Int s
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused Int
1 s
s
                else (b -> Initial (Tuple'Fused Int s) b)
-> m b -> m (Initial (Tuple'Fused Int s) b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Initial (Tuple'Fused Int s) b
forall s b. b -> Initial s b
IDone (s -> m b
ffinal s
s)
            FL.Done b
b -> Initial (Tuple'Fused Int s) b -> m (Initial (Tuple'Fused Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple'Fused Int s) b
 -> m (Initial (Tuple'Fused Int s) b))
-> Initial (Tuple'Fused Int s) b
-> m (Initial (Tuple'Fused Int s) b)
forall a b. (a -> b) -> a -> b
$
                if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                then String -> Initial (Tuple'Fused Int s) b
forall s b. String -> Initial s b
IError
                         (String -> Initial (Tuple'Fused Int s) b)
-> String -> Initial (Tuple'Fused Int s) b
forall a b. (a -> b) -> a -> b
$ String
"takeEQ: Expecting exactly " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, fold terminated without"
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" consuming any elements"
                else b -> Initial (Tuple'Fused Int s) b
forall s b. b -> Initial s b
IDone b
b

    step :: Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b)
step (Tuple'Fused Int
i1 s
r) a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
r a
a
        if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i1
        then
            Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                (Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b))
-> Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                    FL.Partial s
s -> Int -> Tuple'Fused Int s -> Step (Tuple'Fused Int s) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (Tuple'Fused Int s -> Step (Tuple'Fused Int s) b)
-> Tuple'Fused Int s -> Step (Tuple'Fused Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple'Fused Int s
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused (Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) s
s
                    FL.Done b
_ ->
                        String -> Step (Tuple'Fused Int s) b
forall s b. String -> Step s b
SError
                            (String -> Step (Tuple'Fused Int s) b)
-> String -> Step (Tuple'Fused Int s) b
forall a b. (a -> b) -> a -> b
$ String
"takeEQ: Expecting exactly " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, fold terminated on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i1
        else
            -- assert (n == i1)
            Int -> b -> Step (Tuple'Fused Int s) b
forall s b. Int -> b -> Step s b
SDone Int
1
                (b -> Step (Tuple'Fused Int s) b)
-> m b -> m (Step (Tuple'Fused Int s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Step s b
res of
                        FL.Partial s
s -> s -> m b
ffinal s
s
                        FL.Done b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

    extract :: Tuple'Fused a b -> m (Final s b)
extract (Tuple'Fused a
i b
_) =
        -- Using the count "i" in the message below causes large performance
        -- regression unless we use Fuse annotation on Tuple.
        Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (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 -> Final s b) -> String -> Final s b
forall a b. (a -> b) -> a -> b
$ String
"takeEQ: Expecting exactly " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, input terminated on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (a
i a -> a -> a
forall a. Num a => a -> a -> a
- a
1)

{-# ANN type TakeGEState Fuse #-}
data TakeGEState s =
      TakeGELT !Int !s
    | TakeGEGE !s

-- | Take at least @n@ input elements, but can collect more.
--
-- * Stops - when the collecting fold stops.
-- * Fails - if the stream or the collecting fold ends before producing @n@
--           elements.
--
-- >>> Stream.parsePos (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1]
-- Left (ParseErrorPos 3 "takeGE: Expecting at least 4 elements, input terminated on 3")
--
-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1,0,1]
-- Right [1,0,1,0,1]
--
-- /Pre-release/
--
{-# INLINE takeGE #-}
takeGE :: Monad m => Int -> Fold m a b -> Parser a m b
takeGE :: forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Parser a m b
takeGE Int
n (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) = (TakeGEState s -> a -> m (Step (TakeGEState s) b))
-> m (Initial (TakeGEState s) b)
-> (TakeGEState s -> m (Final (TakeGEState 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 TakeGEState s -> a -> m (Step (TakeGEState s) b)
step m (Initial (TakeGEState s) b)
initial TakeGEState s -> m (Final (TakeGEState s) b)
forall {s}. TakeGEState s -> m (Final s b)
extract

    where

    initial :: m (Initial (TakeGEState s) b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        case Step s b
res of
            FL.Partial s
s ->
                if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                then Initial (TakeGEState s) b -> m (Initial (TakeGEState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (TakeGEState s) b -> m (Initial (TakeGEState s) b))
-> Initial (TakeGEState s) b -> m (Initial (TakeGEState s) b)
forall a b. (a -> b) -> a -> b
$ TakeGEState s -> Initial (TakeGEState s) b
forall s b. s -> Initial s b
IPartial (TakeGEState s -> Initial (TakeGEState s) b)
-> TakeGEState s -> Initial (TakeGEState s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> TakeGEState s
forall s. Int -> s -> TakeGEState s
TakeGELT Int
1 s
s
                else Initial (TakeGEState s) b -> m (Initial (TakeGEState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (TakeGEState s) b -> m (Initial (TakeGEState s) b))
-> Initial (TakeGEState s) b -> m (Initial (TakeGEState s) b)
forall a b. (a -> b) -> a -> b
$ TakeGEState s -> Initial (TakeGEState s) b
forall s b. s -> Initial s b
IPartial (TakeGEState s -> Initial (TakeGEState s) b)
-> TakeGEState s -> Initial (TakeGEState s) b
forall a b. (a -> b) -> a -> b
$ s -> TakeGEState s
forall s. s -> TakeGEState s
TakeGEGE s
s
            FL.Done b
b -> Initial (TakeGEState s) b -> m (Initial (TakeGEState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (TakeGEState s) b -> m (Initial (TakeGEState s) b))
-> Initial (TakeGEState s) b -> m (Initial (TakeGEState s) b)
forall a b. (a -> b) -> a -> b
$
                if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                then String -> Initial (TakeGEState s) b
forall s b. String -> Initial s b
IError
                         (String -> Initial (TakeGEState s) b)
-> String -> Initial (TakeGEState s) b
forall a b. (a -> b) -> a -> b
$ String
"takeGE: Expecting at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, fold terminated without"
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" consuming any elements"
                else b -> Initial (TakeGEState s) b
forall s b. b -> Initial s b
IDone b
b

    step :: TakeGEState s -> a -> m (Step (TakeGEState s) b)
step (TakeGELT Int
i1 s
r) a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
r a
a
        if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i1
        then
            Step (TakeGEState s) b -> m (Step (TakeGEState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                (Step (TakeGEState s) b -> m (Step (TakeGEState s) b))
-> Step (TakeGEState s) b -> m (Step (TakeGEState s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                      FL.Partial s
s -> Int -> TakeGEState s -> Step (TakeGEState s) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (TakeGEState s -> Step (TakeGEState s) b)
-> TakeGEState s -> Step (TakeGEState s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> TakeGEState s
forall s. Int -> s -> TakeGEState s
TakeGELT (Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) s
s
                      FL.Done b
_ ->
                        String -> Step (TakeGEState s) b
forall s b. String -> Step s b
SError
                            (String -> Step (TakeGEState s) b)
-> String -> Step (TakeGEState s) b
forall a b. (a -> b) -> a -> b
$ String
"takeGE: Expecting at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, fold terminated on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i1
        else
            -- assert (n <= i1)
            Step (TakeGEState s) b -> m (Step (TakeGEState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                (Step (TakeGEState s) b -> m (Step (TakeGEState s) b))
-> Step (TakeGEState s) b -> m (Step (TakeGEState s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                      FL.Partial s
s -> Int -> TakeGEState s -> Step (TakeGEState s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (TakeGEState s -> Step (TakeGEState s) b)
-> TakeGEState s -> Step (TakeGEState s) b
forall a b. (a -> b) -> a -> b
$ s -> TakeGEState s
forall s. s -> TakeGEState s
TakeGEGE s
s
                      FL.Done b
b -> Int -> b -> Step (TakeGEState s) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b
    step (TakeGEGE s
r) a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
r a
a
        Step (TakeGEState s) b -> m (Step (TakeGEState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (TakeGEState s) b -> m (Step (TakeGEState s) b))
-> Step (TakeGEState s) b -> m (Step (TakeGEState s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
s -> Int -> TakeGEState s -> Step (TakeGEState s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (TakeGEState s -> Step (TakeGEState s) b)
-> TakeGEState s -> Step (TakeGEState s) b
forall a b. (a -> b) -> a -> b
$ s -> TakeGEState s
forall s. s -> TakeGEState s
TakeGEGE s
s
                  FL.Done b
b -> Int -> b -> Step (TakeGEState s) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b

    extract :: TakeGEState s -> m (Final s b)
extract (TakeGELT Int
i s
_) =
        Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (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 -> Final s b) -> String -> Final s b
forall a b. (a -> b) -> a -> b
$ String
"takeGE: Expecting at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, input terminated on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    extract (TakeGEGE s
r) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
r

-------------------------------------------------------------------------------
-- Conditional splitting
-------------------------------------------------------------------------------

-- XXX We should perhaps use only takeWhileP and rename it to takeWhile.

-- | Like 'takeWhile' but uses a 'Parser' instead of a 'Fold' to collect the
-- input. The combinator stops when the condition fails or if the collecting
-- parser stops.
--
-- Other interesting parsers can be implemented in terms of this parser:
--
-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)
-- >>> takeWhileBetween cond m n p = Parser.takeWhileP cond (Parser.takeBetween m n p)
--
-- Stops: when the condition fails or the collecting parser stops.
-- Fails: when the collecting parser fails.
--
-- /Pre-release/
--
{-# INLINE takeWhileP #-}
takeWhileP :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
takeWhileP :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Parser a m b -> Parser a m b
takeWhileP a -> Bool
predicate (Parser s -> a -> m (Step s b)
pstep m (Initial s b)
pinitial s -> m (Final s b)
pextract) =
    (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)
pinitial s -> m (Final s b)
pextract

    where

    step :: s -> a -> m (Step s b)
step s
s a
a =
        if a -> Bool
predicate a
a
        then s -> a -> m (Step s b)
pstep s
s a
a
        else do
            -- In this case when converting Final to Step we don't add 1 as we
            -- don't consume the current element.
            Final s b
r <- s -> m (Final s b)
pextract s
s
            case Final s b
r of
                FError String
err -> 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
$ String -> Step s b
forall s b. String -> Step s b
SError String
err
                FDone Int
n b
s1 -> 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 -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
n b
s1
                FContinue Int
n s
s1 -> 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
SContinue Int
n s
s1

-- | Collect stream elements until an element fails the predicate. The element
-- on which the predicate fails is returned back to the input stream.
--
-- * Stops - when the predicate fails or the collecting fold stops.
-- * Fails - never.
--
-- >>> Stream.parse (Parser.takeWhile (== 0) Fold.toList) $ Stream.fromList [0,0,1,0,1]
-- Right [0,0]
--
-- >>> takeWhile cond f = Parser.takeWhileP cond (Parser.fromFold f)
--
-- We can implement a @breakOn@ using 'takeWhile':
--
-- @
-- breakOn p = takeWhile (not p)
-- @
--
{-# INLINE takeWhile #-}
takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
-- takeWhile cond f = takeWhileP cond (fromFold f)
takeWhile :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Parser a m b
takeWhile a -> Bool
predicate (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) =
    (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 s -> m (Final s b)
forall {s}. s -> m (Final s b)
extract

    where

    initial :: m (Initial s b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        Initial s b -> m (Initial s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial s b -> m (Initial s b)) -> Initial s b -> m (Initial s b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
            FL.Partial s
s -> s -> Initial s b
forall s b. s -> Initial s b
IPartial s
s
            FL.Done b
b -> b -> Initial s b
forall s b. b -> Initial s b
IDone b
b

    step :: s -> a -> m (Step s b)
step s
s a
a =
        if a -> Bool
predicate a
a
        then do
            Step s b
fres <- s -> a -> m (Step s b)
fstep s
s a
a
            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
$ case Step s b
fres of
                      FL.Partial s
s1 -> Int -> s -> Step s b
forall s b. Int -> s -> Step s b
SPartial Int
1 s
s1
                      FL.Done b
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b
        else Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
0 (b -> Step s b) -> m b -> m (Step s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s

    extract :: s -> m (Final s b)
extract s
s = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (s -> m b
ffinal s
s)

{-
-- XXX This may not be composable because of the b argument. We can instead
-- return a "Reparse b a m b" so that those can be composed.
{-# INLINE takeWhile1X #-}
takeWhile1 :: Monad m => b -> (a -> Bool) -> Refold m b a b -> Parser a m b
-- We can implement this using satisfy and takeWhile. We can use "satisfy
-- p", fold the result with the refold and then use the "takeWhile p" and
-- fold that using the refold.
takeWhile1 acc cond f = undefined
-}

-- | Like 'takeWhile' but takes at least one element otherwise fails.
--
-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)
--
{-# INLINE takeWhile1 #-}
takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
-- takeWhile1 cond f = takeWhileP cond (takeBetween 1 maxBound f)
takeWhile1 :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Parser a m b
takeWhile1 a -> Bool
predicate (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) =
    (Either' s s -> a -> m (Step (Either' s s) b))
-> m (Initial (Either' s s) b)
-> (Either' s s -> m (Final (Either' s 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 Either' s s -> a -> m (Step (Either' s s) b)
forall {a}. Either' s s -> a -> m (Step (Either' a s) b)
step m (Initial (Either' s s) b)
forall {b} {b}. m (Initial (Either' s b) b)
initial Either' s s -> m (Final (Either' s s) b)
forall {a} {s}. Either' a s -> m (Final s b)
extract

    where

    initial :: m (Initial (Either' s b) b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        Initial (Either' s b) b -> m (Initial (Either' s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Either' s b) b -> m (Initial (Either' s b) b))
-> Initial (Either' s b) b -> m (Initial (Either' s b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
            FL.Partial s
s -> Either' s b -> Initial (Either' s b) b
forall s b. s -> Initial s b
IPartial (s -> Either' s b
forall a b. a -> Either' a b
Left' s
s)
            FL.Done b
_ ->
                String -> Initial (Either' s b) b
forall s b. String -> Initial s b
IError
                    (String -> Initial (Either' s b) b)
-> String -> Initial (Either' s b) b
forall a b. (a -> b) -> a -> b
$ String
"takeWhile1: fold terminated without consuming:"
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" any element"

    {-# INLINE process #-}
    process :: s -> a -> m (Step (Either' a s) b)
process s
s a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        Step (Either' a s) b -> m (Step (Either' a s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (Either' a s) b -> m (Step (Either' a s) b))
-> Step (Either' a s) b -> m (Step (Either' a s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
s1 -> Int -> Either' a s -> Step (Either' a s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (s -> Either' a s
forall a b. b -> Either' a b
Right' s
s1)
                  FL.Done b
b -> Int -> b -> Step (Either' a s) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b

    step :: Either' s s -> a -> m (Step (Either' a s) b)
step (Left' s
s) a
a =
        if a -> Bool
predicate a
a
        then s -> a -> m (Step (Either' a s) b)
forall {a}. s -> a -> m (Step (Either' a s) b)
process s
s a
a
        else Step (Either' a s) b -> m (Step (Either' a s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either' a s) b -> m (Step (Either' a s) b))
-> Step (Either' a s) b -> m (Step (Either' a s) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (Either' a s) b
forall s b. String -> Step s b
SError String
"takeWhile1: predicate failed on first element"
    step (Right' s
s) a
a =
        if a -> Bool
predicate a
a
        then s -> a -> m (Step (Either' a s) b)
forall {a}. s -> a -> m (Step (Either' a s) b)
process s
s a
a
        else do
            b
b <- s -> m b
ffinal s
s
            Step (Either' a s) b -> m (Step (Either' a s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either' a s) b -> m (Step (Either' a s) b))
-> Step (Either' a s) b -> m (Step (Either' a s) b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step (Either' a s) b
forall s b. Int -> b -> Step s b
SDone Int
0 b
b

    extract :: Either' a s -> m (Final s b)
extract (Left' a
_) = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
"takeWhile1: end of input"
    extract (Right' s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (s -> m b
ffinal s
s)

-- | Drain the input as long as the predicate succeeds, running the effects and
-- discarding the results.
--
-- This is also called @skipWhile@ in some parsing libraries.
--
-- >>> dropWhile p = Parser.takeWhile p Fold.drain
--
{-# INLINE dropWhile #-}
dropWhile :: Monad m => (a -> Bool) -> Parser a m ()
dropWhile :: forall (m :: * -> *) a. Monad m => (a -> Bool) -> Parser a m ()
dropWhile a -> Bool
p = (a -> Bool) -> Fold m a () -> Parser a m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Parser a m b
takeWhile a -> Bool
p Fold m a ()
forall (m :: * -> *) a. Monad m => Fold m a ()
FL.drain

-------------------------------------------------------------------------------
-- Separators
-------------------------------------------------------------------------------

{-# ANN type FramedEscState Fuse #-}
data FramedEscState s =
    FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int

-- XXX We can remove Maybe from esc
{-# INLINE takeFramedByGeneric #-}
takeFramedByGeneric :: Monad m =>
       Maybe (a -> Bool) -- is escape char?
    -> Maybe (a -> Bool) -- is frame begin?
    -> Maybe (a -> Bool) -- is frame end?
    -> Fold m a b
    -> Parser a m b
takeFramedByGeneric :: forall (m :: * -> *) a b.
Monad m =>
Maybe (a -> Bool)
-> Maybe (a -> Bool)
-> Maybe (a -> Bool)
-> Fold m a b
-> Parser a m b
takeFramedByGeneric Maybe (a -> Bool)
esc Maybe (a -> Bool)
begin Maybe (a -> Bool)
end (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) =

    (FramedEscState s -> a -> m (Step (FramedEscState s) b))
-> m (Initial (FramedEscState s) b)
-> (FramedEscState s -> m (Final (FramedEscState 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 FramedEscState s -> a -> m (Step (FramedEscState s) b)
step m (Initial (FramedEscState s) b)
forall {b}. m (Initial (FramedEscState s) b)
initial FramedEscState s -> m (Final (FramedEscState s) b)
forall {s}. FramedEscState s -> m (Final s b)
extract

    where

    initial :: m (Initial (FramedEscState s) b)
initial =  do
        Step s b
res <- m (Step s b)
finitial
        Initial (FramedEscState s) b -> m (Initial (FramedEscState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (FramedEscState s) b -> m (Initial (FramedEscState s) b))
-> Initial (FramedEscState s) b -> m (Initial (FramedEscState s) b)
forall a b. (a -> b) -> a -> b
$
            case Step s b
res of
                FL.Partial s
s -> FramedEscState s -> Initial (FramedEscState s) b
forall s b. s -> Initial s b
IPartial (s -> FramedEscState s
forall s. s -> FramedEscState s
FrameEscInit s
s)
                FL.Done b
_ ->
                    String -> Initial (FramedEscState s) b
forall a. HasCallStack => String -> a
error String
"takeFramedByGeneric: fold done without input"

    {-# INLINE process #-}
    process :: s -> a -> Int -> m (Step (FramedEscState s) b)
process s
s a
a Int
n = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (FramedEscState s) b -> m (Step (FramedEscState s) b))
-> Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                FL.Partial s
s1 -> Int -> FramedEscState s -> Step (FramedEscState s) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (s -> Int -> FramedEscState s
forall s. s -> Int -> FramedEscState s
FrameEscGo s
s1 Int
n)
                FL.Done b
b -> Int -> b -> Step (FramedEscState s) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b

    {-# INLINE processNoEsc #-}
    processNoEsc :: s -> a -> Int -> m (Step (FramedEscState s) b)
processNoEsc s
s a
a Int
n =
        case Maybe (a -> Bool)
end of
            Just a -> Bool
isEnd ->
                case Maybe (a -> Bool)
begin of
                    Just a -> Bool
isBegin ->
                        -- takeFramedBy case
                        if a -> Bool
isEnd a
a
                        then
                            if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                            then Int -> b -> Step (FramedEscState s) b
forall s b. Int -> b -> Step s b
SDone Int
1 (b -> Step (FramedEscState s) b)
-> m b -> m (Step (FramedEscState s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s
                            else s -> a -> Int -> m (Step (FramedEscState s) b)
process s
s a
a (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                        else
                            let n1 :: Int
n1 = if a -> Bool
isBegin a
a then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
n
                             in s -> a -> Int -> m (Step (FramedEscState s) b)
process s
s a
a Int
n1
                    Maybe (a -> Bool)
Nothing -> -- takeEndBy case
                        if a -> Bool
isEnd a
a
                        then Int -> b -> Step (FramedEscState s) b
forall s b. Int -> b -> Step s b
SDone Int
1 (b -> Step (FramedEscState s) b)
-> m b -> m (Step (FramedEscState s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s
                        else s -> a -> Int -> m (Step (FramedEscState s) b)
process s
s a
a Int
n
            Maybe (a -> Bool)
Nothing -> -- takeBeginBy case
                case Maybe (a -> Bool)
begin of
                    Just a -> Bool
isBegin ->
                        if a -> Bool
isBegin a
a
                        then Int -> b -> Step (FramedEscState s) b
forall s b. Int -> b -> Step s b
SDone Int
1 (b -> Step (FramedEscState s) b)
-> m b -> m (Step (FramedEscState s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s
                        else s -> a -> Int -> m (Step (FramedEscState s) b)
process s
s a
a Int
n
                    Maybe (a -> Bool)
Nothing ->
                        String -> m (Step (FramedEscState s) b)
forall a. HasCallStack => String -> a
error (String -> m (Step (FramedEscState s) b))
-> String -> m (Step (FramedEscState s) b)
forall a b. (a -> b) -> a -> b
$ String
"takeFramedByGeneric: "
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Both begin and end frame predicate missing"

    {-# INLINE processCheckEsc #-}
    processCheckEsc :: s -> a -> Int -> m (Step (FramedEscState s) b)
processCheckEsc s
s a
a Int
n =
        case Maybe (a -> Bool)
esc of
            Just a -> Bool
isEsc ->
                if a -> Bool
isEsc a
a
                then Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FramedEscState s) b -> m (Step (FramedEscState s) b))
-> Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a b. (a -> b) -> a -> b
$ Int -> FramedEscState s -> Step (FramedEscState s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (FramedEscState s -> Step (FramedEscState s) b)
-> FramedEscState s -> Step (FramedEscState s) b
forall a b. (a -> b) -> a -> b
$ s -> Int -> FramedEscState s
forall s. s -> Int -> FramedEscState s
FrameEscEsc s
s Int
n
                else s -> a -> Int -> m (Step (FramedEscState s) b)
processNoEsc s
s a
a Int
n
            Maybe (a -> Bool)
Nothing -> s -> a -> Int -> m (Step (FramedEscState s) b)
processNoEsc s
s a
a Int
n

    step :: FramedEscState s -> a -> m (Step (FramedEscState s) b)
step (FrameEscInit s
s) a
a =
        case Maybe (a -> Bool)
begin of
            Just a -> Bool
isBegin ->
                if a -> Bool
isBegin a
a
                then Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FramedEscState s) b -> m (Step (FramedEscState s) b))
-> Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a b. (a -> b) -> a -> b
$ Int -> FramedEscState s -> Step (FramedEscState s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (s -> Int -> FramedEscState s
forall s. s -> Int -> FramedEscState s
FrameEscGo s
s Int
0)
                else Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FramedEscState s) b -> m (Step (FramedEscState s) b))
-> Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (FramedEscState s) b
forall s b. String -> Step s b
SError String
"takeFramedByGeneric: missing frame start"
            Maybe (a -> Bool)
Nothing ->
                case Maybe (a -> Bool)
end of
                    Just a -> Bool
isEnd ->
                        if a -> Bool
isEnd a
a
                        then Int -> b -> Step (FramedEscState s) b
forall s b. Int -> b -> Step s b
SDone Int
1 (b -> Step (FramedEscState s) b)
-> m b -> m (Step (FramedEscState s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s
                        else s -> a -> Int -> m (Step (FramedEscState s) b)
processCheckEsc s
s a
a Int
0
                    Maybe (a -> Bool)
Nothing ->
                        String -> m (Step (FramedEscState s) b)
forall a. HasCallStack => String -> a
error String
"Both begin and end frame predicate missing"
    step (FrameEscGo s
s Int
n) a
a = s -> a -> Int -> m (Step (FramedEscState s) b)
processCheckEsc s
s a
a Int
n
    step (FrameEscEsc s
s Int
n) a
a = s -> a -> Int -> m (Step (FramedEscState s) b)
process s
s a
a Int
n

    err :: String -> m (Final s b)
err = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final s b -> m (Final s b))
-> (String -> Final s b) -> String -> m (Final s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Final s b
forall s b. String -> Final s b
FError

    extract :: FramedEscState s -> m (Final s b)
extract (FrameEscInit s
_) =
        String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"takeFramedByGeneric: empty token"
    extract (FrameEscGo s
s Int
_) =
        case Maybe (a -> Bool)
begin of
            Just a -> Bool
_ ->
                case Maybe (a -> Bool)
end of
                    Maybe (a -> Bool)
Nothing -> (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s
                    Just a -> Bool
_ -> String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"takeFramedByGeneric: missing frame end"
            Maybe (a -> Bool)
Nothing -> String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"takeFramedByGeneric: missing closing frame"
    extract (FrameEscEsc s
_ Int
_) = String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"takeFramedByGeneric: trailing escape"

data BlockParseState s =
      BlockInit !s
    | BlockUnquoted !Int !s
    | BlockQuoted !Int !s
    | BlockQuotedEsc !Int !s

-- Blocks can be of different types e.g. {} or (). We only parse from the
-- perspective of the outermost block type. The nesting of that block are
-- checked. Any other block types nested inside it are opaque to us and can be
-- parsed when the contents of the block are parsed.

-- XXX Put a limit on nest level to keep the API safe.

-- | Parse a block enclosed within open, close brackets. Block contents may be
-- quoted, brackets inside quotes are ignored. Quoting characters can be used
-- within quotes if escaped. A block can have a nested block inside it.
--
-- Quote begin and end chars are the same. Block brackets and quote chars must
-- not overlap. Block start and end brackets must be different for nesting
-- blocks within blocks.
--
-- >>> p = Parser.blockWithQuotes (== '\\') (== '"') '{' '}' Fold.toList
-- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"
-- Right "msg: \"hello world\""
--
{-# INLINE blockWithQuotes #-}
blockWithQuotes :: (Monad m, Eq a) =>
       (a -> Bool)  -- ^ escape char
    -> (a -> Bool)  -- ^ quote char, to quote inside brackets
    -> a  -- ^ Block opening bracket
    -> a  -- ^ Block closing bracket
    -> Fold m a b
    -> Parser a m b
blockWithQuotes :: forall (m :: * -> *) a b.
(Monad m, Eq a) =>
(a -> Bool) -> (a -> Bool) -> a -> a -> Fold m a b -> Parser a m b
blockWithQuotes a -> Bool
isEsc a -> Bool
isQuote a
bopen a
bclose
    (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) =
    (BlockParseState s -> a -> m (Step (BlockParseState s) b))
-> m (Initial (BlockParseState s) b)
-> (BlockParseState s -> m (Final (BlockParseState 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 BlockParseState s -> a -> m (Step (BlockParseState s) b)
step m (Initial (BlockParseState s) b)
forall {b}. m (Initial (BlockParseState s) b)
initial BlockParseState s -> m (Final (BlockParseState s) b)
forall {s}. BlockParseState s -> m (Final s b)
extract

    where

    initial :: m (Initial (BlockParseState s) b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        Initial (BlockParseState s) b -> m (Initial (BlockParseState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (BlockParseState s) b
 -> m (Initial (BlockParseState s) b))
-> Initial (BlockParseState s) b
-> m (Initial (BlockParseState s) b)
forall a b. (a -> b) -> a -> b
$
            case Step s b
res of
                FL.Partial s
s -> BlockParseState s -> Initial (BlockParseState s) b
forall s b. s -> Initial s b
IPartial (s -> BlockParseState s
forall s. s -> BlockParseState s
BlockInit s
s)
                FL.Done b
_ ->
                    String -> Initial (BlockParseState s) b
forall a. HasCallStack => String -> a
error String
"blockWithQuotes: fold finished without input"

    {-# INLINE process #-}
    process :: s -> a -> (s -> s) -> m (Step s b)
process s
s a
a s -> s
nextState = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        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
$ case Step s b
res of
                FL.Partial s
s1 -> Int -> s -> Step s b
forall s b. Int -> s -> Step s b
SContinue Int
1 (s -> s
nextState s
s1)
                FL.Done b
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b

    step :: BlockParseState s -> a -> m (Step (BlockParseState s) b)
step (BlockInit s
s) a
a =
        Step (BlockParseState s) b -> m (Step (BlockParseState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (BlockParseState s) b -> m (Step (BlockParseState s) b))
-> Step (BlockParseState s) b -> m (Step (BlockParseState s) b)
forall a b. (a -> b) -> a -> b
$ if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
bopen
              then Int -> BlockParseState s -> Step (BlockParseState s) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (BlockParseState s -> Step (BlockParseState s) b)
-> BlockParseState s -> Step (BlockParseState s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> BlockParseState s
forall s. Int -> s -> BlockParseState s
BlockUnquoted Int
1 s
s
              else String -> Step (BlockParseState s) b
forall s b. String -> Step s b
SError String
"blockWithQuotes: missing block start"
    step (BlockUnquoted Int
level s
s) a
a
        | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
bopen = s
-> a -> (s -> BlockParseState s) -> m (Step (BlockParseState s) b)
forall {s}. s -> a -> (s -> s) -> m (Step s b)
process s
s a
a (Int -> s -> BlockParseState s
forall s. Int -> s -> BlockParseState s
BlockUnquoted (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
bclose =
            if Int
level Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
            then (b -> Step (BlockParseState s) b)
-> m b -> m (Step (BlockParseState 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 -> b -> Step (BlockParseState s) b
forall s b. Int -> b -> Step s b
SDone Int
1) (s -> m b
ffinal s
s)
            else s
-> a -> (s -> BlockParseState s) -> m (Step (BlockParseState s) b)
forall {s}. s -> a -> (s -> s) -> m (Step s b)
process s
s a
a (Int -> s -> BlockParseState s
forall s. Int -> s -> BlockParseState s
BlockUnquoted (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
        | a -> Bool
isQuote a
a = s
-> a -> (s -> BlockParseState s) -> m (Step (BlockParseState s) b)
forall {s}. s -> a -> (s -> s) -> m (Step s b)
process s
s a
a (Int -> s -> BlockParseState s
forall s. Int -> s -> BlockParseState s
BlockQuoted Int
level)
        | Bool
otherwise = s
-> a -> (s -> BlockParseState s) -> m (Step (BlockParseState s) b)
forall {s}. s -> a -> (s -> s) -> m (Step s b)
process s
s a
a (Int -> s -> BlockParseState s
forall s. Int -> s -> BlockParseState s
BlockUnquoted Int
level)
    step (BlockQuoted Int
level s
s) a
a
        | a -> Bool
isEsc a
a = s
-> a -> (s -> BlockParseState s) -> m (Step (BlockParseState s) b)
forall {s}. s -> a -> (s -> s) -> m (Step s b)
process s
s a
a (Int -> s -> BlockParseState s
forall s. Int -> s -> BlockParseState s
BlockQuotedEsc Int
level)
        | Bool
otherwise =
            if a -> Bool
isQuote a
a
            then s
-> a -> (s -> BlockParseState s) -> m (Step (BlockParseState s) b)
forall {s}. s -> a -> (s -> s) -> m (Step s b)
process s
s a
a (Int -> s -> BlockParseState s
forall s. Int -> s -> BlockParseState s
BlockUnquoted Int
level)
            else s
-> a -> (s -> BlockParseState s) -> m (Step (BlockParseState s) b)
forall {s}. s -> a -> (s -> s) -> m (Step s b)
process s
s a
a (Int -> s -> BlockParseState s
forall s. Int -> s -> BlockParseState s
BlockQuoted Int
level)
    step (BlockQuotedEsc Int
level s
s) a
a = s
-> a -> (s -> BlockParseState s) -> m (Step (BlockParseState s) b)
forall {s}. s -> a -> (s -> s) -> m (Step s b)
process s
s a
a (Int -> s -> BlockParseState s
forall s. Int -> s -> BlockParseState s
BlockQuoted Int
level)

    err :: String -> m (Final s b)
err = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final s b -> m (Final s b))
-> (String -> Final s b) -> String -> m (Final s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Final s b
forall s b. String -> Final s b
FError

    extract :: BlockParseState s -> m (Final s b)
extract (BlockInit s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s
    extract (BlockUnquoted Int
level s
_) =
        String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err (String -> m (Final s b)) -> String -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ String
"blockWithQuotes: finished at block nest level " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
level
    extract (BlockQuoted Int
level s
_) =
        String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err (String -> m (Final s b)) -> String -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ String
"blockWithQuotes: finished, inside an unfinished quote, "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"at block nest level " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
level
    extract (BlockQuotedEsc Int
level s
_) =
        String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err (String -> m (Final s b)) -> String -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ String
"blockWithQuotes: finished, inside an unfinished quote, "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"after an escape char, at block nest level " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
level

{-# INLINE takeEndByDone #-}
takeEndByDone :: Monad f => (s -> f (Final s b)) -> Step s b -> f (Step s b)
takeEndByDone :: forall (f :: * -> *) s b.
Monad f =>
(s -> f (Final s b)) -> Step s b -> f (Step s b)
takeEndByDone s -> f (Final s b)
pextract Step s b
res =
    -- If the parser is backtracking we let it backtrack even if the
    -- predicate is true.
    case Step s b
res of
        SPartial Int
1 s
s1 -> do
            Final s b
res1 <- s -> f (Final s b)
pextract s
s1
            Step s b -> f (Step s b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step s b -> f (Step s b)) -> Step s b -> f (Step s b)
forall a b. (a -> b) -> a -> b
$ case Final s b
res1 of
                FDone Int
n 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
n) b
b
                FContinue Int
n 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
n) s
s
                FError String
err -> String -> Step s b
forall s b. String -> Step s b
SError String
err
        SContinue Int
1 s
s1 -> do
            Final s b
res1 <- s -> f (Final s b)
pextract s
s1
            Step s b -> f (Step s b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step s b -> f (Step s b)) -> Step s b -> f (Step s b)
forall a b. (a -> b) -> a -> b
$ case Final s b
res1 of
                FDone Int
n 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
n) b
b
                FContinue Int
n 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
n) s
s
                FError String
err -> String -> Step s b
forall s b. String -> Step s b
SError String
err
        SPartial Int
_ s
_ -> Step s b -> f (Step s b)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res
        SContinue Int
_ s
_ -> Step s b -> f (Step s b)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res
        SDone Int
n b
b -> Step s b -> f (Step s b)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> f (Step s b)) -> Step s b -> f (Step s b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
n b
b
        SError String
n -> Step s b -> f (Step s b)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> f (Step s b)) -> Step s b -> f (Step s b)
forall a b. (a -> b) -> a -> b
$ String -> Step s b
forall s b. String -> Step s b
SError String
n

-- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by
-- the supplied predicate. The separator is also taken with the token.
--
-- This can be combined with other parsers to implement other interesting
-- parsers as follows:
--
-- >>> takeEndByLE cond n p = Parser.takeEndBy cond (Parser.fromFold $ Fold.take n p)
-- >>> takeEndByBetween cond m n p = Parser.takeEndBy cond (Parser.takeBetween m n p)
--
-- >>> takeEndBy = Parser.takeEndByEsc (const False)
--
-- See also "Streamly.Data.Fold.takeEndBy". Unlike the fold, the collecting
-- parser in the takeEndBy parser can decide whether to fail or not if the
-- stream does not end with separator.
--
-- /Pre-release/
--
{-# INLINE takeEndBy #-}
takeEndBy :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
-- takeEndBy = takeEndByEsc (const False)
takeEndBy :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Parser a m b -> Parser a m b
takeEndBy a -> Bool
cond (Parser s -> a -> m (Step s b)
pstep m (Initial s b)
pinitial s -> m (Final s b)
pextract) =

    (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 s -> m (Final s b)
pextract

    where

    initial :: m (Initial s b)
initial = m (Initial s b)
pinitial

    step :: s -> a -> m (Step s b)
step s
s a
a = do
        Step s b
res <- s -> a -> m (Step s b)
pstep s
s a
a
        if Bool -> Bool
not (a -> Bool
cond a
a)
        then Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res
        else (s -> m (Final s b)) -> Step s b -> m (Step s b)
forall (f :: * -> *) s b.
Monad f =>
(s -> f (Final s b)) -> Step s b -> f (Step s b)
takeEndByDone s -> m (Final s b)
pextract Step s b
res

-- | Like 'takeEndBy' but the separator elements can be escaped using an
-- escape char determined by the first predicate. The escape characters are
-- removed.
--
-- /pre-release/
{-# INLINE takeEndByEsc #-}
takeEndByEsc :: Monad m =>
    (a -> Bool) -> (a -> Bool) -> Parser a m b -> Parser a m b
takeEndByEsc :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> (a -> Bool) -> Parser a m b -> Parser a m b
takeEndByEsc a -> Bool
isEsc a -> Bool
isSep (Parser s -> a -> m (Step s b)
pstep m (Initial s b)
pinitial s -> m (Final s b)
pextract) =

    (Either' s s -> a -> m (Step (Either' s s) b))
-> m (Initial (Either' s s) b)
-> (Either' s s -> m (Final (Either' s 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 Either' s s -> a -> m (Step (Either' s s) b)
step m (Initial (Either' s s) b)
forall {b}. m (Initial (Either' s b) b)
initial Either' s s -> m (Final (Either' s s) b)
forall {b} {b}. Either' s b -> m (Final (Either' s b) b)
extract

    where

    initial :: m (Initial (Either' s b) b)
initial = (s -> Either' s b) -> Initial s b -> Initial (Either' s b) 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 -> Either' s b
forall a b. a -> Either' a b
Left' (Initial s b -> Initial (Either' s b) b)
-> m (Initial s b) -> m (Initial (Either' s b) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Initial s b)
pinitial

    step :: Either' s s -> a -> m (Step (Either' s s) b)
step (Left' s
s) a
a = do
        if a -> Bool
isEsc a
a
        then Step (Either' s s) b -> m (Step (Either' s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either' s s) b -> m (Step (Either' s s) b))
-> Step (Either' s s) b -> m (Step (Either' s s) b)
forall a b. (a -> b) -> a -> b
$ Int -> Either' s s -> Step (Either' s s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (Either' s s -> Step (Either' s s) b)
-> Either' s s -> Step (Either' s s) b
forall a b. (a -> b) -> a -> b
$ s -> Either' s s
forall a b. b -> Either' a b
Right' s
s
        else do
            Step s b
res <- s -> a -> m (Step s b)
pstep s
s a
a
            if Bool -> Bool
not (a -> Bool
isSep a
a)
            then Step (Either' s s) b -> m (Step (Either' s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either' s s) b -> m (Step (Either' s s) b))
-> Step (Either' s s) b -> m (Step (Either' s s) b)
forall a b. (a -> b) -> a -> b
$ (s -> Either' s s) -> Step s b -> Step (Either' 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 -> Either' s s
forall a b. a -> Either' a b
Left' Step s b
res
            else (Step s b -> Step (Either' s s) b)
-> m (Step s b) -> m (Step (Either' 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 -> Either' s s) -> Step s b -> Step (Either' 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 -> Either' s s
forall a b. a -> Either' a b
Left') (m (Step s b) -> m (Step (Either' s s) b))
-> m (Step s b) -> m (Step (Either' s s) b)
forall a b. (a -> b) -> a -> b
$ (s -> m (Final s b)) -> Step s b -> m (Step s b)
forall (f :: * -> *) s b.
Monad f =>
(s -> f (Final s b)) -> Step s b -> f (Step s b)
takeEndByDone s -> m (Final s b)
pextract Step s b
res

    step (Right' s
s) a
a = do
        Step s b
res <- s -> a -> m (Step s b)
pstep s
s a
a
        Step (Either' s s) b -> m (Step (Either' s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either' s s) b -> m (Step (Either' s s) b))
-> Step (Either' s s) b -> m (Step (Either' s s) b)
forall a b. (a -> b) -> a -> b
$ (s -> Either' s s) -> Step s b -> Step (Either' 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 -> Either' s s
forall a b. a -> Either' a b
Left' Step s b
res

    extract :: Either' s b -> m (Final (Either' s b) b)
extract (Left' s
s) = (Final s b -> Final (Either' s b) b)
-> m (Final s b) -> m (Final (Either' s 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 -> Either' s b) -> Final s b -> Final (Either' s 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 -> Either' s b
forall a b. a -> Either' a b
Left') (m (Final s b) -> m (Final (Either' s b) b))
-> m (Final s b) -> m (Final (Either' s b) b)
forall a b. (a -> b) -> a -> b
$ s -> m (Final s b)
pextract s
s
    extract (Right' b
_) =
        Final (Either' s b) b -> m (Final (Either' s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (Either' s b) b -> m (Final (Either' s b) b))
-> Final (Either' s b) b -> m (Final (Either' s b) b)
forall a b. (a -> b) -> a -> b
$ String -> Final (Either' s b) b
forall s b. String -> Final s b
FError String
"takeEndByEsc: trailing escape"

-- | Like 'takeEndBy' but the separator is dropped.
--
-- See also "Streamly.Data.Fold.takeEndBy_".
--
-- /Pre-release/
--
{-# INLINE takeEndBy_ #-}
takeEndBy_ :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b
{-
takeEndBy_ isEnd p =
    takeFramedByGeneric Nothing Nothing (Just isEnd) (toFold p)
-}
takeEndBy_ :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Parser a m b -> Parser a m b
takeEndBy_ a -> Bool
cond (Parser s -> a -> m (Step s b)
pstep m (Initial s b)
pinitial s -> m (Final s b)
pextract) =

    (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)
pinitial s -> m (Final s b)
pextract

    where

    step :: s -> a -> m (Step s b)
step s
s a
a =
        if a -> Bool
cond a
a
        then do
            Final s b
res <- s -> m (Final s b)
pextract 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
$ case Final s b
res of
                FDone Int
n b
b -> Int -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) b
b
                FContinue Int
n s
s1 -> Int -> s -> Step s b
forall s b. Int -> s -> Step s b
SPartial (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) s
s1
                FError String
err -> String -> Step s b
forall s b. String -> Step s b
SError String
err
        else s -> a -> m (Step s b)
pstep s
s a
a

-- | Take either the separator or the token. Separator is a Left value and
-- token is Right value.
--
-- /Unimplemented/
{-# INLINE takeEitherSepBy #-}
takeEitherSepBy :: -- Monad m =>
    (a -> Bool) -> Fold m (Either a b) c -> Parser a m c
takeEitherSepBy :: forall a (m :: * -> *) b c.
(a -> Bool) -> Fold m (Either a b) c -> Parser a m c
takeEitherSepBy a -> Bool
_cond = Fold m (Either a b) c -> Parser a m c
forall a. HasCallStack => a
undefined -- D.toParserK . D.takeEitherSepBy cond

-- | Parse a token that starts with an element chosen by the predicate.  The
-- parser fails if the input does not start with the selected element.
--
-- * Stops - when the predicate succeeds in non-leading position.
-- * Fails - when the predicate fails in the leading position.
--
-- >>> splitWithPrefix p f = Stream.parseMany (Parser.takeBeginBy p f)
--
-- Examples: -
--
-- >>> p = Parser.takeBeginBy (== ',') Fold.toList
-- >>> leadingComma = Stream.parsePos p . Stream.fromList
-- >>> leadingComma "a,b"
-- Left (ParseErrorPos 1 "takeBeginBy: missing frame start")
-- ...
-- >>> leadingComma ",,"
-- Right ","
-- >>> leadingComma ",a,b"
-- Right ",a"
-- >>> leadingComma ""
-- Right ""
--
-- /Pre-release/
--
{-# INLINE takeBeginBy #-}
takeBeginBy, takeStartBy :: Monad m =>
    (a -> Bool) -> Fold m a b -> Parser a m b
takeBeginBy :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Parser a m b
takeBeginBy a -> Bool
cond (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) =

    (Either' s s -> a -> m (Step (Either' s s) b))
-> m (Initial (Either' s s) b)
-> (Either' s s -> m (Final (Either' s 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 Either' s s -> a -> m (Step (Either' s s) b)
forall {a}. Either' s s -> a -> m (Step (Either' a s) b)
step m (Initial (Either' s s) b)
forall {b} {b}. m (Initial (Either' s b) b)
initial Either' s s -> m (Final (Either' s s) b)
forall {s}. Either' s s -> m (Final s b)
extract

    where

    initial :: m (Initial (Either' s b) b)
initial =  do
        Step s b
res <- m (Step s b)
finitial
        Initial (Either' s b) b -> m (Initial (Either' s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Either' s b) b -> m (Initial (Either' s b) b))
-> Initial (Either' s b) b -> m (Initial (Either' s b) b)
forall a b. (a -> b) -> a -> b
$
            case Step s b
res of
                FL.Partial s
s -> Either' s b -> Initial (Either' s b) b
forall s b. s -> Initial s b
IPartial (s -> Either' s b
forall a b. a -> Either' a b
Left' s
s)
                FL.Done b
_ -> String -> Initial (Either' s b) b
forall s b. String -> Initial s b
IError String
"takeBeginBy: fold done without input"

    {-# INLINE process #-}
    process :: s -> a -> m (Step (Either' a s) b)
process s
s a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        Step (Either' a s) b -> m (Step (Either' a s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (Either' a s) b -> m (Step (Either' a s) b))
-> Step (Either' a s) b -> m (Step (Either' a s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                FL.Partial s
s1 -> Int -> Either' a s -> Step (Either' a s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (s -> Either' a s
forall a b. b -> Either' a b
Right' s
s1)
                FL.Done b
b -> Int -> b -> Step (Either' a s) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b

    step :: Either' s s -> a -> m (Step (Either' a s) b)
step (Left' s
s) a
a =
        if a -> Bool
cond a
a
        then s -> a -> m (Step (Either' a s) b)
forall {a}. s -> a -> m (Step (Either' a s) b)
process s
s a
a
        else Step (Either' a s) b -> m (Step (Either' a s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either' a s) b -> m (Step (Either' a s) b))
-> Step (Either' a s) b -> m (Step (Either' a s) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (Either' a s) b
forall s b. String -> Step s b
SError String
"takeBeginBy: missing frame start"
    step (Right' s
s) a
a =
        if Bool -> Bool
not (a -> Bool
cond a
a)
        then s -> a -> m (Step (Either' a s) b)
forall {a}. s -> a -> m (Step (Either' a s) b)
process s
s a
a
        else Int -> b -> Step (Either' a s) b
forall s b. Int -> b -> Step s b
SDone Int
0 (b -> Step (Either' a s) b) -> m b -> m (Step (Either' a s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s

    extract :: Either' s s -> m (Final s b)
extract (Left' s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s
    extract (Right' s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s

RENAME(takeStartBy,takeBeginBy)

-- | Like 'takeBeginBy' but drops the separator.
--
-- >>> takeBeginBy_ isBegin = Parser.takeFramedByGeneric Nothing (Just isBegin) Nothing
--
{-# INLINE takeBeginBy_ #-}
takeBeginBy_, takeStartBy_ :: Monad m =>
    (a -> Bool) -> Fold m a b -> Parser a m b
takeBeginBy_ :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Parser a m b
takeBeginBy_ a -> Bool
isBegin = Maybe (a -> Bool)
-> Maybe (a -> Bool)
-> Maybe (a -> Bool)
-> Fold m a b
-> Parser a m b
forall (m :: * -> *) a b.
Monad m =>
Maybe (a -> Bool)
-> Maybe (a -> Bool)
-> Maybe (a -> Bool)
-> Fold m a b
-> Parser a m b
takeFramedByGeneric Maybe (a -> Bool)
forall a. Maybe a
Nothing ((a -> Bool) -> Maybe (a -> Bool)
forall a. a -> Maybe a
Just a -> Bool
isBegin) Maybe (a -> Bool)
forall a. Maybe a
Nothing

RENAME(takeStartBy_,takeBeginBy_)

-- | @takeFramedByEsc_ isEsc isBegin isEnd fold@ parses a token framed using a
-- begin and end predicate, and an escape character. The frame begin and end
-- characters lose their special meaning if preceded by the escape character.
--
-- Nested frames are allowed if begin and end markers are different, nested
-- frames must be balanced unless escaped, nested frame markers are emitted as
-- it is.
--
-- For example,
--
-- >>> p = Parser.takeFramedByEsc_ (== '\\') (== '{') (== '}') Fold.toList
-- >>> Stream.parse p $ Stream.fromList "{hello}"
-- Right "hello"
-- >>> Stream.parse p $ Stream.fromList "{hello {world}}"
-- Right "hello {world}"
-- >>> Stream.parse p $ Stream.fromList "{hello \\{world}"
-- Right "hello {world"
-- >>> Stream.parsePos p $ Stream.fromList "{hello {world}"
-- Left (ParseErrorPos 14 "takeFramedByEsc_: missing frame end")
--
-- /Pre-release/
{-# INLINE takeFramedByEsc_ #-}
takeFramedByEsc_ :: Monad m =>
    (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
-- takeFramedByEsc_ isEsc isEnd p =
--    takeFramedByGeneric (Just isEsc) Nothing (Just isEnd) (toFold p)
takeFramedByEsc_ :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool)
-> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
takeFramedByEsc_ a -> Bool
isEsc a -> Bool
isBegin a -> Bool
isEnd (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal ) =

    (FramedEscState s -> a -> m (Step (FramedEscState s) b))
-> m (Initial (FramedEscState s) b)
-> (FramedEscState s -> m (Final (FramedEscState 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 FramedEscState s -> a -> m (Step (FramedEscState s) b)
step m (Initial (FramedEscState s) b)
forall {b}. m (Initial (FramedEscState s) b)
initial FramedEscState s -> m (Final (FramedEscState s) b)
forall {s} {s} {b}. FramedEscState s -> m (Final s b)
extract

    where

    initial :: m (Initial (FramedEscState s) b)
initial =  do
        Step s b
res <- m (Step s b)
finitial
        Initial (FramedEscState s) b -> m (Initial (FramedEscState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (FramedEscState s) b -> m (Initial (FramedEscState s) b))
-> Initial (FramedEscState s) b -> m (Initial (FramedEscState s) b)
forall a b. (a -> b) -> a -> b
$
            case Step s b
res of
                FL.Partial s
s -> FramedEscState s -> Initial (FramedEscState s) b
forall s b. s -> Initial s b
IPartial (s -> FramedEscState s
forall s. s -> FramedEscState s
FrameEscInit s
s)
                FL.Done b
_ ->
                    String -> Initial (FramedEscState s) b
forall a. HasCallStack => String -> a
error String
"takeFramedByEsc_: fold done without input"

    {-# INLINE process #-}
    process :: s -> a -> Int -> m (Step (FramedEscState s) b)
process s
s a
a Int
n = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (FramedEscState s) b -> m (Step (FramedEscState s) b))
-> Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                FL.Partial s
s1 -> Int -> FramedEscState s -> Step (FramedEscState s) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (s -> Int -> FramedEscState s
forall s. s -> Int -> FramedEscState s
FrameEscGo s
s1 Int
n)
                FL.Done b
b -> Int -> b -> Step (FramedEscState s) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b

    step :: FramedEscState s -> a -> m (Step (FramedEscState s) b)
step (FrameEscInit s
s) a
a =
        if a -> Bool
isBegin a
a
        then Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FramedEscState s) b -> m (Step (FramedEscState s) b))
-> Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a b. (a -> b) -> a -> b
$ Int -> FramedEscState s -> Step (FramedEscState s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (s -> Int -> FramedEscState s
forall s. s -> Int -> FramedEscState s
FrameEscGo s
s Int
0)
        else Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FramedEscState s) b -> m (Step (FramedEscState s) b))
-> Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (FramedEscState s) b
forall s b. String -> Step s b
SError String
"takeFramedByEsc_: missing frame start"
    step (FrameEscGo s
s Int
n) a
a =
        if a -> Bool
isEsc a
a
        then Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FramedEscState s) b -> m (Step (FramedEscState s) b))
-> Step (FramedEscState s) b -> m (Step (FramedEscState s) b)
forall a b. (a -> b) -> a -> b
$ Int -> FramedEscState s -> Step (FramedEscState s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (FramedEscState s -> Step (FramedEscState s) b)
-> FramedEscState s -> Step (FramedEscState s) b
forall a b. (a -> b) -> a -> b
$ s -> Int -> FramedEscState s
forall s. s -> Int -> FramedEscState s
FrameEscEsc s
s Int
n
        else do
            if Bool -> Bool
not (a -> Bool
isEnd a
a)
            then
                let n1 :: Int
n1 = if a -> Bool
isBegin a
a then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
n
                 in s -> a -> Int -> m (Step (FramedEscState s) b)
process s
s a
a Int
n1
            else
                if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then Int -> b -> Step (FramedEscState s) b
forall s b. Int -> b -> Step s b
SDone Int
1 (b -> Step (FramedEscState s) b)
-> m b -> m (Step (FramedEscState s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s
                else s -> a -> Int -> m (Step (FramedEscState s) b)
process s
s a
a (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    step (FrameEscEsc s
s Int
n) a
a = s -> a -> Int -> m (Step (FramedEscState s) b)
process s
s a
a Int
n

    err :: String -> m (Final s b)
err = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final s b -> m (Final s b))
-> (String -> Final s b) -> String -> m (Final s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Final s b
forall s b. String -> Final s b
FError

    extract :: FramedEscState s -> m (Final s b)
extract (FrameEscInit s
_) = String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"takeFramedByEsc_: empty token"
    extract (FrameEscGo s
_ Int
_) = String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"takeFramedByEsc_: missing frame end"
    extract (FrameEscEsc s
_ Int
_) = String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"takeFramedByEsc_: trailing escape"

data FramedState s = FrameInit !s | FrameGo !s Int

-- | @takeFramedBy_ isBegin isEnd fold@ parses a token framed by a begin and an
-- end predicate.
--
-- >>> takeFramedBy_ = Parser.takeFramedByEsc_ (const False)
--
{-# INLINE takeFramedBy_ #-}
takeFramedBy_ :: Monad m =>
    (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
-- takeFramedBy_ isBegin isEnd =
--    takeFramedByGeneric (Just (const False)) (Just isBegin) (Just isEnd)
takeFramedBy_ :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b
takeFramedBy_ a -> Bool
isBegin a -> Bool
isEnd (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) =

    (FramedState s -> a -> m (Step (FramedState s) b))
-> m (Initial (FramedState s) b)
-> (FramedState s -> m (Final (FramedState 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 FramedState s -> a -> m (Step (FramedState s) b)
step m (Initial (FramedState s) b)
forall {b}. m (Initial (FramedState s) b)
initial FramedState s -> m (Final (FramedState s) b)
forall {s} {s} {b}. FramedState s -> m (Final s b)
extract

    where

    initial :: m (Initial (FramedState s) b)
initial =  do
        Step s b
res <- m (Step s b)
finitial
        Initial (FramedState s) b -> m (Initial (FramedState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (FramedState s) b -> m (Initial (FramedState s) b))
-> Initial (FramedState s) b -> m (Initial (FramedState s) b)
forall a b. (a -> b) -> a -> b
$
            case Step s b
res of
                FL.Partial s
s -> FramedState s -> Initial (FramedState s) b
forall s b. s -> Initial s b
IPartial (s -> FramedState s
forall s. s -> FramedState s
FrameInit s
s)
                FL.Done b
_ ->
                    String -> Initial (FramedState s) b
forall a. HasCallStack => String -> a
error String
"takeFramedBy_: fold done without input"

    {-# INLINE process #-}
    process :: s -> a -> Int -> m (Step (FramedState s) b)
process s
s a
a Int
n = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        Step (FramedState s) b -> m (Step (FramedState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (FramedState s) b -> m (Step (FramedState s) b))
-> Step (FramedState s) b -> m (Step (FramedState s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                FL.Partial s
s1 -> Int -> FramedState s -> Step (FramedState s) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (s -> Int -> FramedState s
forall s. s -> Int -> FramedState s
FrameGo s
s1 Int
n)
                FL.Done b
b -> Int -> b -> Step (FramedState s) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b

    step :: FramedState s -> a -> m (Step (FramedState s) b)
step (FrameInit s
s) a
a =
        if a -> Bool
isBegin a
a
        then Step (FramedState s) b -> m (Step (FramedState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FramedState s) b -> m (Step (FramedState s) b))
-> Step (FramedState s) b -> m (Step (FramedState s) b)
forall a b. (a -> b) -> a -> b
$ Int -> FramedState s -> Step (FramedState s) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (s -> Int -> FramedState s
forall s. s -> Int -> FramedState s
FrameGo s
s Int
0)
        else Step (FramedState s) b -> m (Step (FramedState s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FramedState s) b -> m (Step (FramedState s) b))
-> Step (FramedState s) b -> m (Step (FramedState s) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (FramedState s) b
forall s b. String -> Step s b
SError String
"takeFramedBy_: missing frame start"
    step (FrameGo s
s Int
n) a
a
        | Bool -> Bool
not (a -> Bool
isEnd a
a) =
            let n1 :: Int
n1 = if a -> Bool
isBegin a
a then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
n
             in s -> a -> Int -> m (Step (FramedState s) b)
process s
s a
a Int
n1
        | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> b -> Step (FramedState s) b
forall s b. Int -> b -> Step s b
SDone Int
1 (b -> Step (FramedState s) b) -> m b -> m (Step (FramedState s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s
        | Bool
otherwise = s -> a -> Int -> m (Step (FramedState s) b)
process s
s a
a (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

    err :: String -> m (Final s b)
err = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final s b -> m (Final s b))
-> (String -> Final s b) -> String -> m (Final s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Final s b
forall s b. String -> Final s b
FError

    extract :: FramedState s -> m (Final s b)
extract (FrameInit s
_) = String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"takeFramedBy_: empty token"
    extract (FrameGo s
_ Int
_) = String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"takeFramedBy_: missing frame end"

-------------------------------------------------------------------------------
-- Grouping and words
-------------------------------------------------------------------------------

data WordByState s b = WBLeft !s | WBWord !s | WBRight !b

-- Note we can also get words using something like:
-- sepBy FL.toList (takeWhile (not . p) Fold.toList) (dropWhile p)
--
-- But that won't be as efficient and ergonomic.

-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
-- @["a","b"]@.  In other words, its like parsing words from whitespace
-- separated text.
--
-- * Stops - when it finds a word separator after a non-word element
-- * Fails - never.
--
-- >>> wordBy = Parser.wordFramedBy (const False) (const False) (const False)
--
-- @
-- S.wordsBy pred f = S.parseMany (PR.wordBy pred f)
-- @
--
{-# INLINE wordBy #-}
wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
wordBy :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Parser a m b
wordBy a -> Bool
predicate (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) = (WordByState s b -> a -> m (Step (WordByState s b) b))
-> m (Initial (WordByState s b) b)
-> (WordByState s b -> m (Final (WordByState s b) 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 WordByState s b -> a -> m (Step (WordByState s b) b)
step m (Initial (WordByState s b) b)
forall {b}. m (Initial (WordByState s b) b)
initial WordByState s b -> m (Final (WordByState s b) b)
forall {s}. WordByState s b -> m (Final s b)
extract

    where

    {-# INLINE worder #-}
    worder :: s -> a -> m (Step (WordByState s b) b)
worder s
s a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (WordByState s b) b -> m (Step (WordByState s b) b))
-> Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
s1 -> Int -> WordByState s b -> Step (WordByState s b) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (WordByState s b -> Step (WordByState s b) b)
-> WordByState s b -> Step (WordByState s b) b
forall a b. (a -> b) -> a -> b
$ s -> WordByState s b
forall s b. s -> WordByState s b
WBWord s
s1
                  FL.Done b
b -> Int -> b -> Step (WordByState s b) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b

    initial :: m (Initial (WordByState s b) b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        Initial (WordByState s b) b -> m (Initial (WordByState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Initial (WordByState s b) b -> m (Initial (WordByState s b) b))
-> Initial (WordByState s b) b -> m (Initial (WordByState s b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
s -> WordByState s b -> Initial (WordByState s b) b
forall s b. s -> Initial s b
IPartial (WordByState s b -> Initial (WordByState s b) b)
-> WordByState s b -> Initial (WordByState s b) b
forall a b. (a -> b) -> a -> b
$ s -> WordByState s b
forall s b. s -> WordByState s b
WBLeft s
s
                  FL.Done b
b -> b -> Initial (WordByState s b) b
forall s b. b -> Initial s b
IDone b
b

    step :: WordByState s b -> a -> m (Step (WordByState s b) b)
step (WBLeft s
s) a
a =
        if Bool -> Bool
not (a -> Bool
predicate a
a)
        then s -> a -> m (Step (WordByState s b) b)
forall {b}. s -> a -> m (Step (WordByState s b) b)
worder s
s a
a
        else Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordByState s b) b -> m (Step (WordByState s b) b))
-> Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordByState s b -> Step (WordByState s b) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (WordByState s b -> Step (WordByState s b) b)
-> WordByState s b -> Step (WordByState s b) b
forall a b. (a -> b) -> a -> b
$ s -> WordByState s b
forall s b. s -> WordByState s b
WBLeft s
s
    step (WBWord s
s) a
a =
        if Bool -> Bool
not (a -> Bool
predicate a
a)
        then s -> a -> m (Step (WordByState s b) b)
forall {b}. s -> a -> m (Step (WordByState s b) b)
worder s
s a
a
        else do
            b
b <- s -> m b
ffinal s
s
            Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordByState s b) b -> m (Step (WordByState s b) b))
-> Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordByState s b -> Step (WordByState s b) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (WordByState s b -> Step (WordByState s b) b)
-> WordByState s b -> Step (WordByState s b) b
forall a b. (a -> b) -> a -> b
$ b -> WordByState s b
forall s b. b -> WordByState s b
WBRight b
b
    step (WBRight b
b) a
a =
        Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (WordByState s b) b -> m (Step (WordByState s b) b))
-> Step (WordByState s b) b -> m (Step (WordByState s b) b)
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not (a -> Bool
predicate a
a)
              then Int -> b -> Step (WordByState s b) b
forall s b. Int -> b -> Step s b
SDone Int
0 b
b
              else Int -> WordByState s b -> Step (WordByState s b) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (WordByState s b -> Step (WordByState s b) b)
-> WordByState s b -> Step (WordByState s b) b
forall a b. (a -> b) -> a -> b
$ b -> WordByState s b
forall s b. b -> WordByState s b
WBRight b
b

    extract :: WordByState s b -> m (Final s b)
extract (WBLeft s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s
    extract (WBWord s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s
    extract (WBRight b
b) = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0 b
b)

data WordFramedState s b =
      WordFramedSkipPre !s
    | WordFramedWord !s !Int
    | WordFramedEsc !s !Int
    | WordFramedSkipPost !b

-- | Like 'wordBy' but treats anything inside a pair of quotes as a single
-- word, the quotes can be escaped by an escape character.  Recursive quotes
-- are possible if quote begin and end characters are different, quotes must be
-- balanced. Outermost quotes are stripped.
--
-- >>> braces = Parser.wordFramedBy (== '\\') (== '{') (== '}') isSpace Fold.toList
-- >>> Stream.parse braces $ Stream.fromList "{ab} cd"
-- Right "ab"
-- >>> Stream.parse braces $ Stream.fromList "{ab}{cd}"
-- Right "abcd"
-- >>> Stream.parse braces $ Stream.fromList "a{b} cd"
-- Right "ab"
-- >>> Stream.parse braces $ Stream.fromList "a{{b}} cd"
-- Right "a{b}"
--
-- >>> quotes = Parser.wordFramedBy (== '\\') (== '"') (== '"') isSpace Fold.toList
-- >>> Stream.parse quotes $ Stream.fromList "\"a\"\"b\""
-- Right "ab"
--
{-# INLINE wordFramedBy #-}
wordFramedBy :: Monad m =>
       (a -> Bool)  -- ^ Matches escape elem?
    -> (a -> Bool)  -- ^ Matches left quote?
    -> (a -> Bool)  -- ^ matches right quote?
    -> (a -> Bool)  -- ^ matches word separator?
    -> Fold m a b
    -> Parser a m b
wordFramedBy :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> Fold m a b
-> Parser a m b
wordFramedBy a -> Bool
isEsc a -> Bool
isBegin a -> Bool
isEnd a -> Bool
isSep
    (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) =
    (WordFramedState s b -> a -> m (Step (WordFramedState s b) b))
-> m (Initial (WordFramedState s b) b)
-> (WordFramedState s b -> m (Final (WordFramedState s b) 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 WordFramedState s b -> a -> m (Step (WordFramedState s b) b)
step m (Initial (WordFramedState s b) b)
forall {b} {b}. m (Initial (WordFramedState s b) b)
initial WordFramedState s b -> m (Final (WordFramedState s b) b)
forall {s}. WordFramedState s b -> m (Final s b)
extract

    where

    initial :: m (Initial (WordFramedState s b) b)
initial =  do
        Step s b
res <- m (Step s b)
finitial
        Initial (WordFramedState s b) b
-> m (Initial (WordFramedState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (WordFramedState s b) b
 -> m (Initial (WordFramedState s b) b))
-> Initial (WordFramedState s b) b
-> m (Initial (WordFramedState s b) b)
forall a b. (a -> b) -> a -> b
$
            case Step s b
res of
                FL.Partial s
s -> WordFramedState s b -> Initial (WordFramedState s b) b
forall s b. s -> Initial s b
IPartial (s -> WordFramedState s b
forall s b. s -> WordFramedState s b
WordFramedSkipPre s
s)
                FL.Done b
_ ->
                    String -> Initial (WordFramedState s b) b
forall a. HasCallStack => String -> a
error String
"wordFramedBy: fold done without input"

    {-# INLINE process #-}
    process :: s -> a -> Int -> m (Step (WordFramedState s b) b)
process s
s a
a Int
n = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b))
-> Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                FL.Partial s
s1 -> Int -> WordFramedState s b -> Step (WordFramedState s b) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (s -> Int -> WordFramedState s b
forall s b. s -> Int -> WordFramedState s b
WordFramedWord s
s1 Int
n)
                FL.Done b
b -> Int -> b -> Step (WordFramedState s b) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b

    step :: WordFramedState s b -> a -> m (Step (WordFramedState s b) b)
step (WordFramedSkipPre s
s) a
a
        | a -> Bool
isEsc a
a = Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b))
-> Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordFramedState s b -> Step (WordFramedState s b) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (WordFramedState s b -> Step (WordFramedState s b) b)
-> WordFramedState s b -> Step (WordFramedState s b) b
forall a b. (a -> b) -> a -> b
$ s -> Int -> WordFramedState s b
forall s b. s -> Int -> WordFramedState s b
WordFramedEsc s
s Int
0
        | a -> Bool
isSep a
a = Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b))
-> Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordFramedState s b -> Step (WordFramedState s b) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (WordFramedState s b -> Step (WordFramedState s b) b)
-> WordFramedState s b -> Step (WordFramedState s b) b
forall a b. (a -> b) -> a -> b
$ s -> WordFramedState s b
forall s b. s -> WordFramedState s b
WordFramedSkipPre s
s
        | a -> Bool
isBegin a
a = Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b))
-> Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordFramedState s b -> Step (WordFramedState s b) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (WordFramedState s b -> Step (WordFramedState s b) b)
-> WordFramedState s b -> Step (WordFramedState s b) b
forall a b. (a -> b) -> a -> b
$ s -> Int -> WordFramedState s b
forall s b. s -> Int -> WordFramedState s b
WordFramedWord s
s Int
1
        | a -> Bool
isEnd a
a =
            Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b))
-> Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (WordFramedState s b) b
forall s b. String -> Step s b
SError String
"wordFramedBy: missing frame start"
        | Bool
otherwise = s -> a -> Int -> m (Step (WordFramedState s b) b)
forall {b}. s -> a -> Int -> m (Step (WordFramedState s b) b)
process s
s a
a Int
0
    step (WordFramedWord s
s Int
n) a
a
        | a -> Bool
isEsc a
a = Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b))
-> Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordFramedState s b -> Step (WordFramedState s b) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (WordFramedState s b -> Step (WordFramedState s b) b)
-> WordFramedState s b -> Step (WordFramedState s b) b
forall a b. (a -> b) -> a -> b
$ s -> Int -> WordFramedState s b
forall s b. s -> Int -> WordFramedState s b
WordFramedEsc s
s Int
n
        | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& a -> Bool
isSep a
a = do
            b
b <- s -> m b
ffinal s
s
            Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b))
-> Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordFramedState s b -> Step (WordFramedState s b) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (WordFramedState s b -> Step (WordFramedState s b) b)
-> WordFramedState s b -> Step (WordFramedState s b) b
forall a b. (a -> b) -> a -> b
$ b -> WordFramedState s b
forall s b. b -> WordFramedState s b
WordFramedSkipPost b
b
        | Bool
otherwise = do
            -- We need to use different order for checking begin and end for
            -- the n == 0 and n == 1 case so that when the begin and end
            -- character is the same we treat the one after begin as end.
            if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then
               -- Need to check isBegin first
               if a -> Bool
isBegin a
a
               then Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b))
-> Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordFramedState s b -> Step (WordFramedState s b) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (WordFramedState s b -> Step (WordFramedState s b) b)
-> WordFramedState s b -> Step (WordFramedState s b) b
forall a b. (a -> b) -> a -> b
$ s -> Int -> WordFramedState s b
forall s b. s -> Int -> WordFramedState s b
WordFramedWord s
s Int
1
               else if a -> Bool
isEnd a
a
                    then Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b))
-> Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (WordFramedState s b) b
forall s b. String -> Step s b
SError String
"wordFramedBy: missing frame start"
                    else s -> a -> Int -> m (Step (WordFramedState s b) b)
forall {b}. s -> a -> Int -> m (Step (WordFramedState s b) b)
process s
s a
a Int
n
            else
               -- Need to check isEnd first
                if a -> Bool
isEnd a
a
                then
                   if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                   then Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b))
-> Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordFramedState s b -> Step (WordFramedState s b) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (WordFramedState s b -> Step (WordFramedState s b) b)
-> WordFramedState s b -> Step (WordFramedState s b) b
forall a b. (a -> b) -> a -> b
$ s -> Int -> WordFramedState s b
forall s b. s -> Int -> WordFramedState s b
WordFramedWord s
s Int
0
                   else s -> a -> Int -> m (Step (WordFramedState s b) b)
forall {b}. s -> a -> Int -> m (Step (WordFramedState s b) b)
process s
s a
a (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                else if a -> Bool
isBegin a
a
                     then s -> a -> Int -> m (Step (WordFramedState s b) b)
forall {b}. s -> a -> Int -> m (Step (WordFramedState s b) b)
process s
s a
a (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                     else s -> a -> Int -> m (Step (WordFramedState s b) b)
forall {b}. s -> a -> Int -> m (Step (WordFramedState s b) b)
process s
s a
a Int
n
    step (WordFramedEsc s
s Int
n) a
a = s -> a -> Int -> m (Step (WordFramedState s b) b)
forall {b}. s -> a -> Int -> m (Step (WordFramedState s b) b)
process s
s a
a Int
n
    step (WordFramedSkipPost b
b) a
a =
        Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b))
-> Step (WordFramedState s b) b -> m (Step (WordFramedState s b) b)
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not (a -> Bool
isSep a
a)
              then Int -> b -> Step (WordFramedState s b) b
forall s b. Int -> b -> Step s b
SDone Int
0 b
b
              else Int -> WordFramedState s b -> Step (WordFramedState s b) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (WordFramedState s b -> Step (WordFramedState s b) b)
-> WordFramedState s b -> Step (WordFramedState s b) b
forall a b. (a -> b) -> a -> b
$ b -> WordFramedState s b
forall s b. b -> WordFramedState s b
WordFramedSkipPost b
b

    err :: String -> m (Final s b)
err = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final s b -> m (Final s b))
-> (String -> Final s b) -> String -> m (Final s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Final s b
forall s b. String -> Final s b
FError

    extract :: WordFramedState s b -> m (Final s b)
extract (WordFramedSkipPre s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s
    extract (WordFramedWord s
s Int
n) =
        if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s
        else String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"wordFramedBy: missing frame end"
    extract (WordFramedEsc s
_ Int
_) =
        String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"wordFramedBy: trailing escape"
    extract (WordFramedSkipPost b
b) = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0 b
b)

data WordQuotedState s b a =
      WordQuotedSkipPre !s
    | WordUnquotedWord !s
    | WordQuotedWord !s !Int !a !a
    | WordUnquotedEsc !s
    | WordQuotedEsc !s !Int !a !a
    | WordQuotedSkipPost !b

-- | Quote and bracket aware word splitting with escaping. Like 'wordBy' but
-- word separators within specified quotes or brackets are ignored. Quotes and
-- escape characters can be processed. If the end quote is different from the
-- start quote it is called a bracket. The following quoting rules apply:
--
-- * In an unquoted string a character may be preceded by an escape character.
-- The escape character is removed and the character following it is treated
-- literally with no special meaning e.g. e.g. h\ e\ l\ l\ o is a single word,
-- \n is same as n.
-- * Any part of the word can be placed within quotes. Inside quotes all
-- characters are treated literally with no special meaning. Quoting character
-- itself cannot be used within quotes unless escape processing within quotes
-- is applied to allow it.
-- * Optionally escape processing for quoted part can be specified. Escape
-- character has no special meaning inside quotes unless it is followed by a
-- character that has a escape translation specified, in that case the escape
-- character is removed, and the specified translation is applied to the
-- character following it. This can be used to escape the quoting character
-- itself within quotes.
-- * There can be multiple quoting characters, when a quote starts, all other
-- quoting characters within that quote lose any special meaning until the
-- quote is closed.
-- * A starting quote char without an ending char generates a parse error. An
-- ending bracket char without a corresponding bracket begin is ignored.
-- * Brackets can be nested.
--
-- We should note that unquoted and quoted escape processing are different. In
-- unquoted part escape character is always removed. In quoted part it is
-- removed only if followed by a special meaning character. This is consistent
-- with how shell performs escape processing.

-- Examples of quotes - "double quotes", 'single quotes', (parens), {braces},
-- ((nested) brackets).
--
-- Example:
--
-- >>> :{
-- >>> q x =
-- >>>     case x of
-- >>>         '"' -> Just x
-- >>>         '\'' -> Just x
-- >>>         _ -> Nothing
-- >>> :}
--
-- >>> p = Parser.wordKeepQuotes (== '\\') q isSpace Fold.toList
-- >>> Stream.parse p $ Stream.fromList "a\"b'c\";'d\"e'f ghi"
-- Right "a\"b'c\";'d\"e'f"
--
-- Note that outer quotes and backslashes from the input string are consumed by
-- Haskell, therefore, the actual input string passed to the parser is:
-- a"b'c";'d"e'f ghi
--
-- Similarly, when printing, double quotes are escaped by Haskell.
--
-- Limitations:
--
-- Shell like quote processing can be performed by using quote char specific
-- escape processing, single quotes with no escapes, and double quotes with
-- escapes.
--
-- JSON string processing can also be achieved except the "\uXXXX" style
-- escaping for Unicode characters.
--
{-# INLINE wordWithQuotes #-}
wordWithQuotes :: (Monad m, Eq a) =>
       Bool            -- ^ Retain the quotes and escape chars in the output
    -> (a -> a -> Maybe a)  -- ^ quote char -> escaped char -> translated char
    -> a               -- ^ Matches an escape elem?
    -> (a -> Maybe a)  -- ^ If left quote, return right quote, else Nothing.
    -> (a -> Bool)     -- ^ Matches a word separator?
    -> Fold m a b
    -> Parser a m b
wordWithQuotes :: forall (m :: * -> *) a b.
(Monad m, Eq a) =>
Bool
-> (a -> a -> Maybe a)
-> a
-> (a -> Maybe a)
-> (a -> Bool)
-> Fold m a b
-> Parser a m b
wordWithQuotes Bool
keepQuotes a -> a -> Maybe a
tr a
escChar a -> Maybe a
toRight a -> Bool
isSep
    (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) =
    (WordQuotedState s b a -> a -> m (Step (WordQuotedState s b a) b))
-> m (Initial (WordQuotedState s b a) b)
-> (WordQuotedState s b a -> m (Final (WordQuotedState s b a) 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 WordQuotedState s b a -> a -> m (Step (WordQuotedState s b a) b)
step m (Initial (WordQuotedState s b a) b)
forall {b} {a} {b}. m (Initial (WordQuotedState s b a) b)
initial WordQuotedState s b a -> m (Final (WordQuotedState s b a) b)
forall {a} {s}. WordQuotedState s b a -> m (Final s b)
extract

    where

    -- Can be used to generate parse error for a bracket end without a bracket
    -- begin.
    isInvalid :: b -> Bool
isInvalid = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
False

    isEsc :: a -> Bool
isEsc = (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
escChar)

    initial :: m (Initial (WordQuotedState s b a) b)
initial =  do
        Step s b
res <- m (Step s b)
finitial
        Initial (WordQuotedState s b a) b
-> m (Initial (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (WordQuotedState s b a) b
 -> m (Initial (WordQuotedState s b a) b))
-> Initial (WordQuotedState s b a) b
-> m (Initial (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$
            case Step s b
res of
                FL.Partial s
s -> WordQuotedState s b a -> Initial (WordQuotedState s b a) b
forall s b. s -> Initial s b
IPartial (s -> WordQuotedState s b a
forall s b a. s -> WordQuotedState s b a
WordQuotedSkipPre s
s)
                FL.Done b
_ ->
                    String -> Initial (WordQuotedState s b a) b
forall a. HasCallStack => String -> a
error String
"wordKeepQuotes: fold done without input"

    {-# INLINE processQuoted #-}
    processQuoted :: s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
processQuoted s
s a
a Int
n a
ql a
qr = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                FL.Partial s
s1 -> Int -> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (s -> Int -> a -> a -> WordQuotedState s b a
forall s b a. s -> Int -> a -> a -> WordQuotedState s b a
WordQuotedWord s
s1 Int
n a
ql a
qr)
                FL.Done b
b -> Int -> b -> Step (WordQuotedState s b a) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b

    {-# INLINE processUnquoted #-}
    processUnquoted :: s -> a -> m (Step (WordQuotedState s b a) b)
processUnquoted s
s a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                FL.Partial s
s1 -> Int -> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (s -> WordQuotedState s b a
forall s b a. s -> WordQuotedState s b a
WordUnquotedWord s
s1)
                FL.Done b
b -> Int -> b -> Step (WordQuotedState s b a) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b

    {-# INLINE checkRightQuoteAndProcess #-}
    checkRightQuoteAndProcess :: s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
checkRightQuoteAndProcess s
s a
a Int
n a
ql a
qr
        | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
qr =
           if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
           then if Bool
keepQuotes
                then s -> a -> m (Step (WordQuotedState s b a) b)
forall {b} {a}. s -> a -> m (Step (WordQuotedState s b a) b)
processUnquoted s
s a
a
                else Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (WordQuotedState s b a -> Step (WordQuotedState s b a) b)
-> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall a b. (a -> b) -> a -> b
$ s -> WordQuotedState s b a
forall s b a. s -> WordQuotedState s b a
WordUnquotedWord s
s
           else s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
forall {a} {b}.
s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
processQuoted s
s a
a (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
ql a
qr
        | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
ql = s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
forall {a} {b}.
s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
processQuoted s
s a
a (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
ql a
qr
        | Bool
otherwise = s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
forall {a} {b}.
s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
processQuoted s
s a
a Int
n a
ql a
qr

    step :: WordQuotedState s b a -> a -> m (Step (WordQuotedState s b a) b)
step (WordQuotedSkipPre s
s) a
a
        | a -> Bool
isEsc a
a = Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (WordQuotedState s b a -> Step (WordQuotedState s b a) b)
-> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall a b. (a -> b) -> a -> b
$ s -> WordQuotedState s b a
forall s b a. s -> WordQuotedState s b a
WordUnquotedEsc s
s
        | a -> Bool
isSep a
a = Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (WordQuotedState s b a -> Step (WordQuotedState s b a) b)
-> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall a b. (a -> b) -> a -> b
$ s -> WordQuotedState s b a
forall s b a. s -> WordQuotedState s b a
WordQuotedSkipPre s
s
        | Bool
otherwise =
            case a -> Maybe a
toRight a
a of
                Just a
qr ->
                  if Bool
keepQuotes
                  then s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
forall {a} {b}.
s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
processQuoted s
s a
a Int
1 a
a a
qr
                  else Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (WordQuotedState s b a -> Step (WordQuotedState s b a) b)
-> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall a b. (a -> b) -> a -> b
$ s -> Int -> a -> a -> WordQuotedState s b a
forall s b a. s -> Int -> a -> a -> WordQuotedState s b a
WordQuotedWord s
s Int
1 a
a a
qr
                Maybe a
Nothing
                    | a -> Bool
forall {b}. b -> Bool
isInvalid a
a ->
                        Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (WordQuotedState s b a) b
forall s b. String -> Step s b
SError String
"wordKeepQuotes: invalid unquoted char"
                    | Bool
otherwise -> s -> a -> m (Step (WordQuotedState s b a) b)
forall {b} {a}. s -> a -> m (Step (WordQuotedState s b a) b)
processUnquoted s
s a
a
    step (WordUnquotedWord s
s) a
a
        | a -> Bool
isEsc a
a = Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (WordQuotedState s b a -> Step (WordQuotedState s b a) b)
-> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall a b. (a -> b) -> a -> b
$ s -> WordQuotedState s b a
forall s b a. s -> WordQuotedState s b a
WordUnquotedEsc s
s
        | a -> Bool
isSep a
a = do
            b
b <- s -> m b
ffinal s
s
            Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (WordQuotedState s b a -> Step (WordQuotedState s b a) b)
-> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall a b. (a -> b) -> a -> b
$ b -> WordQuotedState s b a
forall s b a. b -> WordQuotedState s b a
WordQuotedSkipPost b
b
        | Bool
otherwise = do
            case a -> Maybe a
toRight a
a of
                Just a
qr ->
                    if Bool
keepQuotes
                    then s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
forall {a} {b}.
s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
processQuoted s
s a
a Int
1 a
a a
qr
                    else Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (WordQuotedState s b a -> Step (WordQuotedState s b a) b)
-> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall a b. (a -> b) -> a -> b
$ s -> Int -> a -> a -> WordQuotedState s b a
forall s b a. s -> Int -> a -> a -> WordQuotedState s b a
WordQuotedWord s
s Int
1 a
a a
qr
                Maybe a
Nothing ->
                    if a -> Bool
forall {b}. b -> Bool
isInvalid a
a
                    then Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (WordQuotedState s b a) b
forall s b. String -> Step s b
SError String
"wordKeepQuotes: invalid unquoted char"
                    else s -> a -> m (Step (WordQuotedState s b a) b)
forall {b} {a}. s -> a -> m (Step (WordQuotedState s b a) b)
processUnquoted s
s a
a
    step (WordQuotedWord s
s Int
n a
ql a
qr) a
a
        | a -> Bool
isEsc a
a = Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ Int -> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (WordQuotedState s b a -> Step (WordQuotedState s b a) b)
-> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall a b. (a -> b) -> a -> b
$ s -> Int -> a -> a -> WordQuotedState s b a
forall s b a. s -> Int -> a -> a -> WordQuotedState s b a
WordQuotedEsc s
s Int
n a
ql a
qr
        {-
        -- XXX Will this ever occur? Will n ever be 0?
        | n == 0 && isSep a = do
            b <- fextract s
            return $ SPartial 1 $ WordQuotedSkipPost b
        -}
        | Bool
otherwise = s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
forall {b}.
s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
checkRightQuoteAndProcess s
s a
a Int
n a
ql a
qr
    step (WordUnquotedEsc s
s) a
a = s -> a -> m (Step (WordQuotedState s b a) b)
forall {b} {a}. s -> a -> m (Step (WordQuotedState s b a) b)
processUnquoted s
s a
a
    step (WordQuotedEsc s
s Int
n a
ql a
qr) a
a =
        case a -> a -> Maybe a
tr a
ql a
a of
            Maybe a
Nothing -> do
                Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
escChar
                case Step s b
res of
                    FL.Partial s
s1 -> s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
forall {b}.
s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
checkRightQuoteAndProcess s
s1 a
a Int
n a
ql a
qr
                    FL.Done b
b -> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step (WordQuotedState s b a) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b
            Just a
x -> s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
forall {a} {b}.
s -> a -> Int -> a -> a -> m (Step (WordQuotedState s b a) b)
processQuoted s
s a
x Int
n a
ql a
qr
    step (WordQuotedSkipPost b
b) a
a =
        Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (WordQuotedState s b a) b
 -> m (Step (WordQuotedState s b a) b))
-> Step (WordQuotedState s b a) b
-> m (Step (WordQuotedState s b a) b)
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not (a -> Bool
isSep a
a)
              then Int -> b -> Step (WordQuotedState s b a) b
forall s b. Int -> b -> Step s b
SDone Int
0 b
b
              else Int -> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (WordQuotedState s b a -> Step (WordQuotedState s b a) b)
-> WordQuotedState s b a -> Step (WordQuotedState s b a) b
forall a b. (a -> b) -> a -> b
$ b -> WordQuotedState s b a
forall s b a. b -> WordQuotedState s b a
WordQuotedSkipPost b
b

    err :: String -> m (Final s b)
err = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final s b -> m (Final s b))
-> (String -> Final s b) -> String -> m (Final s b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Final s b
forall s b. String -> Final s b
FError

    extract :: WordQuotedState s b a -> m (Final s b)
extract (WordQuotedSkipPre s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s
    extract (WordUnquotedWord s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s
    extract (WordQuotedWord s
s Int
n a
_ a
_) =
        if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s
        else String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"wordWithQuotes: missing frame end"
    extract WordQuotedEsc {} =
        String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"wordWithQuotes: trailing escape"
    extract (WordUnquotedEsc s
_) =
        String -> m (Final s b)
forall {s} {b}. String -> m (Final s b)
err String
"wordWithQuotes: trailing escape"
    extract (WordQuotedSkipPost b
b) = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0 b
b)

-- | 'wordWithQuotes' without processing the quotes and escape function
-- supplied to escape the quote char within a quote. Can be used to parse words
-- keeping the quotes and escapes intact.
--
-- >>> wordKeepQuotes = Parser.wordWithQuotes True (\_ _ -> Nothing)
--
{-# INLINE wordKeepQuotes #-}
wordKeepQuotes :: (Monad m, Eq a) =>
       a               -- ^ Escape char
    -> (a -> Maybe a)  -- ^ If left quote, return right quote, else Nothing.
    -> (a -> Bool)     -- ^ Matches a word separator?
    -> Fold m a b
    -> Parser a m b
wordKeepQuotes :: forall (m :: * -> *) a b.
(Monad m, Eq a) =>
a -> (a -> Maybe a) -> (a -> Bool) -> Fold m a b -> Parser a m b
wordKeepQuotes =
    -- Escape the quote char itself
    Bool
-> (a -> a -> Maybe a)
-> a
-> (a -> Maybe a)
-> (a -> Bool)
-> Fold m a b
-> Parser a m b
forall (m :: * -> *) a b.
(Monad m, Eq a) =>
Bool
-> (a -> a -> Maybe a)
-> a
-> (a -> Maybe a)
-> (a -> Bool)
-> Fold m a b
-> Parser a m b
wordWithQuotes Bool
True (\a
q a
x -> if a
q a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x then a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
Nothing)

-- See the "Quoting Rules" section in the "bash" manual page for a primer on
-- how quotes are used by shells.

-- | 'wordWithQuotes' with quote processing applied and escape function
-- supplied to escape the quote char within a quote. Can be ysed to parse words
-- and processing the quoting and escaping at the same time.
--
-- >>> wordProcessQuotes = Parser.wordWithQuotes False (\_ _ -> Nothing)
--
{-# INLINE wordProcessQuotes #-}
wordProcessQuotes :: (Monad m, Eq a) =>
        a              -- ^ Escape char
    -> (a -> Maybe a)  -- ^ If left quote, return right quote, else Nothing.
    -> (a -> Bool)     -- ^ Matches a word separator?
    -> Fold m a b
    -> Parser a m b
wordProcessQuotes :: forall (m :: * -> *) a b.
(Monad m, Eq a) =>
a -> (a -> Maybe a) -> (a -> Bool) -> Fold m a b -> Parser a m b
wordProcessQuotes =
    -- Escape the quote char itself
    Bool
-> (a -> a -> Maybe a)
-> a
-> (a -> Maybe a)
-> (a -> Bool)
-> Fold m a b
-> Parser a m b
forall (m :: * -> *) a b.
(Monad m, Eq a) =>
Bool
-> (a -> a -> Maybe a)
-> a
-> (a -> Maybe a)
-> (a -> Bool)
-> Fold m a b
-> Parser a m b
wordWithQuotes Bool
False (\a
q a
x -> if a
q a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x then a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
Nothing)

{-# ANN type GroupByState Fuse #-}
data GroupByState a s
    = GroupByInit !s
    | GroupByGrouping !a !s

-- | Given an input stream @[a,b,c,...]@ and a comparison function @cmp@, the
-- parser assigns the element @a@ to the first group, then if @a \`cmp` b@ is
-- 'True' @b@ is also assigned to the same group.  If @a \`cmp` c@ is 'True'
-- then @c@ is also assigned to the same group and so on. When the comparison
-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and
-- the result of the fold is the result of the parser.
--
-- * Stops - when the comparison fails.
-- * Fails - never.
--
-- >>> :{
--  runGroupsBy eq =
--      Stream.fold Fold.toList
--          . Stream.parseMany (Parser.groupBy eq Fold.toList)
--          . Stream.fromList
-- :}
--
-- >>> runGroupsBy (<) []
-- []
--
-- >>> runGroupsBy (<) [1]
-- [Right [1]]
--
-- >>> runGroupsBy (<) [3, 5, 4, 1, 2, 0]
-- [Right [3,5,4],Right [1,2],Right [0]]
--
{-# INLINE groupBy #-}
groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b
groupBy :: forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Parser a m b
groupBy a -> a -> Bool
eq (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) = (GroupByState a s -> a -> m (Step (GroupByState a s) b))
-> m (Initial (GroupByState a s) b)
-> (GroupByState a s -> m (Final (GroupByState a 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 GroupByState a s -> a -> m (Step (GroupByState a s) b)
step m (Initial (GroupByState a s) b)
forall {a}. m (Initial (GroupByState a s) b)
initial GroupByState a s -> m (Final (GroupByState a s) b)
forall {a} {s}. GroupByState a s -> m (Final s b)
extract

    where

    {-# INLINE grouper #-}
    grouper :: s -> a -> a -> m (Step (GroupByState a s) b)
grouper s
s a
a0 a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        Step (GroupByState a s) b -> m (Step (GroupByState a s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GroupByState a s) b -> m (Step (GroupByState a s) b))
-> Step (GroupByState a s) b -> m (Step (GroupByState a s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Done b
b -> Int -> b -> Step (GroupByState a s) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b
                  FL.Partial s
s1 -> Int -> GroupByState a s -> Step (GroupByState a s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (a -> s -> GroupByState a s
forall a s. a -> s -> GroupByState a s
GroupByGrouping a
a0 s
s1)

    initial :: m (Initial (GroupByState a s) b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        Initial (GroupByState a s) b -> m (Initial (GroupByState a s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Initial (GroupByState a s) b -> m (Initial (GroupByState a s) b))
-> Initial (GroupByState a s) b -> m (Initial (GroupByState a s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
s -> GroupByState a s -> Initial (GroupByState a s) b
forall s b. s -> Initial s b
IPartial (GroupByState a s -> Initial (GroupByState a s) b)
-> GroupByState a s -> Initial (GroupByState a s) b
forall a b. (a -> b) -> a -> b
$ s -> GroupByState a s
forall a s. s -> GroupByState a s
GroupByInit s
s
                  FL.Done b
b -> b -> Initial (GroupByState a s) b
forall s b. b -> Initial s b
IDone b
b

    step :: GroupByState a s -> a -> m (Step (GroupByState a s) b)
step (GroupByInit s
s) a
a = s -> a -> a -> m (Step (GroupByState a s) b)
forall {a}. s -> a -> a -> m (Step (GroupByState a s) b)
grouper s
s a
a a
a
    step (GroupByGrouping a
a0 s
s) a
a =
        if a -> a -> Bool
eq a
a0 a
a
        then s -> a -> a -> m (Step (GroupByState a s) b)
forall {a}. s -> a -> a -> m (Step (GroupByState a s) b)
grouper s
s a
a0 a
a
        else Int -> b -> Step (GroupByState a s) b
forall s b. Int -> b -> Step s b
SDone Int
0 (b -> Step (GroupByState a s) b)
-> m b -> m (Step (GroupByState a s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s

    extract :: GroupByState a s -> m (Final s b)
extract (GroupByInit s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s
    extract (GroupByGrouping a
_ s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s

-- | Unlike 'groupBy' this combinator performs a rolling comparison of two
-- successive elements in the input stream.  Assuming the input stream
-- is @[a,b,c,...]@ and the comparison function is @cmp@, the parser
-- first assigns the element @a@ to the first group, then if @a \`cmp` b@ is
-- 'True' @b@ is also assigned to the same group.  If @b \`cmp` c@ is 'True'
-- then @c@ is also assigned to the same group and so on. When the comparison
-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and
-- the result of the fold is the result of the parser.
--
-- * Stops - when the comparison fails.
-- * Fails - never.
--
-- >>> :{
--  runGroupsByRolling eq =
--      Stream.fold Fold.toList
--          . Stream.parseMany (Parser.groupByRolling eq Fold.toList)
--          . Stream.fromList
-- :}
--
-- >>> runGroupsByRolling (<) []
-- []
--
-- >>> runGroupsByRolling (<) [1]
-- [Right [1]]
--
-- >>> runGroupsByRolling (<) [3, 5, 4, 1, 2, 0]
-- [Right [3,5],Right [4],Right [1,2],Right [0]]
--
-- /Pre-release/
--
{-# INLINE groupByRolling #-}
groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b
groupByRolling :: forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Parser a m b
groupByRolling a -> a -> Bool
eq (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
_ s -> m b
ffinal) = (GroupByState a s -> a -> m (Step (GroupByState a s) b))
-> m (Initial (GroupByState a s) b)
-> (GroupByState a s -> m (Final (GroupByState a 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 GroupByState a s -> a -> m (Step (GroupByState a s) b)
step m (Initial (GroupByState a s) b)
forall {a}. m (Initial (GroupByState a s) b)
initial GroupByState a s -> m (Final (GroupByState a s) b)
forall {a} {s}. GroupByState a s -> m (Final s b)
extract

    where

    {-# INLINE grouper #-}
    grouper :: s -> a -> m (Step (GroupByState a s) b)
grouper s
s a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        Step (GroupByState a s) b -> m (Step (GroupByState a s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GroupByState a s) b -> m (Step (GroupByState a s) b))
-> Step (GroupByState a s) b -> m (Step (GroupByState a s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Done b
b -> Int -> b -> Step (GroupByState a s) b
forall s b. Int -> b -> Step s b
SDone Int
1 b
b
                  FL.Partial s
s1 -> Int -> GroupByState a s -> Step (GroupByState a s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (a -> s -> GroupByState a s
forall a s. a -> s -> GroupByState a s
GroupByGrouping a
a s
s1)

    initial :: m (Initial (GroupByState a s) b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        Initial (GroupByState a s) b -> m (Initial (GroupByState a s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Initial (GroupByState a s) b -> m (Initial (GroupByState a s) b))
-> Initial (GroupByState a s) b -> m (Initial (GroupByState a s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
s -> GroupByState a s -> Initial (GroupByState a s) b
forall s b. s -> Initial s b
IPartial (GroupByState a s -> Initial (GroupByState a s) b)
-> GroupByState a s -> Initial (GroupByState a s) b
forall a b. (a -> b) -> a -> b
$ s -> GroupByState a s
forall a s. s -> GroupByState a s
GroupByInit s
s
                  FL.Done b
b -> b -> Initial (GroupByState a s) b
forall s b. b -> Initial s b
IDone b
b

    step :: GroupByState a s -> a -> m (Step (GroupByState a s) b)
step (GroupByInit s
s) a
a = s -> a -> m (Step (GroupByState a s) b)
grouper s
s a
a
    step (GroupByGrouping a
a0 s
s) a
a =
        if a -> a -> Bool
eq a
a0 a
a
        then s -> a -> m (Step (GroupByState a s) b)
grouper s
s a
a
        else Int -> b -> Step (GroupByState a s) b
forall s b. Int -> b -> Step s b
SDone Int
0 (b -> Step (GroupByState a s) b)
-> m b -> m (Step (GroupByState a s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s

    extract :: GroupByState a s -> m (Final s b)
extract (GroupByInit s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s
    extract (GroupByGrouping a
_ s
s) = (b -> Final s b) -> m b -> m (Final 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 -> b -> Final s b
forall s b. Int -> b -> Final s b
FDone Int
0) (m b -> m (Final s b)) -> m b -> m (Final s b)
forall a b. (a -> b) -> a -> b
$ s -> m b
ffinal s
s

{-# ANN type GroupByStatePair Fuse #-}
data GroupByStatePair a s1 s2
    = GroupByInitPair !s1 !s2
    | GroupByGroupingPair !a !s1 !s2
    | GroupByGroupingPairL !a !s1 !s2
    | GroupByGroupingPairR !a !s1 !s2

-- | Like 'groupByRolling', but if the predicate is 'True' then collects using
-- the first fold as long as the predicate holds 'True', if the predicate is
-- 'False' collects using the second fold as long as it remains 'False'.
-- Returns 'Left' for the first case and 'Right' for the second case.
--
-- For example, if we want to detect sorted sequences in a stream, both
-- ascending and descending cases we can use 'groupByRollingEither (<=)
-- Fold.toList Fold.toList'.
--
-- /Pre-release/
{-# INLINE groupByRollingEither #-}
groupByRollingEither :: Monad m =>
    (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)
groupByRollingEither :: forall (m :: * -> *) a b c.
Monad m =>
(a -> a -> Bool)
-> Fold m a b -> Fold m a c -> Parser a m (Either b c)
groupByRollingEither
    a -> a -> Bool
eq
    (Fold s -> a -> m (Step s b)
fstep1 m (Step s b)
finitial1 s -> m b
_ s -> m b
ffinal1)
    (Fold s -> a -> m (Step s c)
fstep2 m (Step s c)
finitial2 s -> m c
_ s -> m c
ffinal2) = (GroupByStatePair a s s
 -> a -> m (Step (GroupByStatePair a s s) (Either b c)))
-> m (Initial (GroupByStatePair a s s) (Either b c))
-> (GroupByStatePair a s s
    -> m (Final (GroupByStatePair a s s) (Either b c)))
-> Parser a m (Either b 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 GroupByStatePair a s s
-> a -> m (Step (GroupByStatePair a s s) (Either b c))
step m (Initial (GroupByStatePair a s s) (Either b c))
forall {a}. m (Initial (GroupByStatePair a s s) (Either b c))
initial GroupByStatePair a s s
-> m (Final (GroupByStatePair a s s) (Either b c))
forall {s}. GroupByStatePair a s s -> m (Final s (Either b c))
extract

    where

    {-# INLINE grouper #-}
    grouper :: s1 -> s2 -> a -> m (Step (GroupByStatePair a s1 s2) b)
grouper s1
s1 s2
s2 a
a = do
        Step (GroupByStatePair a s1 s2) b
-> m (Step (GroupByStatePair a s1 s2) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByStatePair a s1 s2) b
 -> m (Step (GroupByStatePair a s1 s2) b))
-> Step (GroupByStatePair a s1 s2) b
-> m (Step (GroupByStatePair a s1 s2) b)
forall a b. (a -> b) -> a -> b
$ Int
-> GroupByStatePair a s1 s2 -> Step (GroupByStatePair a s1 s2) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (a -> s1 -> s2 -> GroupByStatePair a s1 s2
forall a s1 s2. a -> s1 -> s2 -> GroupByStatePair a s1 s2
GroupByGroupingPair a
a s1
s1 s2
s2)

    {-# INLINE grouperL2 #-}
    grouperL2 :: s -> s2 -> a -> m (Step (GroupByStatePair a s s2) (Either b b))
grouperL2 s
s1 s2
s2 a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep1 s
s1 a
a
        Step (GroupByStatePair a s s2) (Either b b)
-> m (Step (GroupByStatePair a s s2) (Either b b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GroupByStatePair a s s2) (Either b b)
 -> m (Step (GroupByStatePair a s s2) (Either b b)))
-> Step (GroupByStatePair a s s2) (Either b b)
-> m (Step (GroupByStatePair a s s2) (Either b b))
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                FL.Done b
b -> Int -> Either b b -> Step (GroupByStatePair a s s2) (Either b b)
forall s b. Int -> b -> Step s b
SDone Int
1 (b -> Either b b
forall a b. a -> Either a b
Left b
b)
                FL.Partial s
s11 -> Int
-> GroupByStatePair a s s2
-> Step (GroupByStatePair a s s2) (Either b b)
forall s b. Int -> s -> Step s b
SPartial Int
1 (a -> s -> s2 -> GroupByStatePair a s s2
forall a s1 s2. a -> s1 -> s2 -> GroupByStatePair a s1 s2
GroupByGroupingPairL a
a s
s11 s2
s2)

    {-# INLINE grouperL #-}
    grouperL :: s
-> s2 -> a -> a -> m (Step (GroupByStatePair a s s2) (Either b b))
grouperL s
s1 s2
s2 a
a0 a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep1 s
s1 a
a0
        case Step s b
res of
            FL.Done b
b -> Step (GroupByStatePair a s s2) (Either b b)
-> m (Step (GroupByStatePair a s s2) (Either b b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByStatePair a s s2) (Either b b)
 -> m (Step (GroupByStatePair a s s2) (Either b b)))
-> Step (GroupByStatePair a s s2) (Either b b)
-> m (Step (GroupByStatePair a s s2) (Either b b))
forall a b. (a -> b) -> a -> b
$ Int -> Either b b -> Step (GroupByStatePair a s s2) (Either b b)
forall s b. Int -> b -> Step s b
SDone Int
1 (b -> Either b b
forall a b. a -> Either a b
Left b
b)
            FL.Partial s
s11 -> s -> s2 -> a -> m (Step (GroupByStatePair a s s2) (Either b b))
forall {s2} {b}.
s -> s2 -> a -> m (Step (GroupByStatePair a s s2) (Either b b))
grouperL2 s
s11 s2
s2 a
a

    {-# INLINE grouperR2 #-}
    grouperR2 :: s1 -> s -> a -> m (Step (GroupByStatePair a s1 s) (Either a c))
grouperR2 s1
s1 s
s2 a
a = do
        Step s c
res <- s -> a -> m (Step s c)
fstep2 s
s2 a
a
        Step (GroupByStatePair a s1 s) (Either a c)
-> m (Step (GroupByStatePair a s1 s) (Either a c))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GroupByStatePair a s1 s) (Either a c)
 -> m (Step (GroupByStatePair a s1 s) (Either a c)))
-> Step (GroupByStatePair a s1 s) (Either a c)
-> m (Step (GroupByStatePair a s1 s) (Either a c))
forall a b. (a -> b) -> a -> b
$ case Step s c
res of
                FL.Done c
b -> Int -> Either a c -> Step (GroupByStatePair a s1 s) (Either a c)
forall s b. Int -> b -> Step s b
SDone Int
1 (c -> Either a c
forall a b. b -> Either a b
Right c
b)
                FL.Partial s
s21 -> Int
-> GroupByStatePair a s1 s
-> Step (GroupByStatePair a s1 s) (Either a c)
forall s b. Int -> s -> Step s b
SPartial Int
1 (a -> s1 -> s -> GroupByStatePair a s1 s
forall a s1 s2. a -> s1 -> s2 -> GroupByStatePair a s1 s2
GroupByGroupingPairR a
a s1
s1 s
s21)

    {-# INLINE grouperR #-}
    grouperR :: s1
-> s -> a -> a -> m (Step (GroupByStatePair a s1 s) (Either a c))
grouperR s1
s1 s
s2 a
a0 a
a = do
        Step s c
res <- s -> a -> m (Step s c)
fstep2 s
s2 a
a0
        case Step s c
res of
            FL.Done c
b -> Step (GroupByStatePair a s1 s) (Either a c)
-> m (Step (GroupByStatePair a s1 s) (Either a c))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByStatePair a s1 s) (Either a c)
 -> m (Step (GroupByStatePair a s1 s) (Either a c)))
-> Step (GroupByStatePair a s1 s) (Either a c)
-> m (Step (GroupByStatePair a s1 s) (Either a c))
forall a b. (a -> b) -> a -> b
$ Int -> Either a c -> Step (GroupByStatePair a s1 s) (Either a c)
forall s b. Int -> b -> Step s b
SDone Int
1 (c -> Either a c
forall a b. b -> Either a b
Right c
b)
            FL.Partial s
s21 -> s1 -> s -> a -> m (Step (GroupByStatePair a s1 s) (Either a c))
forall {s1} {a}.
s1 -> s -> a -> m (Step (GroupByStatePair a s1 s) (Either a c))
grouperR2 s1
s1 s
s21 a
a

    initial :: m (Initial (GroupByStatePair a s s) (Either b c))
initial = do
        Step s b
res1 <- m (Step s b)
finitial1
        Step s c
res2 <- m (Step s c)
finitial2
        Initial (GroupByStatePair a s s) (Either b c)
-> m (Initial (GroupByStatePair a s s) (Either b c))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Initial (GroupByStatePair a s s) (Either b c)
 -> m (Initial (GroupByStatePair a s s) (Either b c)))
-> Initial (GroupByStatePair a s s) (Either b c)
-> m (Initial (GroupByStatePair a s s) (Either b c))
forall a b. (a -> b) -> a -> b
$ case Step s b
res1 of
                FL.Partial s
s1 ->
                    case Step s c
res2 of
                        FL.Partial s
s2 -> GroupByStatePair a s s
-> Initial (GroupByStatePair a s s) (Either b c)
forall s b. s -> Initial s b
IPartial (GroupByStatePair a s s
 -> Initial (GroupByStatePair a s s) (Either b c))
-> GroupByStatePair a s s
-> Initial (GroupByStatePair a s s) (Either b c)
forall a b. (a -> b) -> a -> b
$ s -> s -> GroupByStatePair a s s
forall a s1 s2. s1 -> s2 -> GroupByStatePair a s1 s2
GroupByInitPair s
s1 s
s2
                        FL.Done c
b -> Either b c -> Initial (GroupByStatePair a s s) (Either b c)
forall s b. b -> Initial s b
IDone (c -> Either b c
forall a b. b -> Either a b
Right c
b)
                FL.Done b
b -> Either b c -> Initial (GroupByStatePair a s s) (Either b c)
forall s b. b -> Initial s b
IDone (b -> Either b c
forall a b. a -> Either a b
Left b
b)

    step :: GroupByStatePair a s s
-> a -> m (Step (GroupByStatePair a s s) (Either b c))
step (GroupByInitPair s
s1 s
s2) a
a = s -> s -> a -> m (Step (GroupByStatePair a s s) (Either b c))
forall {m :: * -> *} {s1} {s2} {a} {b}.
Monad m =>
s1 -> s2 -> a -> m (Step (GroupByStatePair a s1 s2) b)
grouper s
s1 s
s2 a
a

    step (GroupByGroupingPair a
a0 s
s1 s
s2) a
a =
        if Bool -> Bool
not (a -> a -> Bool
eq a
a0 a
a)
        then s -> s -> a -> a -> m (Step (GroupByStatePair a s s) (Either b c))
forall {s2} {b}.
s
-> s2 -> a -> a -> m (Step (GroupByStatePair a s s2) (Either b b))
grouperL s
s1 s
s2 a
a0 a
a
        else s -> s -> a -> a -> m (Step (GroupByStatePair a s s) (Either b c))
forall {s1} {a}.
s1
-> s -> a -> a -> m (Step (GroupByStatePair a s1 s) (Either a c))
grouperR s
s1 s
s2 a
a0 a
a

    step (GroupByGroupingPairL a
a0 s
s1 s
s2) a
a =
        if Bool -> Bool
not (a -> a -> Bool
eq a
a0 a
a)
        then s -> s -> a -> m (Step (GroupByStatePair a s s) (Either b c))
forall {s2} {b}.
s -> s2 -> a -> m (Step (GroupByStatePair a s s2) (Either b b))
grouperL2 s
s1 s
s2 a
a
        else Int -> Either b c -> Step (GroupByStatePair a s s) (Either b c)
forall s b. Int -> b -> Step s b
SDone Int
0 (Either b c -> Step (GroupByStatePair a s s) (Either b c))
-> (b -> Either b c)
-> b
-> Step (GroupByStatePair a s s) (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b c
forall a b. a -> Either a b
Left (b -> Step (GroupByStatePair a s s) (Either b c))
-> m b -> m (Step (GroupByStatePair a s s) (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal1 s
s1

    step (GroupByGroupingPairR a
a0 s
s1 s
s2) a
a =
        if a -> a -> Bool
eq a
a0 a
a
        then s -> s -> a -> m (Step (GroupByStatePair a s s) (Either b c))
forall {s1} {a}.
s1 -> s -> a -> m (Step (GroupByStatePair a s1 s) (Either a c))
grouperR2 s
s1 s
s2 a
a
        else Int -> Either b c -> Step (GroupByStatePair a s s) (Either b c)
forall s b. Int -> b -> Step s b
SDone Int
0 (Either b c -> Step (GroupByStatePair a s s) (Either b c))
-> (c -> Either b c)
-> c
-> Step (GroupByStatePair a s s) (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right (c -> Step (GroupByStatePair a s s) (Either b c))
-> m c -> m (Step (GroupByStatePair a s s) (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
ffinal2 s
s2

    extract :: GroupByStatePair a s s -> m (Final s (Either b c))
extract (GroupByInitPair s
s1 s
_) = Int -> Either b c -> Final s (Either b c)
forall s b. Int -> b -> Final s b
FDone Int
0 (Either b c -> Final s (Either b c))
-> (b -> Either b c) -> b -> Final s (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b c
forall a b. a -> Either a b
Left (b -> Final s (Either b c)) -> m b -> m (Final s (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal1 s
s1
    extract (GroupByGroupingPairL a
_ s
s1 s
_) = Int -> Either b c -> Final s (Either b c)
forall s b. Int -> b -> Final s b
FDone Int
0 (Either b c -> Final s (Either b c))
-> (b -> Either b c) -> b -> Final s (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b c
forall a b. a -> Either a b
Left (b -> Final s (Either b c)) -> m b -> m (Final s (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal1 s
s1
    extract (GroupByGroupingPairR a
_ s
_ s
s2) = Int -> Either b c -> Final s (Either b c)
forall s b. Int -> b -> Final s b
FDone Int
0 (Either b c -> Final s (Either b c))
-> (c -> Either b c) -> c -> Final s (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right (c -> Final s (Either b c)) -> m c -> m (Final s (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
ffinal2 s
s2
    extract (GroupByGroupingPair a
a s
s1 s
_) = do
                Step s b
res <- s -> a -> m (Step s b)
fstep1 s
s1 a
a
                case Step s b
res of
                    FL.Done b
b -> Final s (Either b c) -> m (Final s (Either b c))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final s (Either b c) -> m (Final s (Either b c)))
-> Final s (Either b c) -> m (Final s (Either b c))
forall a b. (a -> b) -> a -> b
$ Int -> Either b c -> Final s (Either b c)
forall s b. Int -> b -> Final s b
FDone Int
0 (b -> Either b c
forall a b. a -> Either a b
Left b
b)
                    FL.Partial s
s11 -> Int -> Either b c -> Final s (Either b c)
forall s b. Int -> b -> Final s b
FDone Int
0 (Either b c -> Final s (Either b c))
-> (b -> Either b c) -> b -> Final s (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b c
forall a b. a -> Either a b
Left (b -> Final s (Either b c)) -> m b -> m (Final s (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal1 s
s11

-- XXX use an Unfold instead of a list?
-- XXX custom combinators for matching list, array and stream?
-- XXX rename to listBy?

-- | Match the given sequence of elements using the given comparison function.
-- Returns the original sequence if successful.
--
-- Definition:
--
-- >>> listEqBy cmp xs = Parser.streamEqBy cmp (Stream.fromList xs) *> Parser.fromPure xs
--
-- Examples:
--
-- >>> Stream.parse (Parser.listEqBy (==) "string") $ Stream.fromList "string"
-- Right "string"
--
-- >>> Stream.parsePos (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match"
-- Left (ParseErrorPos 2 "streamEqBy: mismtach occurred")
--
{-# INLINE listEqBy #-}
listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]
listEqBy :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> [a] -> Parser a m [a]
listEqBy a -> a -> Bool
cmp [a]
xs = (a -> a -> Bool) -> Stream m a -> Parser a m ()
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> Stream m a -> Parser a m ()
streamEqByInternal a -> a -> Bool
cmp ([a] -> Stream m a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs) Parser a m () -> Parser a m [a] -> Parser a m [a]
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
*> [a] -> Parser a m [a]
forall (m :: * -> *) b a. Monad m => b -> Parser a m b
fromPure [a]
xs
{-
listEqBy cmp str = Parser step initial extract

    where

    -- XXX Should return IDone in initial for [] case
    initial = return $ IPartial str

    step [] _ = return $ SDone 1 str
    step [x] a =
        return
            $ if x `cmp` a
              then SDone 1 str
              else SError "listEqBy: failed, yet to match the last element"
    step (x:xs) a =
        return
            $ if x `cmp` a
              then SContinue 1 xs
              else SError
                       $ "listEqBy: failed, yet to match "
                       ++ show (length xs + 1) ++ " elements"

    extract xs =
        return
            $ SError
            $ "listEqBy: end of input, yet to match "
            ++ show (length xs) ++ " elements"
-}

{-# INLINE streamEqByInternal #-}
streamEqByInternal :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()
streamEqByInternal :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> Stream m a -> Parser a m ()
streamEqByInternal a -> a -> Bool
cmp (D.Stream State StreamK m a -> s -> m (Step s a)
sstep s
state) = ((Maybe' a, s) -> a -> m (Step (Maybe' a, s) ()))
-> m (Initial (Maybe' a, s) ())
-> ((Maybe' a, s) -> m (Final (Maybe' a, s) ()))
-> Parser a m ()
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 (Maybe' a, s) -> a -> m (Step (Maybe' a, s) ())
step m (Initial (Maybe' a, s) ())
initial (Maybe' a, s) -> m (Final (Maybe' a, s) ())
forall {m :: * -> *} {p} {s} {b}. Monad m => p -> m (Final s b)
extract

    where

    initial :: m (Initial (Maybe' a, s) ())
initial = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
sstep State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
state
        case Step s a
r of
            D.Yield a
x s
s -> Initial (Maybe' a, s) () -> m (Initial (Maybe' a, s) ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Maybe' a, s) () -> m (Initial (Maybe' a, s) ()))
-> Initial (Maybe' a, s) () -> m (Initial (Maybe' a, s) ())
forall a b. (a -> b) -> a -> b
$ (Maybe' a, s) -> Initial (Maybe' a, s) ()
forall s b. s -> Initial s b
IPartial (a -> Maybe' a
forall a. a -> Maybe' a
Just' a
x, s
s)
            Step s a
D.Stop -> Initial (Maybe' a, s) () -> m (Initial (Maybe' a, s) ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Maybe' a, s) () -> m (Initial (Maybe' a, s) ()))
-> Initial (Maybe' a, s) () -> m (Initial (Maybe' a, s) ())
forall a b. (a -> b) -> a -> b
$ () -> Initial (Maybe' a, s) ()
forall s b. b -> Initial s b
IDone ()
            -- Need Skip/Continue in initial to loop right here
            D.Skip s
s -> Initial (Maybe' a, s) () -> m (Initial (Maybe' a, s) ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Maybe' a, s) () -> m (Initial (Maybe' a, s) ()))
-> Initial (Maybe' a, s) () -> m (Initial (Maybe' a, s) ())
forall a b. (a -> b) -> a -> b
$ (Maybe' a, s) -> Initial (Maybe' a, s) ()
forall s b. s -> Initial s b
IPartial (Maybe' a
forall a. Maybe' a
Nothing', s
s)

    step :: (Maybe' a, s) -> a -> m (Step (Maybe' a, s) ())
step (Just' a
x, s
st) a
a =
        if a
x a -> a -> Bool
`cmp` a
a
          then do
            Step s a
r <- State StreamK m a -> s -> m (Step s a)
sstep State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
            Step (Maybe' a, s) () -> m (Step (Maybe' a, s) ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                (Step (Maybe' a, s) () -> m (Step (Maybe' a, s) ()))
-> Step (Maybe' a, s) () -> m (Step (Maybe' a, s) ())
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
                    D.Yield a
x1 s
s -> Int -> (Maybe' a, s) -> Step (Maybe' a, s) ()
forall s b. Int -> s -> Step s b
SContinue Int
1 (a -> Maybe' a
forall a. a -> Maybe' a
Just' a
x1, s
s)
                    Step s a
D.Stop -> Int -> () -> Step (Maybe' a, s) ()
forall s b. Int -> b -> Step s b
SDone Int
1 ()
                    D.Skip s
s -> Int -> (Maybe' a, s) -> Step (Maybe' a, s) ()
forall s b. Int -> s -> Step s b
SContinue Int
0 (Maybe' a
forall a. Maybe' a
Nothing', s
s)
          else Step (Maybe' a, s) () -> m (Step (Maybe' a, s) ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a, s) () -> m (Step (Maybe' a, s) ()))
-> Step (Maybe' a, s) () -> m (Step (Maybe' a, s) ())
forall a b. (a -> b) -> a -> b
$ String -> Step (Maybe' a, s) ()
forall s b. String -> Step s b
SError String
"streamEqBy: mismtach occurred"
    step (Maybe' a
Nothing', s
st) a
a = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
sstep State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        Step (Maybe' a, s) () -> m (Step (Maybe' a, s) ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (Maybe' a, s) () -> m (Step (Maybe' a, s) ()))
-> Step (Maybe' a, s) () -> m (Step (Maybe' a, s) ())
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
                D.Yield a
x s
s -> do
                    if a
x a -> a -> Bool
`cmp` a
a
                    then Int -> (Maybe' a, s) -> Step (Maybe' a, s) ()
forall s b. Int -> s -> Step s b
SContinue Int
1 (Maybe' a
forall a. Maybe' a
Nothing', s
s)
                    else String -> Step (Maybe' a, s) ()
forall s b. String -> Step s b
SError String
"streamEqBy: mismatch occurred"
                Step s a
D.Stop -> Int -> () -> Step (Maybe' a, s) ()
forall s b. Int -> b -> Step s b
SDone Int
0 ()
                D.Skip s
s -> Int -> (Maybe' a, s) -> Step (Maybe' a, s) ()
forall s b. Int -> s -> Step s b
SContinue Int
0 (Maybe' a
forall a. Maybe' a
Nothing', s
s)

    extract :: p -> m (Final s b)
extract p
_ = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
"streamEqBy: end of input"

-- | Like 'listEqBy' but uses a stream instead of a list and does not return
-- the stream.
--
{-# INLINE streamEqBy #-}
streamEqBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()
-- XXX Somehow composing this with "*>" is much faster on the microbenchmark.
-- Need to investigate why.
streamEqBy :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> Stream m a -> Parser a m ()
streamEqBy a -> a -> Bool
cmp Stream m a
stream = (a -> a -> Bool) -> Stream m a -> Parser a m ()
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> Stream m a -> Parser a m ()
streamEqByInternal a -> a -> Bool
cmp Stream m a
stream Parser a m () -> Parser a m () -> Parser a m ()
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
*> () -> Parser a m ()
forall (m :: * -> *) b a. Monad m => b -> Parser a m b
fromPure ()

-- Rename to "list".
-- | Match the input sequence with the supplied list and return it if
-- successful.
--
-- >>> listEq = Parser.listEqBy (==)
--
{-# INLINE listEq #-}
listEq :: (Monad m, Eq a) => [a] -> Parser a m [a]
listEq :: forall (m :: * -> *) a. (Monad m, Eq a) => [a] -> Parser a m [a]
listEq = (a -> a -> Bool) -> [a] -> Parser a m [a]
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> [a] -> Parser a m [a]
listEqBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Match if the input stream is a subsequence of the argument stream i.e. all
-- the elements of the input stream occur, in order, in the argument stream.
-- The elements do not have to occur consecutively. A sequence is considered a
-- subsequence of itself.
{-# INLINE subsequenceBy #-}
subsequenceBy :: -- Monad m =>
    (a -> a -> Bool) -> Stream m a -> Parser a m ()
subsequenceBy :: forall a (m :: * -> *).
(a -> a -> Bool) -> Stream m a -> Parser a m ()
subsequenceBy = (a -> a -> Bool) -> Stream m a -> Parser a m ()
forall a. HasCallStack => a
undefined

{-
-- Should go in Data.Parser.Regex in streamly package so that it can depend on
-- regex backends.
{-# INLINE regexPosix #-}
regexPosix :: -- Monad m =>
    Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))
regexPosix = undefined

{-# INLINE regexPCRE #-}
regexPCRE :: -- Monad m =>
    Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))
regexPCRE = undefined
-}

-------------------------------------------------------------------------------
-- Transformations on input
-------------------------------------------------------------------------------

-- Initial needs a "Continue" constructor to implement scans on parsers. As a
-- parser can always return a Continue in initial when we feed the fold's
-- initial result to it. We can work this around for postscan by introducing an
-- initial state and calling "initial" only on the first input.

-- | Stateful scan on the input of a parser using a Fold.
--
-- /Unimplemented/
--
{-# INLINE postscan #-}
postscan :: -- Monad m =>
    Fold m a b -> Parser b m c -> Parser a m c
postscan :: forall (m :: * -> *) a b c.
Fold m a b -> Parser b m c -> Parser a m c
postscan = Fold m a b -> Parser b m c -> Parser a m c
forall a. HasCallStack => a
undefined

{-# INLINE zipWithM #-}
zipWithM :: Monad m =>
    (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser b m x
zipWithM :: forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> m c) -> Stream m a -> Fold m c x -> Parser b m x
zipWithM a -> b -> m c
zf (D.Stream State StreamK m a -> s -> m (Step s a)
sstep s
state) (Fold s -> c -> m (Step s x)
fstep m (Step s x)
finitial s -> m x
_ s -> m x
ffinal) =
    ((Maybe' a, s, s) -> b -> m (Step (Maybe' a, s, s) x))
-> m (Initial (Maybe' a, s, s) x)
-> ((Maybe' a, s, s) -> m (Final (Maybe' a, s, s) x))
-> Parser b m x
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 (Maybe' a, s, s) -> b -> m (Step (Maybe' a, s, s) x)
step m (Initial (Maybe' a, s, s) x)
initial (Maybe' a, s, s) -> m (Final (Maybe' a, s, s) x)
forall {m :: * -> *} {p} {s} {b}. Monad m => p -> m (Final s b)
extract

    where

    initial :: m (Initial (Maybe' a, s, s) x)
initial = do
        Step s x
fres <- m (Step s x)
finitial
        case Step s x
fres of
            FL.Partial s
fs -> do
                Step s a
r <- State StreamK m a -> s -> m (Step s a)
sstep State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
state
                case Step s a
r of
                    D.Yield a
x s
s -> Initial (Maybe' a, s, s) x -> m (Initial (Maybe' a, s, s) x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Maybe' a, s, s) x -> m (Initial (Maybe' a, s, s) x))
-> Initial (Maybe' a, s, s) x -> m (Initial (Maybe' a, s, s) x)
forall a b. (a -> b) -> a -> b
$ (Maybe' a, s, s) -> Initial (Maybe' a, s, s) x
forall s b. s -> Initial s b
IPartial (a -> Maybe' a
forall a. a -> Maybe' a
Just' a
x, s
s, s
fs)
                    Step s a
D.Stop -> do
                        x
x <- s -> m x
ffinal s
fs
                        Initial (Maybe' a, s, s) x -> m (Initial (Maybe' a, s, s) x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Maybe' a, s, s) x -> m (Initial (Maybe' a, s, s) x))
-> Initial (Maybe' a, s, s) x -> m (Initial (Maybe' a, s, s) x)
forall a b. (a -> b) -> a -> b
$ x -> Initial (Maybe' a, s, s) x
forall s b. b -> Initial s b
IDone x
x
                    -- Need Skip/Continue in initial to loop right here
                    D.Skip s
s -> Initial (Maybe' a, s, s) x -> m (Initial (Maybe' a, s, s) x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Maybe' a, s, s) x -> m (Initial (Maybe' a, s, s) x))
-> Initial (Maybe' a, s, s) x -> m (Initial (Maybe' a, s, s) x)
forall a b. (a -> b) -> a -> b
$ (Maybe' a, s, s) -> Initial (Maybe' a, s, s) x
forall s b. s -> Initial s b
IPartial (Maybe' a
forall a. Maybe' a
Nothing', s
s, s
fs)
            FL.Done x
x -> Initial (Maybe' a, s, s) x -> m (Initial (Maybe' a, s, s) x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Maybe' a, s, s) x -> m (Initial (Maybe' a, s, s) x))
-> Initial (Maybe' a, s, s) x -> m (Initial (Maybe' a, s, s) x)
forall a b. (a -> b) -> a -> b
$ x -> Initial (Maybe' a, s, s) x
forall s b. b -> Initial s b
IDone x
x

    step :: (Maybe' a, s, s) -> b -> m (Step (Maybe' a, s, s) x)
step (Just' a
a, s
st, s
fs) b
b = do
        c
c <- a -> b -> m c
zf a
a b
b
        Step s x
fres <- s -> c -> m (Step s x)
fstep s
fs c
c
        case Step s x
fres of
            FL.Partial s
fs1 -> do
                Step s a
r <- State StreamK m a -> s -> m (Step s a)
sstep State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
                case Step s a
r of
                    D.Yield a
x1 s
s -> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x))
-> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a b. (a -> b) -> a -> b
$ Int -> (Maybe' a, s, s) -> Step (Maybe' a, s, s) x
forall s b. Int -> s -> Step s b
SContinue Int
1 (a -> Maybe' a
forall a. a -> Maybe' a
Just' a
x1, s
s, s
fs1)
                    Step s a
D.Stop -> do
                        x
x <- s -> m x
ffinal s
fs1
                        Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x))
-> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a b. (a -> b) -> a -> b
$ Int -> x -> Step (Maybe' a, s, s) x
forall s b. Int -> b -> Step s b
SDone Int
1 x
x
                    D.Skip s
s -> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x))
-> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a b. (a -> b) -> a -> b
$ Int -> (Maybe' a, s, s) -> Step (Maybe' a, s, s) x
forall s b. Int -> s -> Step s b
SContinue Int
0 (Maybe' a
forall a. Maybe' a
Nothing', s
s, s
fs1)
            FL.Done x
x -> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x))
-> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a b. (a -> b) -> a -> b
$ Int -> x -> Step (Maybe' a, s, s) x
forall s b. Int -> b -> Step s b
SDone Int
1 x
x
    step (Maybe' a
Nothing', s
st, s
fs) b
b = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
sstep State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s a
r of
                D.Yield a
a s
s -> do
                    c
c <- a -> b -> m c
zf a
a b
b
                    Step s x
fres <- s -> c -> m (Step s x)
fstep s
fs c
c
                    case Step s x
fres of
                        FL.Partial s
fs1 ->
                            Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x))
-> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a b. (a -> b) -> a -> b
$ Int -> (Maybe' a, s, s) -> Step (Maybe' a, s, s) x
forall s b. Int -> s -> Step s b
SContinue Int
1 (Maybe' a
forall a. Maybe' a
Nothing', s
s, s
fs1)
                        FL.Done x
x -> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x))
-> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a b. (a -> b) -> a -> b
$ Int -> x -> Step (Maybe' a, s, s) x
forall s b. Int -> b -> Step s b
SDone Int
1 x
x
                Step s a
D.Stop -> do
                    x
x <- s -> m x
ffinal s
fs
                    Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x))
-> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a b. (a -> b) -> a -> b
$ Int -> x -> Step (Maybe' a, s, s) x
forall s b. Int -> b -> Step s b
SDone Int
0 x
x
                D.Skip s
s -> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x))
-> Step (Maybe' a, s, s) x -> m (Step (Maybe' a, s, s) x)
forall a b. (a -> b) -> a -> b
$ Int -> (Maybe' a, s, s) -> Step (Maybe' a, s, s) x
forall s b. Int -> s -> Step s b
SContinue Int
0 (Maybe' a
forall a. Maybe' a
Nothing', s
s, s
fs)

    extract :: p -> m (Final s b)
extract p
_ = Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (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
"zipWithM: end of input"

-- | Zip the input of a fold with a stream.
--
-- /Pre-release/
--
{-# INLINE zip #-}
zip :: Monad m => D.Stream m a -> Fold m (a, b) x -> Parser b m x
zip :: forall (m :: * -> *) a b x.
Monad m =>
Stream m a -> Fold m (a, b) x -> Parser b m x
zip = (a -> b -> m (a, b))
-> Stream m a -> Fold m (a, b) x -> Parser b m x
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> m c) -> Stream m a -> Fold m c x -> Parser b m x
zipWithM (((a, b) -> m (a, b)) -> a -> b -> m (a, b)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, b) -> m (a, b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | Pair each element of a fold input with its index, starting from index 0.
--
-- /Pre-release/
{-# INLINE indexed #-}
indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser a m b
indexed :: forall (m :: * -> *) a b.
Monad m =>
Fold m (Int, a) b -> Parser a m b
indexed = Stream m Int -> Fold m (Int, a) b -> Parser a m b
forall (m :: * -> *) a b x.
Monad m =>
Stream m a -> Fold m (a, b) x -> Parser b m x
zip (Int -> Stream m Int
forall (m :: * -> *) a.
(Monad m, Integral a, Bounded a) =>
a -> Stream m a
D.enumerateFromIntegral Int
0 :: D.Stream m Int)

-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering
-- function using a fold indexing function that attaches an index to each input
-- element and a filtering function that filters using @(index, element) ->
-- Bool) as predicate.
--
-- For example:
--
-- @
-- filterWithIndex = makeIndexFilter indexed filter
-- filterWithAbsTime = makeIndexFilter timestamped filter
-- filterWithRelTime = makeIndexFilter timeIndexed filter
-- @
--
-- /Pre-release/
{-# INLINE makeIndexFilter #-}
makeIndexFilter ::
       (Fold m (s, a) b -> Parser a m b)
    -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
    -> (((s, a) -> Bool) -> Fold m a b -> Parser a m b)
makeIndexFilter :: forall (m :: * -> *) s a b.
(Fold m (s, a) b -> Parser a m b)
-> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
-> ((s, a) -> Bool)
-> Fold m a b
-> Parser a m b
makeIndexFilter Fold m (s, a) b -> Parser a m b
f ((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b
comb (s, a) -> Bool
g = Fold m (s, a) b -> Parser a m b
f (Fold m (s, a) b -> Parser a m b)
-> (Fold m a b -> Fold m (s, a) b) -> Fold m a b -> Parser a m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b
comb (s, a) -> Bool
g (Fold m (s, a) b -> Fold m (s, a) b)
-> (Fold m a b -> Fold m (s, a) b) -> Fold m a b -> Fold m (s, a) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s, a) -> a) -> Fold m a b -> Fold m (s, a) b
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
FL.lmap (s, a) -> a
forall a b. (a, b) -> b
snd

-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
-- then every element at strides of @stride@.
--
-- /Pre-release/
{-# INLINE sampleFromthen #-}
sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser a m b
sampleFromthen :: forall (m :: * -> *) a b.
Monad m =>
Int -> Int -> Fold m a b -> Parser a m b
sampleFromthen Int
offset Int
size =
    (Fold m (Int, a) b -> Parser a m b)
-> (((Int, a) -> Bool) -> Fold m (Int, a) b -> Fold m (Int, a) b)
-> ((Int, a) -> Bool)
-> Fold m a b
-> Parser a m b
forall (m :: * -> *) s a b.
(Fold m (s, a) b -> Parser a m b)
-> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)
-> ((s, a) -> Bool)
-> Fold m a b
-> Parser a m b
makeIndexFilter Fold m (Int, a) b -> Parser a m b
forall (m :: * -> *) a b.
Monad m =>
Fold m (Int, a) b -> Parser a m b
indexed ((Int, a) -> Bool) -> Fold m (Int, a) b -> Fold m (Int, a) b
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Fold m a r -> Fold m a r
FL.filter (\(Int
i, a
_) -> (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)

--------------------------------------------------------------------------------
--- Spanning
--------------------------------------------------------------------------------

-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
-- input as long as the predicate @p@ is 'True'.  @f2@ consumes the rest of the
-- input.
--
-- @
-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs
--
-- > span_ (< 1) [1,2,3]
-- ([],[1,2,3])
--
-- > span_ (< 2) [1,2,3]
-- ([1],[2,3])
--
-- > span_ (< 4) [1,2,3]
-- ([1,2,3],[])
--
-- @
--
-- /Pre-release/
{-# INLINE span #-}
span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
span :: forall (m :: * -> *) a b c.
Monad m =>
(a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
span a -> Bool
p Fold m a b
f1 Fold m a c
f2 = (b -> c -> (b, c))
-> Parser a m b -> Parser a m c -> Parser a m (b, c)
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 -> Bool) -> Fold m a b -> Parser a m b
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Parser a m b
takeWhile a -> Bool
p Fold m a b
f1) (Fold m a c -> Parser a m c
forall (m :: * -> *) a b. Monad m => Fold m a b -> Parser a m b
fromFold Fold m a c
f2)

-- | Break the input stream into two groups, the first group takes the input as
-- long as the predicate applied to the first element of the stream and next
-- input element holds 'True', the second group takes the rest of the input.
--
-- /Pre-release/
--
{-# INLINE spanBy #-}
spanBy ::
       Monad m
    => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
spanBy :: forall (m :: * -> *) a b c.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
spanBy a -> a -> Bool
eq Fold m a b
f1 Fold m a c
f2 = (b -> c -> (b, c))
-> Parser a m b -> Parser a m c -> Parser a m (b, c)
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 -> a -> Bool) -> Fold m a b -> Parser a m b
forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Parser a m b
groupBy a -> a -> Bool
eq Fold m a b
f1) (Fold m a c -> Parser a m c
forall (m :: * -> *) a b. Monad m => Fold m a b -> Parser a m b
fromFold Fold m a c
f2)

-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
-- predicate is applied to the previous and the next input elements.
--
-- /Pre-release/
{-# INLINE spanByRolling #-}
spanByRolling ::
       Monad m
    => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
spanByRolling :: forall (m :: * -> *) a b c.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)
spanByRolling a -> a -> Bool
eq Fold m a b
f1 Fold m a c
f2 =
    (b -> c -> (b, c))
-> Parser a m b -> Parser a m c -> Parser a m (b, c)
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 -> a -> Bool) -> Fold m a b -> Parser a m b
forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Parser a m b
groupByRolling a -> a -> Bool
eq Fold m a b
f1) (Fold m a c -> Parser a m c
forall (m :: * -> *) a b. Monad m => Fold m a b -> Parser a m b
fromFold Fold m a c
f2)

-------------------------------------------------------------------------------
-- nested parsers
-------------------------------------------------------------------------------

-- | Takes at-most @n@ input elements.
--
-- * Stops - when the collecting parser stops.
-- * Fails - when the collecting parser fails.
--
-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 2 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
-- Right [1,2]
--
-- >>> Stream.parsePos (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]
-- Left (ParseErrorPos 4 "takeEQ: Expecting exactly 5 elements, input terminated on 4")
--
-- /Internal/
{-# INLINE takeP #-}
takeP :: Monad m => Int -> Parser a m b -> Parser a m b
takeP :: forall (m :: * -> *) a b.
Monad m =>
Int -> Parser a m b -> Parser a m b
takeP Int
lim (Parser s -> a -> m (Step s b)
pstep m (Initial s b)
pinitial s -> m (Final s b)
pextract) = (Tuple' Int s -> a -> m (Step (Tuple' Int s) b))
-> m (Initial (Tuple' Int s) b)
-> (Tuple' Int s -> m (Final (Tuple' Int 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 Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step m (Initial (Tuple' Int s) b)
initial Tuple' Int s -> m (Final (Tuple' Int s) b)
extract

    where

    initial :: m (Initial (Tuple' Int s) b)
initial = do
        Initial s b
res <- m (Initial s b)
pinitial
        case Initial s b
res of
            IPartial s
s ->
                if Int
lim Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                then Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b))
-> Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ Tuple' Int s -> Initial (Tuple' Int s) b
forall s b. s -> Initial s b
IPartial (Tuple' Int s -> Initial (Tuple' Int s) b)
-> Tuple' Int s -> Initial (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
0 s
s
                else s -> m (Initial (Tuple' Int s) b)
forall {s}. s -> m (Initial s b)
iextract s
s
            IDone b
b -> Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b))
-> Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ b -> Initial (Tuple' Int s) b
forall s b. b -> Initial s b
IDone b
b
            IError String
e -> Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b))
-> Initial (Tuple' Int s) b -> m (Initial (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ String -> Initial (Tuple' Int s) b
forall s b. String -> Initial s b
IError String
e

    step :: Tuple' Int s -> a -> m (Step (Tuple' Int s) b)
step (Tuple' Int
cnt s
r) a
a = do
        assertM(Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lim)
        Step s b
res <- s -> a -> m (Step s b)
pstep s
r a
a
        case Step s b
res of
            SPartial Int
1 s
s -> do
                let cnt1 :: Int
cnt1 = Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                assertM(Int
cnt1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
                if Int
cnt1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lim
                then Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
SPartial Int
1 (Tuple' Int s -> Step (Tuple' Int s) b)
-> Tuple' Int s -> Step (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
cnt1 s
s
                else do
                    Final s b
r1 <- s -> m (Final s b)
pextract s
s
                    Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Final s b
r1 of
                        FDone Int
n b
b -> Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
SDone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) b
b
                        FContinue Int
n s
s1 -> Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
SContinue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
s1)
                        FError String
err -> String -> Step (Tuple' Int s) b
forall s b. String -> Step s b
SError String
err

            SContinue Int
1 s
s -> do
                let cnt1 :: Int
cnt1 = Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                assertM(Int
cnt1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
                if Int
cnt1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lim
                then Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
SContinue Int
1 (Tuple' Int s -> Step (Tuple' Int s) b)
-> Tuple' Int s -> Step (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
cnt1 s
s
                else do
                    Final s b
r1 <- s -> m (Final s b)
pextract s
s
                    Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Final s b
r1 of
                        FDone Int
n b
b -> Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
SDone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) b
b
                        FContinue Int
n s
s1 -> Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
SContinue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
s1)
                        FError String
err -> String -> Step (Tuple' Int s) b
forall s b. String -> Step s b
SError String
err
            SPartial Int
n s
s -> do
                let taken :: Int
taken = Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                assertM(Int
taken Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
                Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
SPartial Int
n (Tuple' Int s -> Step (Tuple' Int s) b)
-> Tuple' Int s -> Step (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
taken s
s
            SContinue Int
n s
s -> do
                let taken :: Int
taken = Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                assertM(Int
taken Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
                Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ Int -> Tuple' Int s -> Step (Tuple' Int s) b
forall s b. Int -> s -> Step s b
SContinue Int
n (Tuple' Int s -> Step (Tuple' Int s) b)
-> Tuple' Int s -> Step (Tuple' Int s) b
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' Int
taken s
s
            SDone Int
n b
b -> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step (Tuple' Int s) b
forall s b. Int -> b -> Step s b
SDone Int
n b
b
            SError String
str -> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b))
-> Step (Tuple' Int s) b -> m (Step (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ String -> Step (Tuple' Int s) b
forall s b. String -> Step s b
SError String
str

    extract :: Tuple' Int s -> m (Final (Tuple' Int s) b)
extract (Tuple' Int
cnt s
r) = do
        Final s b
r1 <- s -> m (Final s b)
pextract s
r
        Final (Tuple' Int s) b -> m (Final (Tuple' Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (Tuple' Int s) b -> m (Final (Tuple' Int s) b))
-> Final (Tuple' Int s) b -> m (Final (Tuple' Int s) b)
forall a b. (a -> b) -> a -> b
$ case Final s b
r1 of
            FDone Int
n b
b -> Int -> b -> Final (Tuple' Int s) b
forall s b. Int -> b -> Final s b
FDone Int
n b
b
            FContinue Int
n s
s1 -> Int -> Tuple' Int s -> Final (Tuple' Int s) b
forall s b. Int -> s -> Final s b
FContinue Int
n (Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
s1)
            FError String
err -> String -> Final (Tuple' Int s) b
forall s b. String -> Final s b
FError String
err

    -- XXX Need to make the Initial type Step to remove this
    iextract :: s -> m (Initial s b)
iextract s
s = do
        Final s b
r <- s -> m (Final s b)
pextract s
s
        Initial s b -> m (Initial s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial s b -> m (Initial s b)) -> Initial s b -> m (Initial s b)
forall a b. (a -> b) -> a -> b
$ case Final s b
r of
            FDone Int
_ b
b -> b -> Initial s b
forall s b. b -> Initial s b
IDone b
b
            FError String
err -> String -> Initial s b
forall s b. String -> Initial s b
IError String
err
            Final s b
_ -> String -> Initial s b
forall a. HasCallStack => String -> a
error String
"Bug: takeP invalid state in initial"

-- | Run a parser without consuming the input.
--
{-# INLINE lookAhead #-}
lookAhead :: Monad m => Parser a m b -> Parser a m b
lookAhead :: forall (m :: * -> *) a b. Monad m => Parser a m b -> Parser a m b
lookAhead (Parser s -> a -> m (Step s b)
step1 m (Initial s b)
initial1 s -> m (Final s b)
_) = (Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b))
-> m (Initial (Tuple'Fused Int s) b)
-> (Tuple'Fused Int s -> m (Final (Tuple'Fused Int 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 Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b)
step m (Initial (Tuple'Fused Int s) b)
initial Tuple'Fused Int s -> m (Final (Tuple'Fused Int s) b)
forall {m :: * -> *} {a} {b} {s} {b}.
(Monad m, Show a) =>
Tuple'Fused a b -> m (Final s b)
extract

    where

    initial :: m (Initial (Tuple'Fused Int s) b)
initial = do
        Initial s b
res <- m (Initial s b)
initial1
        Initial (Tuple'Fused Int s) b -> m (Initial (Tuple'Fused Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Tuple'Fused Int s) b
 -> m (Initial (Tuple'Fused Int s) b))
-> Initial (Tuple'Fused Int s) b
-> m (Initial (Tuple'Fused Int s) b)
forall a b. (a -> b) -> a -> b
$ case Initial s b
res of
            IPartial s
s -> Tuple'Fused Int s -> Initial (Tuple'Fused Int s) b
forall s b. s -> Initial s b
IPartial (Int -> s -> Tuple'Fused Int s
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused Int
0 s
s)
            IDone b
b -> b -> Initial (Tuple'Fused Int s) b
forall s b. b -> Initial s b
IDone b
b
            IError String
e -> String -> Initial (Tuple'Fused Int s) b
forall s b. String -> Initial s b
IError String
e

    step :: Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b)
step (Tuple'Fused Int
cnt s
st) a
a = do
        Step s b
r <- s -> a -> m (Step s b)
step1 s
st a
a
        Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b))
-> Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
                  SPartial Int
n s
s -> Int -> Tuple'Fused Int s -> Step (Tuple'Fused Int s) b
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> Tuple'Fused Int s
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
s)
                  SContinue Int
n s
s -> Int -> Tuple'Fused Int s -> Step (Tuple'Fused Int s) b
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> Tuple'Fused Int s
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
s)
                  SDone Int
_ b
b -> Int -> b -> Step (Tuple'Fused Int s) b
forall s b. Int -> b -> Step s b
SDone (- Int
cnt) b
b
                  SError String
err -> String -> Step (Tuple'Fused Int s) b
forall s b. String -> Step s b
SError String
err

    -- XXX returning an error let's us backtrack.  To implement it in a way so
    -- that it terminates on eof without an error then we need a way to
    -- backtrack on eof, that will require extract to return 'Step' type.
    extract :: Tuple'Fused a b -> m (Final s b)
extract (Tuple'Fused a
n b
_) =
        Final s b -> m (Final s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (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 -> Final s b) -> String -> Final s b
forall a b. (a -> b) -> a -> b
$ String
"lookAhead: end of input after consuming "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements"

-------------------------------------------------------------------------------
-- Interleaving
-------------------------------------------------------------------------------
--
-- To deinterleave we can chain two parsers one behind the other. The input is
-- given to the first parser and the input definitively rejected by the first
-- parser is given to the second parser.
--
-- We can either have the parsers themselves buffer the input or use the shared
-- global buffer to hold it until none of the parsers need it. When the first
-- parser returns Skip (i.e. rewind) we let the second parser consume the
-- rejected input and when it is done we move the cursor forward to the first
-- parser again. This will require a "move forward" command as well.
--
-- To implement grep we can use three parsers, one to find the pattern, one
-- to store the context behind the pattern and one to store the context in
-- front of the pattern. When a match occurs we need to emit the accumulator of
-- all the three parsers. One parser can count the line numbers to provide the
-- line number info.

{-# ANN type DeintercalateAllState Fuse #-}
data DeintercalateAllState fs sp ss =
      DeintercalateAllInitL !fs
    | DeintercalateAllL !fs !sp
    | DeintercalateAllInitR !fs
    | DeintercalateAllR !fs !ss

-- XXX rename this to intercalate

-- Having deintercalateAll for accepting or rejecting entire input could be
-- useful. For example, in case of JSON parsing we get an entire block of
-- key-value pairs which we need to verify. This version may be simpler, more
-- efficient. We could implement this as a stream operation like parseMany.
--
-- XXX Also, it may be a good idea to provide a parse driver for a fold. For
-- example, in case of csv parsing as we are feeding a line to a fold we can
-- parse it.

-- | Like 'deintercalate' but the entire input must satisfy the pattern
-- otherwise the parser fails. This is many times faster than deintercalate.
--
-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
-- >>> p2 = Parser.satisfy (== '+')
-- >>> p = Parser.deintercalateAll p1 p2 Fold.toList
-- >>> Stream.parse p $ Stream.fromList ""
-- Right []
-- >>> Stream.parse p $ Stream.fromList "1"
-- Right [Left "1"]
-- >>> Stream.parsePos p $ Stream.fromList "1+"
-- Left (ParseErrorPos 2 "takeWhile1: end of input")
-- >>> Stream.parse p $ Stream.fromList "1+2+3"
-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
--
-- See also 'Streamly.Internal.Data.ParserK.chainl1'.
--
{-# INLINE deintercalateAll #-}
deintercalateAll :: Monad m =>
       Parser a m x
    -> Parser a m y
    -> Fold m (Either x y) z
    -> Parser a m z
deintercalateAll :: forall (m :: * -> *) a x y z.
Monad m =>
Parser a m x
-> Parser a m y -> Fold m (Either x y) z -> Parser a m z
deintercalateAll
    (Parser s -> a -> m (Step s x)
stepL m (Initial s x)
initialL s -> m (Final s x)
extractL)
    (Parser s -> a -> m (Step s y)
stepR m (Initial s y)
initialR s -> m (Final s y)
_)
    (Fold s -> Either x y -> m (Step s z)
fstep m (Step s z)
finitial s -> m z
_ s -> m z
ffinal) = (DeintercalateAllState s s s
 -> a -> m (Step (DeintercalateAllState s s s) z))
-> m (Initial (DeintercalateAllState s s s) z)
-> (DeintercalateAllState s s s
    -> m (Final (DeintercalateAllState s s s) z))
-> Parser a m z
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 DeintercalateAllState s s s
-> a -> m (Step (DeintercalateAllState s s s) z)
step m (Initial (DeintercalateAllState s s s) z)
forall {sp} {ss}. m (Initial (DeintercalateAllState s sp ss) z)
initial DeintercalateAllState s s s
-> m (Final (DeintercalateAllState s s s) z)
forall {ss} {ss}.
DeintercalateAllState s s ss
-> m (Final (DeintercalateAllState s s ss) z)
extract

    where

    errMsg :: String -> String -> a
errMsg String
p String
status =
        String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"deintercalate: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" parser cannot "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
status String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" without input"

    initial :: m (Initial (DeintercalateAllState s sp ss) z)
initial = do
        Step s z
res <- m (Step s z)
finitial
        case Step s z
res of
            FL.Partial s
fs -> Initial (DeintercalateAllState s sp ss) z
-> m (Initial (DeintercalateAllState s sp ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (DeintercalateAllState s sp ss) z
 -> m (Initial (DeintercalateAllState s sp ss) z))
-> Initial (DeintercalateAllState s sp ss) z
-> m (Initial (DeintercalateAllState s sp ss) z)
forall a b. (a -> b) -> a -> b
$ DeintercalateAllState s sp ss
-> Initial (DeintercalateAllState s sp ss) z
forall s b. s -> Initial s b
IPartial (DeintercalateAllState s sp ss
 -> Initial (DeintercalateAllState s sp ss) z)
-> DeintercalateAllState s sp ss
-> Initial (DeintercalateAllState s sp ss) z
forall a b. (a -> b) -> a -> b
$ s -> DeintercalateAllState s sp ss
forall fs sp ss. fs -> DeintercalateAllState fs sp ss
DeintercalateAllInitL s
fs
            FL.Done z
c -> Initial (DeintercalateAllState s sp ss) z
-> m (Initial (DeintercalateAllState s sp ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (DeintercalateAllState s sp ss) z
 -> m (Initial (DeintercalateAllState s sp ss) z))
-> Initial (DeintercalateAllState s sp ss) z
-> m (Initial (DeintercalateAllState s sp ss) z)
forall a b. (a -> b) -> a -> b
$ z -> Initial (DeintercalateAllState s sp ss) z
forall s b. b -> Initial s b
IDone z
c

    {-# INLINE processL #-}
    processL :: m (Step t b) -> Int -> (t -> s) -> m (Step s b)
processL m (Step t b)
foldAction Int
n t -> s
nextState = do
        Step t b
fres <- m (Step t b)
foldAction
        case Step t b
fres of
            FL.Partial t
fs1 -> 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
n (t -> s
nextState t
fs1)
            FL.Done b
c -> 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 -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
n b
c

    {-# INLINE runStepL #-}
    runStepL :: s -> s -> a -> m (Step (DeintercalateAllState s s ss) z)
runStepL s
fs s
sL a
a = do
        Step s x
r <- s -> a -> m (Step s x)
stepL s
sL a
a
        case Step s x
r of
            SPartial Int
n s
s -> Step (DeintercalateAllState s s ss) z
-> m (Step (DeintercalateAllState s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateAllState s s ss) z
 -> m (Step (DeintercalateAllState s s ss) z))
-> Step (DeintercalateAllState s s ss) z
-> m (Step (DeintercalateAllState s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateAllState s s ss
-> Step (DeintercalateAllState s s ss) z
forall s b. Int -> s -> Step s b
SPartial Int
n (s -> s -> DeintercalateAllState s s ss
forall fs sp ss. fs -> sp -> DeintercalateAllState fs sp ss
DeintercalateAllL s
fs s
s)
            SContinue Int
n s
s -> Step (DeintercalateAllState s s ss) z
-> m (Step (DeintercalateAllState s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateAllState s s ss) z
 -> m (Step (DeintercalateAllState s s ss) z))
-> Step (DeintercalateAllState s s ss) z
-> m (Step (DeintercalateAllState s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateAllState s s ss
-> Step (DeintercalateAllState s s ss) z
forall s b. Int -> s -> Step s b
SContinue Int
n (s -> s -> DeintercalateAllState s s ss
forall fs sp ss. fs -> sp -> DeintercalateAllState fs sp ss
DeintercalateAllL s
fs s
s)
            SDone Int
n x
b ->
                m (Step s z)
-> Int
-> (s -> DeintercalateAllState s s ss)
-> m (Step (DeintercalateAllState s s ss) z)
forall {m :: * -> *} {t} {b} {s}.
Monad m =>
m (Step t b) -> Int -> (t -> s) -> m (Step s b)
processL (s -> Either x y -> m (Step s z)
fstep s
fs (x -> Either x y
forall a b. a -> Either a b
Left x
b)) Int
n s -> DeintercalateAllState s s ss
forall fs sp ss. fs -> DeintercalateAllState fs sp ss
DeintercalateAllInitR
            SError String
err -> Step (DeintercalateAllState s s ss) z
-> m (Step (DeintercalateAllState s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateAllState s s ss) z
 -> m (Step (DeintercalateAllState s s ss) z))
-> Step (DeintercalateAllState s s ss) z
-> m (Step (DeintercalateAllState s s ss) z)
forall a b. (a -> b) -> a -> b
$ String -> Step (DeintercalateAllState s s ss) z
forall s b. String -> Step s b
SError String
err

    {-# INLINE processR #-}
    processR :: m (Step fs b) -> Int -> m (Step (DeintercalateAllState fs s ss) b)
processR m (Step fs b)
foldAction Int
n = do
        Step fs b
fres <- m (Step fs b)
foldAction
        case Step fs b
fres of
            FL.Partial fs
fs1 -> do
                Initial s x
res <- m (Initial s x)
initialL
                case Initial s x
res of
                    IPartial s
ps -> Step (DeintercalateAllState fs s ss) b
-> m (Step (DeintercalateAllState fs s ss) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateAllState fs s ss) b
 -> m (Step (DeintercalateAllState fs s ss) b))
-> Step (DeintercalateAllState fs s ss) b
-> m (Step (DeintercalateAllState fs s ss) b)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateAllState fs s ss
-> Step (DeintercalateAllState fs s ss) b
forall s b. Int -> s -> Step s b
SPartial Int
n (fs -> s -> DeintercalateAllState fs s ss
forall fs sp ss. fs -> sp -> DeintercalateAllState fs sp ss
DeintercalateAllL fs
fs1 s
ps)
                    IDone x
_ -> String -> String -> m (Step (DeintercalateAllState fs s ss) b)
forall {a}. String -> String -> a
errMsg String
"left" String
"succeed"
                    IError String
_ -> String -> String -> m (Step (DeintercalateAllState fs s ss) b)
forall {a}. String -> String -> a
errMsg String
"left" String
"fail"
            FL.Done b
c -> Step (DeintercalateAllState fs s ss) b
-> m (Step (DeintercalateAllState fs s ss) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateAllState fs s ss) b
 -> m (Step (DeintercalateAllState fs s ss) b))
-> Step (DeintercalateAllState fs s ss) b
-> m (Step (DeintercalateAllState fs s ss) b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step (DeintercalateAllState fs s ss) b
forall s b. Int -> b -> Step s b
SDone Int
n b
c

    {-# INLINE runStepR #-}
    runStepR :: s -> s -> a -> m (Step (DeintercalateAllState s s s) z)
runStepR s
fs s
sR a
a = do
        Step s y
r <- s -> a -> m (Step s y)
stepR s
sR a
a
        case Step s y
r of
            SPartial Int
n s
s -> Step (DeintercalateAllState s s s) z
-> m (Step (DeintercalateAllState s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateAllState s s s) z
 -> m (Step (DeintercalateAllState s s s) z))
-> Step (DeintercalateAllState s s s) z
-> m (Step (DeintercalateAllState s s s) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateAllState s s s
-> Step (DeintercalateAllState s s s) z
forall s b. Int -> s -> Step s b
SPartial Int
n (s -> s -> DeintercalateAllState s s s
forall fs sp ss. fs -> ss -> DeintercalateAllState fs sp ss
DeintercalateAllR s
fs s
s)
            SContinue Int
n s
s -> Step (DeintercalateAllState s s s) z
-> m (Step (DeintercalateAllState s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateAllState s s s) z
 -> m (Step (DeintercalateAllState s s s) z))
-> Step (DeintercalateAllState s s s) z
-> m (Step (DeintercalateAllState s s s) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateAllState s s s
-> Step (DeintercalateAllState s s s) z
forall s b. Int -> s -> Step s b
SContinue Int
n (s -> s -> DeintercalateAllState s s s
forall fs sp ss. fs -> ss -> DeintercalateAllState fs sp ss
DeintercalateAllR s
fs s
s)
            SDone Int
n y
b -> m (Step s z) -> Int -> m (Step (DeintercalateAllState s s s) z)
forall {fs} {b} {ss}.
m (Step fs b) -> Int -> m (Step (DeintercalateAllState fs s ss) b)
processR (s -> Either x y -> m (Step s z)
fstep s
fs (y -> Either x y
forall a b. b -> Either a b
Right y
b)) Int
n
            SError String
err -> Step (DeintercalateAllState s s s) z
-> m (Step (DeintercalateAllState s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateAllState s s s) z
 -> m (Step (DeintercalateAllState s s s) z))
-> Step (DeintercalateAllState s s s) z
-> m (Step (DeintercalateAllState s s s) z)
forall a b. (a -> b) -> a -> b
$ String -> Step (DeintercalateAllState s s s) z
forall s b. String -> Step s b
SError String
err

    step :: DeintercalateAllState s s s
-> a -> m (Step (DeintercalateAllState s s s) z)
step (DeintercalateAllInitL s
fs) a
a = do
        Initial s x
res <- m (Initial s x)
initialL
        case Initial s x
res of
            IPartial s
s -> s -> s -> a -> m (Step (DeintercalateAllState s s s) z)
forall {ss}.
s -> s -> a -> m (Step (DeintercalateAllState s s ss) z)
runStepL s
fs s
s a
a
            IDone x
_ -> String -> String -> m (Step (DeintercalateAllState s s s) z)
forall {a}. String -> String -> a
errMsg String
"left" String
"succeed"
            IError String
_ -> String -> String -> m (Step (DeintercalateAllState s s s) z)
forall {a}. String -> String -> a
errMsg String
"left" String
"fail"
    step (DeintercalateAllL s
fs s
sL) a
a = s -> s -> a -> m (Step (DeintercalateAllState s s s) z)
forall {ss}.
s -> s -> a -> m (Step (DeintercalateAllState s s ss) z)
runStepL s
fs s
sL a
a
    step (DeintercalateAllInitR s
fs) a
a = do
        Initial s y
res <- m (Initial s y)
initialR
        case Initial s y
res of
            IPartial s
s -> s -> s -> a -> m (Step (DeintercalateAllState s s s) z)
runStepR s
fs s
s a
a
            IDone y
_ -> String -> String -> m (Step (DeintercalateAllState s s s) z)
forall {a}. String -> String -> a
errMsg String
"right" String
"succeed"
            IError String
_ -> String -> String -> m (Step (DeintercalateAllState s s s) z)
forall {a}. String -> String -> a
errMsg String
"right" String
"fail"
    step (DeintercalateAllR s
fs s
sR) a
a = s -> s -> a -> m (Step (DeintercalateAllState s s s) z)
runStepR s
fs s
sR a
a

    {-# INLINE extractResult #-}
    extractResult :: Int -> s -> Either x y -> m (Final s z)
extractResult Int
n s
fs Either x y
r = do
        Step s z
res <- s -> Either x y -> m (Step s z)
fstep s
fs Either x y
r
        case Step s z
res of
            FL.Partial s
fs1 -> (z -> Final s z) -> m z -> m (Final s z)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> z -> Final s z
forall s b. Int -> b -> Final s b
FDone Int
n) (m z -> m (Final s z)) -> m z -> m (Final s z)
forall a b. (a -> b) -> a -> b
$ s -> m z
ffinal s
fs1
            FL.Done z
c -> Final s z -> m (Final s z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> z -> Final s z
forall s b. Int -> b -> Final s b
FDone Int
n z
c)
    extract :: DeintercalateAllState s s ss
-> m (Final (DeintercalateAllState s s ss) z)
extract (DeintercalateAllInitL s
fs) = (z -> Final (DeintercalateAllState s s ss) z)
-> m z -> m (Final (DeintercalateAllState s s ss) z)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> z -> Final (DeintercalateAllState s s ss) z
forall s b. Int -> b -> Final s b
FDone Int
0) (m z -> m (Final (DeintercalateAllState s s ss) z))
-> m z -> m (Final (DeintercalateAllState s s ss) z)
forall a b. (a -> b) -> a -> b
$ s -> m z
ffinal s
fs
    extract (DeintercalateAllL s
fs s
sL) = do
        Final s x
r <- s -> m (Final s x)
extractL s
sL
        case Final s x
r of
            FDone Int
n x
b -> Int
-> s -> Either x y -> m (Final (DeintercalateAllState s s ss) z)
forall {s}. Int -> s -> Either x y -> m (Final s z)
extractResult Int
n s
fs (x -> Either x y
forall a b. a -> Either a b
Left x
b)
            FError String
err -> Final (DeintercalateAllState s s ss) z
-> m (Final (DeintercalateAllState s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (DeintercalateAllState s s ss) z
 -> m (Final (DeintercalateAllState s s ss) z))
-> Final (DeintercalateAllState s s ss) z
-> m (Final (DeintercalateAllState s s ss) z)
forall a b. (a -> b) -> a -> b
$ String -> Final (DeintercalateAllState s s ss) z
forall s b. String -> Final s b
FError String
err
            FContinue Int
n s
s -> Final (DeintercalateAllState s s ss) z
-> m (Final (DeintercalateAllState s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (DeintercalateAllState s s ss) z
 -> m (Final (DeintercalateAllState s s ss) z))
-> Final (DeintercalateAllState s s ss) z
-> m (Final (DeintercalateAllState s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateAllState s s ss
-> Final (DeintercalateAllState s s ss) z
forall s b. Int -> s -> Final s b
FContinue Int
n (s -> s -> DeintercalateAllState s s ss
forall fs sp ss. fs -> sp -> DeintercalateAllState fs sp ss
DeintercalateAllL s
fs s
s)
    extract (DeintercalateAllInitR s
fs) = (z -> Final (DeintercalateAllState s s ss) z)
-> m z -> m (Final (DeintercalateAllState s s ss) z)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> z -> Final (DeintercalateAllState s s ss) z
forall s b. Int -> b -> Final s b
FDone Int
0) (m z -> m (Final (DeintercalateAllState s s ss) z))
-> m z -> m (Final (DeintercalateAllState s s ss) z)
forall a b. (a -> b) -> a -> b
$ s -> m z
ffinal s
fs
    extract (DeintercalateAllR s
_ ss
_) =
        Final (DeintercalateAllState s s ss) z
-> m (Final (DeintercalateAllState s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (DeintercalateAllState s s ss) z
 -> m (Final (DeintercalateAllState s s ss) z))
-> Final (DeintercalateAllState s s ss) z
-> m (Final (DeintercalateAllState s s ss) z)
forall a b. (a -> b) -> a -> b
$ String -> Final (DeintercalateAllState s s ss) z
forall s b. String -> Final s b
FError String
"deintercalateAll: input ended at 'Right' value"

{-# ANN type DeintercalateState Fuse #-}
data DeintercalateState b fs sp ss =
      DeintercalateInitL !fs
    | DeintercalateL !Int !fs !sp
    | DeintercalateInitR !fs
    | DeintercalateR !Int !fs !ss
    | DeintercalateRL !Int !b !fs !sp

-- XXX Add tests that the next character that we take after running a parser is
-- correct. Especially for the parsers that maintain a count. In the stream
-- finished case (extract) as well as not finished case.

-- | Apply two parsers alternately to an input stream. The input stream is
-- considered an interleaving of two patterns. The two parsers represent the
-- two patterns. Parsing starts at the first parser and stops at the first
-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
-- input or single parse of the first parser is accepted.
--
-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
-- >>> p2 = Parser.satisfy (== '+')
-- >>> p = Parser.deintercalate p1 p2 Fold.toList
-- >>> Stream.parse p $ Stream.fromList ""
-- Right []
-- >>> Stream.parse p $ Stream.fromList "1"
-- Right [Left "1"]
-- >>> Stream.parse p $ Stream.fromList "1+"
-- Right [Left "1"]
-- >>> Stream.parse p $ Stream.fromList "1+2+3"
-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
--
-- See also 'Streamly.Internal.Data.ParserK.chainl1'.
--
{-# INLINE deintercalate #-}
deintercalate :: Monad m =>
       Parser a m x
    -> Parser a m y
    -> Fold m (Either x y) z
    -> Parser a m z
deintercalate :: forall (m :: * -> *) a x y z.
Monad m =>
Parser a m x
-> Parser a m y -> Fold m (Either x y) z -> Parser a m z
deintercalate
    (Parser s -> a -> m (Step s x)
stepL m (Initial s x)
initialL s -> m (Final s x)
extractL)
    (Parser s -> a -> m (Step s y)
stepR m (Initial s y)
initialR s -> m (Final s y)
_)
    (Fold s -> Either x y -> m (Step s z)
fstep m (Step s z)
finitial s -> m z
_ s -> m z
ffinal) = (DeintercalateState y s s s
 -> a -> m (Step (DeintercalateState y s s s) z))
-> m (Initial (DeintercalateState y s s s) z)
-> (DeintercalateState y s s s
    -> m (Final (DeintercalateState y s s s) z))
-> Parser a m z
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 DeintercalateState y s s s
-> a -> m (Step (DeintercalateState y s s s) z)
step m (Initial (DeintercalateState y s s s) z)
forall {b} {sp} {ss}. m (Initial (DeintercalateState b s sp ss) z)
initial DeintercalateState y s s s
-> m (Final (DeintercalateState y s s s) z)
forall {ss} {ss}.
DeintercalateState y s s ss
-> m (Final (DeintercalateState y s s ss) z)
extract

    where

    errMsg :: String -> String -> a
errMsg String
p String
status =
        String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"deintercalate: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" parser cannot "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
status String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" without input"

    initial :: m (Initial (DeintercalateState b s sp ss) z)
initial = do
        Step s z
res <- m (Step s z)
finitial
        case Step s z
res of
            FL.Partial s
fs -> Initial (DeintercalateState b s sp ss) z
-> m (Initial (DeintercalateState b s sp ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (DeintercalateState b s sp ss) z
 -> m (Initial (DeintercalateState b s sp ss) z))
-> Initial (DeintercalateState b s sp ss) z
-> m (Initial (DeintercalateState b s sp ss) z)
forall a b. (a -> b) -> a -> b
$ DeintercalateState b s sp ss
-> Initial (DeintercalateState b s sp ss) z
forall s b. s -> Initial s b
IPartial (DeintercalateState b s sp ss
 -> Initial (DeintercalateState b s sp ss) z)
-> DeintercalateState b s sp ss
-> Initial (DeintercalateState b s sp ss) z
forall a b. (a -> b) -> a -> b
$ s -> DeintercalateState b s sp ss
forall b fs sp ss. fs -> DeintercalateState b fs sp ss
DeintercalateInitL s
fs
            FL.Done z
c -> Initial (DeintercalateState b s sp ss) z
-> m (Initial (DeintercalateState b s sp ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (DeintercalateState b s sp ss) z
 -> m (Initial (DeintercalateState b s sp ss) z))
-> Initial (DeintercalateState b s sp ss) z
-> m (Initial (DeintercalateState b s sp ss) z)
forall a b. (a -> b) -> a -> b
$ z -> Initial (DeintercalateState b s sp ss) z
forall s b. b -> Initial s b
IDone z
c

    {-# INLINE processL #-}
    processL :: m (Step t b) -> Int -> (t -> s) -> m (Step s b)
processL m (Step t b)
foldAction Int
n t -> s
nextState = do
        Step t b
fres <- m (Step t b)
foldAction
        case Step t b
fres of
            FL.Partial t
fs1 -> 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
n (t -> s
nextState t
fs1)
            FL.Done b
c -> 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 -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
n b
c

    {-# INLINE runStepL #-}
    runStepL :: Int -> s -> s -> a -> m (Step (DeintercalateState b s s ss) z)
runStepL Int
cnt s
fs s
sL a
a = do
        Step s x
r <- s -> a -> m (Step s x)
stepL s
sL a
a
        case Step s x
r of
            -- XXX If we subtract instead of adding we do not need to negate
            -- when returning cnt.
            SPartial Int
n s
s -> Step (DeintercalateState b s s ss) z
-> m (Step (DeintercalateState b s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateState b s s ss) z
 -> m (Step (DeintercalateState b s s ss) z))
-> Step (DeintercalateState b s s ss) z
-> m (Step (DeintercalateState b s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateState b s s ss
-> Step (DeintercalateState b s s ss) z
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> DeintercalateState b s s ss
forall b fs sp ss. Int -> fs -> sp -> DeintercalateState b fs sp ss
DeintercalateL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SContinue Int
n s
s -> Step (DeintercalateState b s s ss) z
-> m (Step (DeintercalateState b s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateState b s s ss) z
 -> m (Step (DeintercalateState b s s ss) z))
-> Step (DeintercalateState b s s ss) z
-> m (Step (DeintercalateState b s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateState b s s ss
-> Step (DeintercalateState b s s ss) z
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> DeintercalateState b s s ss
forall b fs sp ss. Int -> fs -> sp -> DeintercalateState b fs sp ss
DeintercalateL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SDone Int
n x
b ->
                m (Step s z)
-> Int
-> (s -> DeintercalateState b s s ss)
-> m (Step (DeintercalateState b s s ss) z)
forall {m :: * -> *} {t} {b} {s}.
Monad m =>
m (Step t b) -> Int -> (t -> s) -> m (Step s b)
processL (s -> Either x y -> m (Step s z)
fstep s
fs (x -> Either x y
forall a b. a -> Either a b
Left x
b)) Int
n s -> DeintercalateState b s s ss
forall b fs sp ss. fs -> DeintercalateState b fs sp ss
DeintercalateInitR
            SError String
_ -> do
                z
xs <- s -> m z
ffinal s
fs
                Step (DeintercalateState b s s ss) z
-> m (Step (DeintercalateState b s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateState b s s ss) z
 -> m (Step (DeintercalateState b s s ss) z))
-> Step (DeintercalateState b s s ss) z
-> m (Step (DeintercalateState b s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int -> z -> Step (DeintercalateState b s s ss) z
forall s b. Int -> b -> Step s b
SDone (-Int
cnt) z
xs

    {-# INLINE processR #-}
    processR :: Int -> b -> fs -> Int -> m (Step (DeintercalateState b fs s ss) b)
processR Int
cnt b
b fs
fs Int
n = do
        Initial s x
res <- m (Initial s x)
initialL
        case Initial s x
res of
            IPartial s
ps -> Step (DeintercalateState b fs s ss) b
-> m (Step (DeintercalateState b fs s ss) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateState b fs s ss) b
 -> m (Step (DeintercalateState b fs s ss) b))
-> Step (DeintercalateState b fs s ss) b
-> m (Step (DeintercalateState b fs s ss) b)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateState b fs s ss
-> Step (DeintercalateState b fs s ss) b
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> b -> fs -> s -> DeintercalateState b fs s ss
forall b fs sp ss.
Int -> b -> fs -> sp -> DeintercalateState b fs sp ss
DeintercalateRL Int
cnt b
b fs
fs s
ps)
            IDone x
_ -> String -> String -> m (Step (DeintercalateState b fs s ss) b)
forall {a}. String -> String -> a
errMsg String
"left" String
"succeed"
            IError String
_ -> String -> String -> m (Step (DeintercalateState b fs s ss) b)
forall {a}. String -> String -> a
errMsg String
"left" String
"fail"

    {-# INLINE runStepR #-}
    runStepR :: Int -> s -> s -> a -> m (Step (DeintercalateState y s s s) z)
runStepR Int
cnt s
fs s
sR a
a = do
        Step s y
r <- s -> a -> m (Step s y)
stepR s
sR a
a
        case Step s y
r of
            SPartial Int
n s
s -> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateState y s s s) z
 -> m (Step (DeintercalateState y s s s) z))
-> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateState y s s s
-> Step (DeintercalateState y s s s) z
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> DeintercalateState y s s s
forall b fs sp ss. Int -> fs -> ss -> DeintercalateState b fs sp ss
DeintercalateR (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SContinue Int
n s
s -> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateState y s s s) z
 -> m (Step (DeintercalateState y s s s) z))
-> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateState y s s s
-> Step (DeintercalateState y s s s) z
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> DeintercalateState y s s s
forall b fs sp ss. Int -> fs -> ss -> DeintercalateState b fs sp ss
DeintercalateR (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SDone Int
n y
b -> Int -> y -> s -> Int -> m (Step (DeintercalateState y s s s) z)
forall {b} {fs} {ss} {b}.
Int -> b -> fs -> Int -> m (Step (DeintercalateState b fs s ss) b)
processR (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) y
b s
fs Int
n
            SError String
_ -> do
                z
xs <- s -> m z
ffinal s
fs
                Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateState y s s s) z
 -> m (Step (DeintercalateState y s s s) z))
-> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int -> z -> Step (DeintercalateState y s s s) z
forall s b. Int -> b -> Step s b
SDone (- Int
cnt) z
xs

    step :: DeintercalateState y s s s
-> a -> m (Step (DeintercalateState y s s s) z)
step (DeintercalateInitL s
fs) a
a = do
        Initial s x
res <- m (Initial s x)
initialL
        case Initial s x
res of
            IPartial s
s -> Int -> s -> s -> a -> m (Step (DeintercalateState y s s s) z)
forall {b} {ss}.
Int -> s -> s -> a -> m (Step (DeintercalateState b s s ss) z)
runStepL Int
0 s
fs s
s a
a
            IDone x
_ -> String -> String -> m (Step (DeintercalateState y s s s) z)
forall {a}. String -> String -> a
errMsg String
"left" String
"succeed"
            IError String
_ -> String -> String -> m (Step (DeintercalateState y s s s) z)
forall {a}. String -> String -> a
errMsg String
"left" String
"fail"
    step (DeintercalateL Int
cnt s
fs s
sL) a
a = Int -> s -> s -> a -> m (Step (DeintercalateState y s s s) z)
forall {b} {ss}.
Int -> s -> s -> a -> m (Step (DeintercalateState b s s ss) z)
runStepL Int
cnt s
fs s
sL a
a
    step (DeintercalateInitR s
fs) a
a = do
        Initial s y
res <- m (Initial s y)
initialR
        case Initial s y
res of
            IPartial s
s -> Int -> s -> s -> a -> m (Step (DeintercalateState y s s s) z)
runStepR Int
0 s
fs s
s a
a
            IDone y
_ -> String -> String -> m (Step (DeintercalateState y s s s) z)
forall {a}. String -> String -> a
errMsg String
"right" String
"succeed"
            IError String
_ -> String -> String -> m (Step (DeintercalateState y s s s) z)
forall {a}. String -> String -> a
errMsg String
"right" String
"fail"
    step (DeintercalateR Int
cnt s
fs s
sR) a
a = Int -> s -> s -> a -> m (Step (DeintercalateState y s s s) z)
runStepR Int
cnt s
fs s
sR a
a
    step (DeintercalateRL Int
cnt y
bR s
fs s
sL) a
a = do
        Step s x
r <- s -> a -> m (Step s x)
stepL s
sL a
a
        case Step s x
r of
            SPartial Int
n s
s -> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateState y s s s) z
 -> m (Step (DeintercalateState y s s s) z))
-> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateState y s s s
-> Step (DeintercalateState y s s s) z
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> y -> s -> s -> DeintercalateState y s s s
forall b fs sp ss.
Int -> b -> fs -> sp -> DeintercalateState b fs sp ss
DeintercalateRL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) y
bR s
fs s
s)
            SContinue Int
n s
s -> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateState y s s s) z
 -> m (Step (DeintercalateState y s s s) z))
-> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateState y s s s
-> Step (DeintercalateState y s s s) z
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> y -> s -> s -> DeintercalateState y s s s
forall b fs sp ss.
Int -> b -> fs -> sp -> DeintercalateState b fs sp ss
DeintercalateRL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) y
bR s
fs s
s)
            SDone Int
n x
bL -> do
                Step s z
res <- s -> Either x y -> m (Step s z)
fstep s
fs (y -> Either x y
forall a b. b -> Either a b
Right y
bR)
                case Step s z
res of
                    FL.Partial s
fs1 -> do
                        Step s z
fres <- s -> Either x y -> m (Step s z)
fstep s
fs1 (x -> Either x y
forall a b. a -> Either a b
Left x
bL)
                        case Step s z
fres of
                            FL.Partial s
fs2 ->
                                Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateState y s s s) z
 -> m (Step (DeintercalateState y s s s) z))
-> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateState y s s s
-> Step (DeintercalateState y s s s) z
forall s b. Int -> s -> Step s b
SPartial Int
n (s -> DeintercalateState y s s s
forall b fs sp ss. fs -> DeintercalateState b fs sp ss
DeintercalateInitR s
fs2)
                            FL.Done z
c -> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateState y s s s) z
 -> m (Step (DeintercalateState y s s s) z))
-> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int -> z -> Step (DeintercalateState y s s s) z
forall s b. Int -> b -> Step s b
SDone Int
n z
c
                    -- XXX We could have the fold accept pairs of (bR, bL)
                    FL.Done z
_ -> String -> m (Step (DeintercalateState y s s s) z)
forall a. HasCallStack => String -> a
error String
"Fold terminated consuming partial input"
            SError String
_ -> do
                z
xs <- s -> m z
ffinal s
fs
                Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DeintercalateState y s s s) z
 -> m (Step (DeintercalateState y s s s) z))
-> Step (DeintercalateState y s s s) z
-> m (Step (DeintercalateState y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int -> z -> Step (DeintercalateState y s s s) z
forall s b. Int -> b -> Step s b
SDone (- Int
cnt) z
xs

    {-# INLINE extractResult #-}
    extractResult :: Int -> s -> Either x y -> m (Final s z)
extractResult Int
n s
fs Either x y
r = do
        Step s z
res <- s -> Either x y -> m (Step s z)
fstep s
fs Either x y
r
        case Step s z
res of
            FL.Partial s
fs1 -> (z -> Final s z) -> m z -> m (Final s z)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> z -> Final s z
forall s b. Int -> b -> Final s b
FDone Int
n) (m z -> m (Final s z)) -> m z -> m (Final s z)
forall a b. (a -> b) -> a -> b
$ s -> m z
ffinal s
fs1
            FL.Done z
c -> Final s z -> m (Final s z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> z -> Final s z
forall s b. Int -> b -> Final s b
FDone Int
n z
c)

    extract :: DeintercalateState y s s ss
-> m (Final (DeintercalateState y s s ss) z)
extract (DeintercalateInitL s
fs) = (z -> Final (DeintercalateState y s s ss) z)
-> m z -> m (Final (DeintercalateState y s s ss) z)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> z -> Final (DeintercalateState y s s ss) z
forall s b. Int -> b -> Final s b
FDone Int
0) (m z -> m (Final (DeintercalateState y s s ss) z))
-> m z -> m (Final (DeintercalateState y s s ss) z)
forall a b. (a -> b) -> a -> b
$ s -> m z
ffinal s
fs
    extract (DeintercalateL Int
cnt s
fs s
sL) = do
        Final s x
r <- s -> m (Final s x)
extractL s
sL
        case Final s x
r of
            FDone Int
n x
b -> Int -> s -> Either x y -> m (Final (DeintercalateState y s s ss) z)
forall {s}. Int -> s -> Either x y -> m (Final s z)
extractResult Int
n s
fs (x -> Either x y
forall a b. a -> Either a b
Left x
b)
            FContinue Int
n s
s -> Final (DeintercalateState y s s ss) z
-> m (Final (DeintercalateState y s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (DeintercalateState y s s ss) z
 -> m (Final (DeintercalateState y s s ss) z))
-> Final (DeintercalateState y s s ss) z
-> m (Final (DeintercalateState y s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateState y s s ss
-> Final (DeintercalateState y s s ss) z
forall s b. Int -> s -> Final s b
FContinue Int
n (Int -> s -> s -> DeintercalateState y s s ss
forall b fs sp ss. Int -> fs -> sp -> DeintercalateState b fs sp ss
DeintercalateL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            FError String
_ -> do
                z
xs <- s -> m z
ffinal s
fs
                Final (DeintercalateState y s s ss) z
-> m (Final (DeintercalateState y s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (DeintercalateState y s s ss) z
 -> m (Final (DeintercalateState y s s ss) z))
-> Final (DeintercalateState y s s ss) z
-> m (Final (DeintercalateState y s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int -> z -> Final (DeintercalateState y s s ss) z
forall s b. Int -> b -> Final s b
FDone (- Int
cnt) z
xs
    extract (DeintercalateInitR s
fs) = (z -> Final (DeintercalateState y s s ss) z)
-> m z -> m (Final (DeintercalateState y s s ss) z)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> z -> Final (DeintercalateState y s s ss) z
forall s b. Int -> b -> Final s b
FDone Int
0) (m z -> m (Final (DeintercalateState y s s ss) z))
-> m z -> m (Final (DeintercalateState y s s ss) z)
forall a b. (a -> b) -> a -> b
$ s -> m z
ffinal s
fs
    extract (DeintercalateR Int
cnt s
fs ss
_) = (z -> Final (DeintercalateState y s s ss) z)
-> m z -> m (Final (DeintercalateState y s s ss) z)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> z -> Final (DeintercalateState y s s ss) z
forall s b. Int -> b -> Final s b
FDone (- Int
cnt)) (m z -> m (Final (DeintercalateState y s s ss) z))
-> m z -> m (Final (DeintercalateState y s s ss) z)
forall a b. (a -> b) -> a -> b
$ s -> m z
ffinal s
fs
    extract (DeintercalateRL Int
cnt y
bR s
fs s
sL) = do
        Final s x
r <- s -> m (Final s x)
extractL s
sL
        case Final s x
r of
            FDone Int
n x
bL -> do
                Step s z
res <- s -> Either x y -> m (Step s z)
fstep s
fs (y -> Either x y
forall a b. b -> Either a b
Right y
bR)
                case Step s z
res of
                    FL.Partial s
fs1 -> Int -> s -> Either x y -> m (Final (DeintercalateState y s s ss) z)
forall {s}. Int -> s -> Either x y -> m (Final s z)
extractResult Int
n s
fs1 (x -> Either x y
forall a b. a -> Either a b
Left x
bL)
                    FL.Done z
_ -> String -> m (Final (DeintercalateState y s s ss) z)
forall a. HasCallStack => String -> a
error String
"Fold terminated consuming partial input"
            FContinue Int
n s
s -> Final (DeintercalateState y s s ss) z
-> m (Final (DeintercalateState y s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (DeintercalateState y s s ss) z
 -> m (Final (DeintercalateState y s s ss) z))
-> Final (DeintercalateState y s s ss) z
-> m (Final (DeintercalateState y s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int
-> DeintercalateState y s s ss
-> Final (DeintercalateState y s s ss) z
forall s b. Int -> s -> Final s b
FContinue Int
n (Int -> y -> s -> s -> DeintercalateState y s s ss
forall b fs sp ss.
Int -> b -> fs -> sp -> DeintercalateState b fs sp ss
DeintercalateRL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) y
bR s
fs s
s)
            FError String
_ -> do
                z
xs <- s -> m z
ffinal s
fs
                Final (DeintercalateState y s s ss) z
-> m (Final (DeintercalateState y s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (DeintercalateState y s s ss) z
 -> m (Final (DeintercalateState y s s ss) z))
-> Final (DeintercalateState y s s ss) z
-> m (Final (DeintercalateState y s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int -> z -> Final (DeintercalateState y s s ss) z
forall s b. Int -> b -> Final s b
FDone (- Int
cnt) z
xs

{-# ANN type Deintercalate1State Fuse #-}
data Deintercalate1State b fs sp ss =
      Deintercalate1InitL !Int !fs !sp
    | Deintercalate1InitR !fs
    | Deintercalate1R !Int !fs !ss
    | Deintercalate1RL !Int !b !fs !sp

-- | Apply two parsers alternately to an input stream. The input stream is
-- considered an interleaving of two patterns. The two parsers represent the
-- two patterns. Parsing starts at the first parser and stops at the first
-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
-- input or single parse of the first parser is accepted.
--
-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
-- >>> p2 = Parser.satisfy (== '+')
-- >>> p = Parser.deintercalate1 p1 p2 Fold.toList
-- >>> Stream.parsePos p $ Stream.fromList ""
-- Left (ParseErrorPos 0 "takeWhile1: end of input")
-- >>> Stream.parse p $ Stream.fromList "1"
-- Right [Left "1"]
-- >>> Stream.parse p $ Stream.fromList "1+"
-- Right [Left "1"]
-- >>> Stream.parse p $ Stream.fromList "1+2+3"
-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
--
{-# INLINE deintercalate1 #-}
deintercalate1 :: Monad m =>
       Parser a m x
    -> Parser a m y
    -> Fold m (Either x y) z
    -> Parser a m z
deintercalate1 :: forall (m :: * -> *) a x y z.
Monad m =>
Parser a m x
-> Parser a m y -> Fold m (Either x y) z -> Parser a m z
deintercalate1
    (Parser s -> a -> m (Step s x)
stepL m (Initial s x)
initialL s -> m (Final s x)
extractL)
    (Parser s -> a -> m (Step s y)
stepR m (Initial s y)
initialR s -> m (Final s y)
_)
    (Fold s -> Either x y -> m (Step s z)
fstep m (Step s z)
finitial s -> m z
_ s -> m z
ffinal) = (Deintercalate1State y s s s
 -> a -> m (Step (Deintercalate1State y s s s) z))
-> m (Initial (Deintercalate1State y s s s) z)
-> (Deintercalate1State y s s s
    -> m (Final (Deintercalate1State y s s s) z))
-> Parser a m z
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 Deintercalate1State y s s s
-> a -> m (Step (Deintercalate1State y s s s) z)
step m (Initial (Deintercalate1State y s s s) z)
forall {b} {ss}. m (Initial (Deintercalate1State b s s ss) z)
initial Deintercalate1State y s s s
-> m (Final (Deintercalate1State y s s s) z)
forall {ss} {ss}.
Deintercalate1State y s s ss
-> m (Final (Deintercalate1State y s s ss) z)
extract

    where

    errMsg :: String -> String -> a
errMsg String
p String
status =
        String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"deintercalate: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" parser cannot "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
status String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" without input"

    initial :: m (Initial (Deintercalate1State b s s ss) z)
initial = do
        Step s z
res <- m (Step s z)
finitial
        case Step s z
res of
            FL.Partial s
fs -> do
                Initial s x
pres <- m (Initial s x)
initialL
                case Initial s x
pres of
                    IPartial s
s -> Initial (Deintercalate1State b s s ss) z
-> m (Initial (Deintercalate1State b s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Deintercalate1State b s s ss) z
 -> m (Initial (Deintercalate1State b s s ss) z))
-> Initial (Deintercalate1State b s s ss) z
-> m (Initial (Deintercalate1State b s s ss) z)
forall a b. (a -> b) -> a -> b
$ Deintercalate1State b s s ss
-> Initial (Deintercalate1State b s s ss) z
forall s b. s -> Initial s b
IPartial (Deintercalate1State b s s ss
 -> Initial (Deintercalate1State b s s ss) z)
-> Deintercalate1State b s s ss
-> Initial (Deintercalate1State b s s ss) z
forall a b. (a -> b) -> a -> b
$ Int -> s -> s -> Deintercalate1State b s s ss
forall b fs sp ss.
Int -> fs -> sp -> Deintercalate1State b fs sp ss
Deintercalate1InitL Int
0 s
fs s
s
                    IDone x
_ -> String -> String -> m (Initial (Deintercalate1State b s s ss) z)
forall {a}. String -> String -> a
errMsg String
"left" String
"succeed"
                    IError String
_ -> String -> String -> m (Initial (Deintercalate1State b s s ss) z)
forall {a}. String -> String -> a
errMsg String
"left" String
"fail"
            FL.Done z
c -> Initial (Deintercalate1State b s s ss) z
-> m (Initial (Deintercalate1State b s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Deintercalate1State b s s ss) z
 -> m (Initial (Deintercalate1State b s s ss) z))
-> Initial (Deintercalate1State b s s ss) z
-> m (Initial (Deintercalate1State b s s ss) z)
forall a b. (a -> b) -> a -> b
$ z -> Initial (Deintercalate1State b s s ss) z
forall s b. b -> Initial s b
IDone z
c

    {-# INLINE processL #-}
    processL :: m (Step t b) -> Int -> (t -> s) -> m (Step s b)
processL m (Step t b)
foldAction Int
n t -> s
nextState = do
        Step t b
fres <- m (Step t b)
foldAction
        case Step t b
fres of
            FL.Partial t
fs1 -> 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
n (t -> s
nextState t
fs1)
            FL.Done b
c -> 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 -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
n b
c

    {-# INLINE runStepInitL #-}
    runStepInitL :: Int -> s -> s -> a -> m (Step (Deintercalate1State b s s ss) z)
runStepInitL Int
cnt s
fs s
sL a
a = do
        Step s x
r <- s -> a -> m (Step s x)
stepL s
sL a
a
        case Step s x
r of
            SPartial Int
n s
s -> Step (Deintercalate1State b s s ss) z
-> m (Step (Deintercalate1State b s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Deintercalate1State b s s ss) z
 -> m (Step (Deintercalate1State b s s ss) z))
-> Step (Deintercalate1State b s s ss) z
-> m (Step (Deintercalate1State b s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int
-> Deintercalate1State b s s ss
-> Step (Deintercalate1State b s s ss) z
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> Deintercalate1State b s s ss
forall b fs sp ss.
Int -> fs -> sp -> Deintercalate1State b fs sp ss
Deintercalate1InitL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SContinue Int
n s
s -> Step (Deintercalate1State b s s ss) z
-> m (Step (Deintercalate1State b s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Deintercalate1State b s s ss) z
 -> m (Step (Deintercalate1State b s s ss) z))
-> Step (Deintercalate1State b s s ss) z
-> m (Step (Deintercalate1State b s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int
-> Deintercalate1State b s s ss
-> Step (Deintercalate1State b s s ss) z
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> Deintercalate1State b s s ss
forall b fs sp ss.
Int -> fs -> sp -> Deintercalate1State b fs sp ss
Deintercalate1InitL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SDone Int
n x
b ->
                m (Step s z)
-> Int
-> (s -> Deintercalate1State b s s ss)
-> m (Step (Deintercalate1State b s s ss) z)
forall {m :: * -> *} {t} {b} {s}.
Monad m =>
m (Step t b) -> Int -> (t -> s) -> m (Step s b)
processL (s -> Either x y -> m (Step s z)
fstep s
fs (x -> Either x y
forall a b. a -> Either a b
Left x
b)) Int
n s -> Deintercalate1State b s s ss
forall b fs sp ss. fs -> Deintercalate1State b fs sp ss
Deintercalate1InitR
            SError String
err -> Step (Deintercalate1State b s s ss) z
-> m (Step (Deintercalate1State b s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Deintercalate1State b s s ss) z
 -> m (Step (Deintercalate1State b s s ss) z))
-> Step (Deintercalate1State b s s ss) z
-> m (Step (Deintercalate1State b s s ss) z)
forall a b. (a -> b) -> a -> b
$ String -> Step (Deintercalate1State b s s ss) z
forall s b. String -> Step s b
SError String
err

    {-# INLINE processR #-}
    processR :: Int -> b -> fs -> Int -> m (Step (Deintercalate1State b fs s ss) b)
processR Int
cnt b
b fs
fs Int
n = do
        Initial s x
res <- m (Initial s x)
initialL
        case Initial s x
res of
            IPartial s
ps -> Step (Deintercalate1State b fs s ss) b
-> m (Step (Deintercalate1State b fs s ss) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Deintercalate1State b fs s ss) b
 -> m (Step (Deintercalate1State b fs s ss) b))
-> Step (Deintercalate1State b fs s ss) b
-> m (Step (Deintercalate1State b fs s ss) b)
forall a b. (a -> b) -> a -> b
$ Int
-> Deintercalate1State b fs s ss
-> Step (Deintercalate1State b fs s ss) b
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> b -> fs -> s -> Deintercalate1State b fs s ss
forall b fs sp ss.
Int -> b -> fs -> sp -> Deintercalate1State b fs sp ss
Deintercalate1RL Int
cnt b
b fs
fs s
ps)
            IDone x
_ -> String -> String -> m (Step (Deintercalate1State b fs s ss) b)
forall {a}. String -> String -> a
errMsg String
"left" String
"succeed"
            IError String
_ -> String -> String -> m (Step (Deintercalate1State b fs s ss) b)
forall {a}. String -> String -> a
errMsg String
"left" String
"fail"

    {-# INLINE runStepR #-}
    runStepR :: Int -> s -> s -> a -> m (Step (Deintercalate1State y s s s) z)
runStepR Int
cnt s
fs s
sR a
a = do
        Step s y
r <- s -> a -> m (Step s y)
stepR s
sR a
a
        case Step s y
r of
            SPartial Int
n s
s -> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Deintercalate1State y s s s) z
 -> m (Step (Deintercalate1State y s s s) z))
-> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int
-> Deintercalate1State y s s s
-> Step (Deintercalate1State y s s s) z
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> Deintercalate1State y s s s
forall b fs sp ss.
Int -> fs -> ss -> Deintercalate1State b fs sp ss
Deintercalate1R (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SContinue Int
n s
s -> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Deintercalate1State y s s s) z
 -> m (Step (Deintercalate1State y s s s) z))
-> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int
-> Deintercalate1State y s s s
-> Step (Deintercalate1State y s s s) z
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> Deintercalate1State y s s s
forall b fs sp ss.
Int -> fs -> ss -> Deintercalate1State b fs sp ss
Deintercalate1R (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SDone Int
n y
b -> Int -> y -> s -> Int -> m (Step (Deintercalate1State y s s s) z)
forall {b} {fs} {ss} {b}.
Int -> b -> fs -> Int -> m (Step (Deintercalate1State b fs s ss) b)
processR (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) y
b s
fs Int
n
            SError String
_ -> do
                z
xs <- s -> m z
ffinal s
fs
                Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Deintercalate1State y s s s) z
 -> m (Step (Deintercalate1State y s s s) z))
-> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int -> z -> Step (Deintercalate1State y s s s) z
forall s b. Int -> b -> Step s b
SDone (- Int
cnt) z
xs

    step :: Deintercalate1State y s s s
-> a -> m (Step (Deintercalate1State y s s s) z)
step (Deintercalate1InitL Int
cnt s
fs s
sL) a
a = Int -> s -> s -> a -> m (Step (Deintercalate1State y s s s) z)
forall {b} {ss}.
Int -> s -> s -> a -> m (Step (Deintercalate1State b s s ss) z)
runStepInitL Int
cnt s
fs s
sL a
a
    step (Deintercalate1InitR s
fs) a
a = do
        Initial s y
res <- m (Initial s y)
initialR
        case Initial s y
res of
            IPartial s
s -> Int -> s -> s -> a -> m (Step (Deintercalate1State y s s s) z)
runStepR Int
0 s
fs s
s a
a
            IDone y
_ -> String -> String -> m (Step (Deintercalate1State y s s s) z)
forall {a}. String -> String -> a
errMsg String
"right" String
"succeed"
            IError String
_ -> String -> String -> m (Step (Deintercalate1State y s s s) z)
forall {a}. String -> String -> a
errMsg String
"right" String
"fail"
    step (Deintercalate1R Int
cnt s
fs s
sR) a
a = Int -> s -> s -> a -> m (Step (Deintercalate1State y s s s) z)
runStepR Int
cnt s
fs s
sR a
a
    step (Deintercalate1RL Int
cnt y
bR s
fs s
sL) a
a = do
        Step s x
r <- s -> a -> m (Step s x)
stepL s
sL a
a
        case Step s x
r of
            SPartial Int
n s
s -> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Deintercalate1State y s s s) z
 -> m (Step (Deintercalate1State y s s s) z))
-> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int
-> Deintercalate1State y s s s
-> Step (Deintercalate1State y s s s) z
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> y -> s -> s -> Deintercalate1State y s s s
forall b fs sp ss.
Int -> b -> fs -> sp -> Deintercalate1State b fs sp ss
Deintercalate1RL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) y
bR s
fs s
s)
            SContinue Int
n s
s -> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Deintercalate1State y s s s) z
 -> m (Step (Deintercalate1State y s s s) z))
-> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int
-> Deintercalate1State y s s s
-> Step (Deintercalate1State y s s s) z
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> y -> s -> s -> Deintercalate1State y s s s
forall b fs sp ss.
Int -> b -> fs -> sp -> Deintercalate1State b fs sp ss
Deintercalate1RL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) y
bR s
fs s
s)
            SDone Int
n x
bL -> do
                Step s z
res <- s -> Either x y -> m (Step s z)
fstep s
fs (y -> Either x y
forall a b. b -> Either a b
Right y
bR)
                case Step s z
res of
                    FL.Partial s
fs1 -> do
                        Step s z
fres <- s -> Either x y -> m (Step s z)
fstep s
fs1 (x -> Either x y
forall a b. a -> Either a b
Left x
bL)
                        case Step s z
fres of
                            FL.Partial s
fs2 ->
                                Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Deintercalate1State y s s s) z
 -> m (Step (Deintercalate1State y s s s) z))
-> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int
-> Deintercalate1State y s s s
-> Step (Deintercalate1State y s s s) z
forall s b. Int -> s -> Step s b
SPartial Int
n (s -> Deintercalate1State y s s s
forall b fs sp ss. fs -> Deintercalate1State b fs sp ss
Deintercalate1InitR s
fs2)
                            FL.Done z
c -> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Deintercalate1State y s s s) z
 -> m (Step (Deintercalate1State y s s s) z))
-> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int -> z -> Step (Deintercalate1State y s s s) z
forall s b. Int -> b -> Step s b
SDone Int
n z
c
                    -- XXX We could have the fold accept pairs of (bR, bL)
                    FL.Done z
_ -> String -> m (Step (Deintercalate1State y s s s) z)
forall a. HasCallStack => String -> a
error String
"Fold terminated consuming partial input"
            SError String
_ -> do
                z
xs <- s -> m z
ffinal s
fs
                Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Deintercalate1State y s s s) z
 -> m (Step (Deintercalate1State y s s s) z))
-> Step (Deintercalate1State y s s s) z
-> m (Step (Deintercalate1State y s s s) z)
forall a b. (a -> b) -> a -> b
$ Int -> z -> Step (Deintercalate1State y s s s) z
forall s b. Int -> b -> Step s b
SDone (- Int
cnt) z
xs

    {-# INLINE extractResult #-}
    extractResult :: Int -> s -> Either x y -> m (Final s z)
extractResult Int
n s
fs Either x y
r = do
        Step s z
res <- s -> Either x y -> m (Step s z)
fstep s
fs Either x y
r
        case Step s z
res of
            FL.Partial s
fs1 -> (z -> Final s z) -> m z -> m (Final s z)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> z -> Final s z
forall s b. Int -> b -> Final s b
FDone Int
n) (m z -> m (Final s z)) -> m z -> m (Final s z)
forall a b. (a -> b) -> a -> b
$ s -> m z
ffinal s
fs1
            FL.Done z
c -> Final s z -> m (Final s z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> z -> Final s z
forall s b. Int -> b -> Final s b
FDone Int
n z
c)

    extract :: Deintercalate1State y s s ss
-> m (Final (Deintercalate1State y s s ss) z)
extract (Deintercalate1InitL Int
cnt s
fs s
sL) = do
        Final s x
r <- s -> m (Final s x)
extractL s
sL
        case Final s x
r of
            FDone Int
n x
b -> Int
-> s -> Either x y -> m (Final (Deintercalate1State y s s ss) z)
forall {s}. Int -> s -> Either x y -> m (Final s z)
extractResult Int
n s
fs (x -> Either x y
forall a b. a -> Either a b
Left x
b)
            FContinue Int
n s
s -> Final (Deintercalate1State y s s ss) z
-> m (Final (Deintercalate1State y s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (Deintercalate1State y s s ss) z
 -> m (Final (Deintercalate1State y s s ss) z))
-> Final (Deintercalate1State y s s ss) z
-> m (Final (Deintercalate1State y s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int
-> Deintercalate1State y s s ss
-> Final (Deintercalate1State y s s ss) z
forall s b. Int -> s -> Final s b
FContinue Int
n (Int -> s -> s -> Deintercalate1State y s s ss
forall b fs sp ss.
Int -> fs -> sp -> Deintercalate1State b fs sp ss
Deintercalate1InitL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            FError String
err -> Final (Deintercalate1State y s s ss) z
-> m (Final (Deintercalate1State y s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (Deintercalate1State y s s ss) z
 -> m (Final (Deintercalate1State y s s ss) z))
-> Final (Deintercalate1State y s s ss) z
-> m (Final (Deintercalate1State y s s ss) z)
forall a b. (a -> b) -> a -> b
$ String -> Final (Deintercalate1State y s s ss) z
forall s b. String -> Final s b
FError String
err
    extract (Deintercalate1InitR s
fs) = (z -> Final (Deintercalate1State y s s ss) z)
-> m z -> m (Final (Deintercalate1State y s s ss) z)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> z -> Final (Deintercalate1State y s s ss) z
forall s b. Int -> b -> Final s b
FDone Int
0) (m z -> m (Final (Deintercalate1State y s s ss) z))
-> m z -> m (Final (Deintercalate1State y s s ss) z)
forall a b. (a -> b) -> a -> b
$ s -> m z
ffinal s
fs
    extract (Deintercalate1R Int
cnt s
fs ss
_) = (z -> Final (Deintercalate1State y s s ss) z)
-> m z -> m (Final (Deintercalate1State y s s ss) z)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> z -> Final (Deintercalate1State y s s ss) z
forall s b. Int -> b -> Final s b
FDone (- Int
cnt)) (m z -> m (Final (Deintercalate1State y s s ss) z))
-> m z -> m (Final (Deintercalate1State y s s ss) z)
forall a b. (a -> b) -> a -> b
$ s -> m z
ffinal s
fs
    extract (Deintercalate1RL Int
cnt y
bR s
fs s
sL) = do
        Final s x
r <- s -> m (Final s x)
extractL s
sL
        case Final s x
r of
            FDone Int
n x
bL -> do
                Step s z
res <- s -> Either x y -> m (Step s z)
fstep s
fs (y -> Either x y
forall a b. b -> Either a b
Right y
bR)
                case Step s z
res of
                    FL.Partial s
fs1 -> Int
-> s -> Either x y -> m (Final (Deintercalate1State y s s ss) z)
forall {s}. Int -> s -> Either x y -> m (Final s z)
extractResult Int
n s
fs1 (x -> Either x y
forall a b. a -> Either a b
Left x
bL)
                    FL.Done z
_ -> String -> m (Final (Deintercalate1State y s s ss) z)
forall a. HasCallStack => String -> a
error String
"Fold terminated consuming partial input"
            FContinue Int
n s
s -> Final (Deintercalate1State y s s ss) z
-> m (Final (Deintercalate1State y s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (Deintercalate1State y s s ss) z
 -> m (Final (Deintercalate1State y s s ss) z))
-> Final (Deintercalate1State y s s ss) z
-> m (Final (Deintercalate1State y s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int
-> Deintercalate1State y s s ss
-> Final (Deintercalate1State y s s ss) z
forall s b. Int -> s -> Final s b
FContinue Int
n (Int -> y -> s -> s -> Deintercalate1State y s s ss
forall b fs sp ss.
Int -> b -> fs -> sp -> Deintercalate1State b fs sp ss
Deintercalate1RL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) y
bR s
fs s
s)
            FError String
_ -> do
                z
xs <- s -> m z
ffinal s
fs
                Final (Deintercalate1State y s s ss) z
-> m (Final (Deintercalate1State y s s ss) z)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (Deintercalate1State y s s ss) z
 -> m (Final (Deintercalate1State y s s ss) z))
-> Final (Deintercalate1State y s s ss) z
-> m (Final (Deintercalate1State y s s ss) z)
forall a b. (a -> b) -> a -> b
$ Int -> z -> Final (Deintercalate1State y s s ss) z
forall s b. Int -> b -> Final s b
FDone (- Int
cnt) z
xs

{-# ANN type SepByState Fuse #-}
data SepByState fs sp ss =
      SepByInitL !fs
    | SepByL !Int !fs !sp
    | SepByInitR !fs
    | SepByR !Int !fs !ss

-- | Apply two parsers alternately to an input stream. Parsing starts at the
-- first parser and stops at the first parser. The output of the first parser
-- is emiited and the output of the second parser is discarded. It can be used
-- to parse a infix style pattern e.g. p1 p2 p1 . Empty input or single parse
-- of the first parser is accepted.
--
-- Definitions:
--
-- >>> sepBy p1 p2 f = Parser.deintercalate p1 p2 (Fold.catLefts f)
-- >>> sepBy p1 p2 f = Parser.sepBy1 p1 p2 f <|> Parser.fromEffect (Fold.finalM f)
--
-- Examples:
--
-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
-- >>> p2 = Parser.satisfy (== '+')
-- >>> p = Parser.sepBy p1 p2 Fold.toList
-- >>> Stream.parse p $ Stream.fromList ""
-- Right []
-- >>> Stream.parse p $ Stream.fromList "1"
-- Right ["1"]
-- >>> Stream.parse p $ Stream.fromList "1+"
-- Right ["1"]
-- >>> Stream.parse p $ Stream.fromList "1+2+3"
-- Right ["1","2","3"]
--
{-# INLINE sepBy #-}
sepBy :: Monad m =>
    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
-- This has similar performance as the custom impl below.
-- sepBy p1 p2 f = deintercalate p1 p2 (FL.catLefts f)
sepBy :: forall (m :: * -> *) a b x c.
Monad m =>
Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
sepBy
    (Parser s -> a -> m (Step s b)
stepL m (Initial s b)
initialL s -> m (Final s b)
extractL)
    (Parser s -> a -> m (Step s x)
stepR m (Initial s x)
initialR s -> m (Final s x)
_)
    (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
_ s -> m c
ffinal) = (SepByState s s s -> a -> m (Step (SepByState s s s) c))
-> m (Initial (SepByState s s s) c)
-> (SepByState s s s -> m (Final (SepByState s 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 SepByState s s s -> a -> m (Step (SepByState s s s) c)
step m (Initial (SepByState s s s) c)
forall {sp} {ss}. m (Initial (SepByState s sp ss) c)
initial SepByState s s s -> m (Final (SepByState s s s) c)
forall {ss} {ss}.
SepByState s s ss -> m (Final (SepByState s s ss) c)
extract

    where

    errMsg :: String -> String -> a
errMsg String
p String
status =
        String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"sepBy: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" parser cannot "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
status String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" without input"

    initial :: m (Initial (SepByState s sp ss) c)
initial = do
        Step s c
res <- m (Step s c)
finitial
        case Step s c
res of
            FL.Partial s
fs -> Initial (SepByState s sp ss) c
-> m (Initial (SepByState s sp ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SepByState s sp ss) c
 -> m (Initial (SepByState s sp ss) c))
-> Initial (SepByState s sp ss) c
-> m (Initial (SepByState s sp ss) c)
forall a b. (a -> b) -> a -> b
$ SepByState s sp ss -> Initial (SepByState s sp ss) c
forall s b. s -> Initial s b
IPartial (SepByState s sp ss -> Initial (SepByState s sp ss) c)
-> SepByState s sp ss -> Initial (SepByState s sp ss) c
forall a b. (a -> b) -> a -> b
$ s -> SepByState s sp ss
forall fs sp ss. fs -> SepByState fs sp ss
SepByInitL s
fs
            FL.Done c
c -> Initial (SepByState s sp ss) c
-> m (Initial (SepByState s sp ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SepByState s sp ss) c
 -> m (Initial (SepByState s sp ss) c))
-> Initial (SepByState s sp ss) c
-> m (Initial (SepByState s sp ss) c)
forall a b. (a -> b) -> a -> b
$ c -> Initial (SepByState s sp ss) c
forall s b. b -> Initial s b
IDone c
c

    {-# INLINE processL #-}
    processL :: m (Step t b) -> Int -> (t -> s) -> m (Step s b)
processL m (Step t b)
foldAction Int
n t -> s
nextState = do
        Step t b
fres <- m (Step t b)
foldAction
        case Step t b
fres of
            FL.Partial t
fs1 -> 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
n (t -> s
nextState t
fs1)
            FL.Done b
c -> 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 -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
n b
c

    {-# INLINE runStepL #-}
    runStepL :: Int -> s -> s -> a -> m (Step (SepByState s s ss) c)
runStepL Int
cnt s
fs s
sL a
a = do
        Step s b
r <- s -> a -> m (Step s b)
stepL s
sL a
a
        case Step s b
r of
            SPartial Int
n s
s -> Step (SepByState s s ss) c -> m (Step (SepByState s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepByState s s ss) c -> m (Step (SepByState s s ss) c))
-> Step (SepByState s s ss) c -> m (Step (SepByState s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepByState s s ss -> Step (SepByState s s ss) c
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> SepByState s s ss
forall fs sp ss. Int -> fs -> sp -> SepByState fs sp ss
SepByL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SContinue Int
n s
s -> Step (SepByState s s ss) c -> m (Step (SepByState s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepByState s s ss) c -> m (Step (SepByState s s ss) c))
-> Step (SepByState s s ss) c -> m (Step (SepByState s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepByState s s ss -> Step (SepByState s s ss) c
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> SepByState s s ss
forall fs sp ss. Int -> fs -> sp -> SepByState fs sp ss
SepByL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SDone Int
n b
b ->
                m (Step s c)
-> Int
-> (s -> SepByState s s ss)
-> m (Step (SepByState s s ss) c)
forall {m :: * -> *} {t} {b} {s}.
Monad m =>
m (Step t b) -> Int -> (t -> s) -> m (Step s b)
processL (s -> b -> m (Step s c)
fstep s
fs b
b) Int
n s -> SepByState s s ss
forall fs sp ss. fs -> SepByState fs sp ss
SepByInitR
            SError String
_ -> do
                c
xs <- s -> m c
ffinal s
fs
                Step (SepByState s s ss) c -> m (Step (SepByState s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepByState s s ss) c -> m (Step (SepByState s s ss) c))
-> Step (SepByState s s ss) c -> m (Step (SepByState s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (SepByState s s ss) c
forall s b. Int -> b -> Step s b
SDone (- Int
cnt) c
xs

    {-# INLINE processR #-}
    processR :: Int -> fs -> Int -> m (Step (SepByState fs s ss) b)
processR Int
cnt fs
fs Int
n = do
        Initial s b
res <- m (Initial s b)
initialL
        case Initial s b
res of
            IPartial s
ps -> Step (SepByState fs s ss) b -> m (Step (SepByState fs s ss) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepByState fs s ss) b -> m (Step (SepByState fs s ss) b))
-> Step (SepByState fs s ss) b -> m (Step (SepByState fs s ss) b)
forall a b. (a -> b) -> a -> b
$ Int -> SepByState fs s ss -> Step (SepByState fs s ss) b
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> fs -> s -> SepByState fs s ss
forall fs sp ss. Int -> fs -> sp -> SepByState fs sp ss
SepByL Int
cnt fs
fs s
ps)
            IDone b
_ -> String -> String -> m (Step (SepByState fs s ss) b)
forall {a}. String -> String -> a
errMsg String
"left" String
"succeed"
            IError String
_ -> String -> String -> m (Step (SepByState fs s ss) b)
forall {a}. String -> String -> a
errMsg String
"left" String
"fail"

    {-# INLINE runStepR #-}
    runStepR :: Int -> s -> s -> a -> m (Step (SepByState s s s) c)
runStepR Int
cnt s
fs s
sR a
a = do
        Step s x
r <- s -> a -> m (Step s x)
stepR s
sR a
a
        case Step s x
r of
            SPartial Int
n s
s -> Step (SepByState s s s) c -> m (Step (SepByState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepByState s s s) c -> m (Step (SepByState s s s) c))
-> Step (SepByState s s s) c -> m (Step (SepByState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepByState s s s -> Step (SepByState s s s) c
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> SepByState s s s
forall fs sp ss. Int -> fs -> ss -> SepByState fs sp ss
SepByR (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SContinue Int
n s
s -> Step (SepByState s s s) c -> m (Step (SepByState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepByState s s s) c -> m (Step (SepByState s s s) c))
-> Step (SepByState s s s) c -> m (Step (SepByState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepByState s s s -> Step (SepByState s s s) c
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> SepByState s s s
forall fs sp ss. Int -> fs -> ss -> SepByState fs sp ss
SepByR (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SDone Int
n x
_ -> Int -> s -> Int -> m (Step (SepByState s s s) c)
forall {fs} {ss} {b}.
Int -> fs -> Int -> m (Step (SepByState fs s ss) b)
processR (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs Int
n
            SError String
_ -> do
                c
xs <- s -> m c
ffinal s
fs
                Step (SepByState s s s) c -> m (Step (SepByState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepByState s s s) c -> m (Step (SepByState s s s) c))
-> Step (SepByState s s s) c -> m (Step (SepByState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (SepByState s s s) c
forall s b. Int -> b -> Step s b
SDone (- Int
cnt) c
xs

    step :: SepByState s s s -> a -> m (Step (SepByState s s s) c)
step (SepByInitL s
fs) a
a = do
        Initial s b
res <- m (Initial s b)
initialL
        case Initial s b
res of
            IPartial s
s -> Int -> s -> s -> a -> m (Step (SepByState s s s) c)
forall {ss}. Int -> s -> s -> a -> m (Step (SepByState s s ss) c)
runStepL Int
0 s
fs s
s a
a
            IDone b
_ -> String -> String -> m (Step (SepByState s s s) c)
forall {a}. String -> String -> a
errMsg String
"left" String
"succeed"
            IError String
_ -> String -> String -> m (Step (SepByState s s s) c)
forall {a}. String -> String -> a
errMsg String
"left" String
"fail"
    step (SepByL Int
cnt s
fs s
sL) a
a = Int -> s -> s -> a -> m (Step (SepByState s s s) c)
forall {ss}. Int -> s -> s -> a -> m (Step (SepByState s s ss) c)
runStepL Int
cnt s
fs s
sL a
a
    step (SepByInitR s
fs) a
a = do
        Initial s x
res <- m (Initial s x)
initialR
        case Initial s x
res of
            IPartial s
s -> Int -> s -> s -> a -> m (Step (SepByState s s s) c)
runStepR Int
0 s
fs s
s a
a
            IDone x
_ -> String -> String -> m (Step (SepByState s s s) c)
forall {a}. String -> String -> a
errMsg String
"right" String
"succeed"
            IError String
_ -> String -> String -> m (Step (SepByState s s s) c)
forall {a}. String -> String -> a
errMsg String
"right" String
"fail"
    step (SepByR Int
cnt s
fs s
sR) a
a = Int -> s -> s -> a -> m (Step (SepByState s s s) c)
runStepR Int
cnt s
fs s
sR a
a

    {-# INLINE extractResult #-}
    extractResult :: Int -> s -> b -> m (Final s c)
extractResult Int
n s
fs b
r = do
        Step s c
res <- s -> b -> m (Step s c)
fstep s
fs b
r
        case Step s c
res of
            FL.Partial s
fs1 -> (c -> Final s c) -> m c -> m (Final 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 s c
forall s b. Int -> b -> Final s b
FDone Int
n) (m c -> m (Final s c)) -> m c -> m (Final s c)
forall a b. (a -> b) -> a -> b
$ s -> m c
ffinal s
fs1
            FL.Done c
c -> Final s c -> m (Final s c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Final s c
forall s b. Int -> b -> Final s b
FDone Int
n c
c)

    extract :: SepByState s s ss -> m (Final (SepByState s s ss) c)
extract (SepByInitL s
fs) = (c -> Final (SepByState s s ss) c)
-> m c -> m (Final (SepByState s s ss) 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 (SepByState s s ss) c
forall s b. Int -> b -> Final s b
FDone Int
0) (m c -> m (Final (SepByState s s ss) c))
-> m c -> m (Final (SepByState s s ss) c)
forall a b. (a -> b) -> a -> b
$ s -> m c
ffinal s
fs
    extract (SepByL Int
cnt s
fs s
sL) = do
        Final s b
r <- s -> m (Final s b)
extractL s
sL
        case Final s b
r of
            FDone Int
n b
b -> Int -> s -> b -> m (Final (SepByState s s ss) c)
forall {s}. Int -> s -> b -> m (Final s c)
extractResult Int
n s
fs b
b
            FContinue Int
n s
s -> Final (SepByState s s ss) c -> m (Final (SepByState s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SepByState s s ss) c -> m (Final (SepByState s s ss) c))
-> Final (SepByState s s ss) c -> m (Final (SepByState s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepByState s s ss -> Final (SepByState s s ss) c
forall s b. Int -> s -> Final s b
FContinue Int
n (Int -> s -> s -> SepByState s s ss
forall fs sp ss. Int -> fs -> sp -> SepByState fs sp ss
SepByL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            FError String
_ -> do
                c
xs <- s -> m c
ffinal s
fs
                Final (SepByState s s ss) c -> m (Final (SepByState s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SepByState s s ss) c -> m (Final (SepByState s s ss) c))
-> Final (SepByState s s ss) c -> m (Final (SepByState s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Final (SepByState s s ss) c
forall s b. Int -> b -> Final s b
FDone (- Int
cnt) c
xs
    extract (SepByInitR s
fs) = (c -> Final (SepByState s s ss) c)
-> m c -> m (Final (SepByState s s ss) 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 (SepByState s s ss) c
forall s b. Int -> b -> Final s b
FDone Int
0) (m c -> m (Final (SepByState s s ss) c))
-> m c -> m (Final (SepByState s s ss) c)
forall a b. (a -> b) -> a -> b
$ s -> m c
ffinal s
fs
    extract (SepByR Int
cnt s
fs ss
_) = (c -> Final (SepByState s s ss) c)
-> m c -> m (Final (SepByState s s ss) 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 (SepByState s s ss) c
forall s b. Int -> b -> Final s b
FDone (- Int
cnt)) (m c -> m (Final (SepByState s s ss) c))
-> m c -> m (Final (SepByState s s ss) c)
forall a b. (a -> b) -> a -> b
$ s -> m c
ffinal s
fs

-- | Non-backtracking version of sepBy. Several times faster.
{-# INLINE sepByAll #-}
sepByAll :: Monad m =>
    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
sepByAll :: forall (m :: * -> *) a b x c.
Monad m =>
Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
sepByAll Parser a m b
p1 Parser a m x
p2 Fold m b c
f = Parser a m b
-> Parser a m x -> Fold m (Either b x) c -> Parser a m c
forall (m :: * -> *) a x y z.
Monad m =>
Parser a m x
-> Parser a m y -> Fold m (Either x y) z -> Parser a m z
deintercalateAll Parser a m b
p1 Parser a m x
p2 (Fold m b c -> Fold m (Either b x) c
forall (m :: * -> *) a c b.
Monad m =>
Fold m a c -> Fold m (Either a b) c
FL.catLefts Fold m b c
f)

-- XXX This can be implemented using refold, parse one and then continue
-- collecting the rest in that.

{-# ANN type SepBy1State Fuse #-}
data SepBy1State fs sp ss =
      SepBy1InitL !Int !fs sp
    | SepBy1L !Int !fs !sp
    | SepBy1InitR !fs
    | SepBy1R !Int !fs !ss

{-
{-# INLINE sepBy1 #-}
sepBy1 :: Monad m =>
    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
sepBy1 p sep sink = do
    x <- p
    f <- fromEffect $ FL.reduce sink
    f1 <- fromEffect $ FL.snoc f x
    many (sep >> p) f1
-}

-- | Like 'sepBy' but requires at least one successful parse.
--
-- Definition:
--
-- >>> sepBy1 p1 p2 f = Parser.deintercalate1 p1 p2 (Fold.catLefts f)
--
-- Examples:
--
-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
-- >>> p2 = Parser.satisfy (== '+')
-- >>> p = Parser.sepBy1 p1 p2 Fold.toList
-- >>> Stream.parsePos p $ Stream.fromList ""
-- Left (ParseErrorPos 0 "takeWhile1: end of input")
-- >>> Stream.parse p $ Stream.fromList "1"
-- Right ["1"]
-- >>> Stream.parse p $ Stream.fromList "1+"
-- Right ["1"]
-- >>> Stream.parse p $ Stream.fromList "1+2+3"
-- Right ["1","2","3"]
--
{-# INLINE sepBy1 #-}
sepBy1 :: Monad m =>
    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
sepBy1 :: forall (m :: * -> *) a b x c.
Monad m =>
Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
sepBy1
    (Parser s -> a -> m (Step s b)
stepL m (Initial s b)
initialL s -> m (Final s b)
extractL)
    (Parser s -> a -> m (Step s x)
stepR m (Initial s x)
initialR s -> m (Final s x)
_)
    (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
_ s -> m c
ffinal) = (SepBy1State s s s -> a -> m (Step (SepBy1State s s s) c))
-> m (Initial (SepBy1State s s s) c)
-> (SepBy1State s s s -> m (Final (SepBy1State s 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 SepBy1State s s s -> a -> m (Step (SepBy1State s s s) c)
step m (Initial (SepBy1State s s s) c)
forall {ss}. m (Initial (SepBy1State s s ss) c)
initial SepBy1State s s s -> m (Final (SepBy1State s s s) c)
forall {ss} {ss}.
SepBy1State s s ss -> m (Final (SepBy1State s s ss) c)
extract

    where

    errMsg :: String -> String -> a
errMsg String
p String
status =
        String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"sepBy: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" parser cannot "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
status String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" without input"

    initial :: m (Initial (SepBy1State s s ss) c)
initial = do
        Step s c
res <- m (Step s c)
finitial
        case Step s c
res of
            FL.Partial s
fs -> do
                Initial s b
pres <- m (Initial s b)
initialL
                case Initial s b
pres of
                    IPartial s
s -> Initial (SepBy1State s s ss) c
-> m (Initial (SepBy1State s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SepBy1State s s ss) c
 -> m (Initial (SepBy1State s s ss) c))
-> Initial (SepBy1State s s ss) c
-> m (Initial (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ SepBy1State s s ss -> Initial (SepBy1State s s ss) c
forall s b. s -> Initial s b
IPartial (SepBy1State s s ss -> Initial (SepBy1State s s ss) c)
-> SepBy1State s s ss -> Initial (SepBy1State s s ss) c
forall a b. (a -> b) -> a -> b
$ Int -> s -> s -> SepBy1State s s ss
forall fs sp ss. Int -> fs -> sp -> SepBy1State fs sp ss
SepBy1InitL Int
0 s
fs s
s
                    IDone b
_ -> String -> String -> m (Initial (SepBy1State s s ss) c)
forall {a}. String -> String -> a
errMsg String
"left" String
"succeed"
                    IError String
_ -> String -> String -> m (Initial (SepBy1State s s ss) c)
forall {a}. String -> String -> a
errMsg String
"left" String
"fail"
            FL.Done c
c -> Initial (SepBy1State s s ss) c
-> m (Initial (SepBy1State s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (SepBy1State s s ss) c
 -> m (Initial (SepBy1State s s ss) c))
-> Initial (SepBy1State s s ss) c
-> m (Initial (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ c -> Initial (SepBy1State s s ss) c
forall s b. b -> Initial s b
IDone c
c

    {-# INLINE processL #-}
    processL :: m (Step t b) -> Int -> (t -> s) -> m (Step s b)
processL m (Step t b)
foldAction Int
n t -> s
nextState = do
        Step t b
fres <- m (Step t b)
foldAction
        case Step t b
fres of
            FL.Partial t
fs1 -> 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
n (t -> s
nextState t
fs1)
            FL.Done b
c -> 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 -> b -> Step s b
forall s b. Int -> b -> Step s b
SDone Int
n b
c

    {-# INLINE runStepInitL #-}
    runStepInitL :: Int -> s -> s -> a -> m (Step (SepBy1State s s ss) c)
runStepInitL Int
cnt s
fs s
sL a
a = do
        Step s b
r <- s -> a -> m (Step s b)
stepL s
sL a
a
        case Step s b
r of
            SPartial Int
n s
s -> Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c))
-> Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepBy1State s s ss -> Step (SepBy1State s s ss) c
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> SepBy1State s s ss
forall fs sp ss. Int -> fs -> sp -> SepBy1State fs sp ss
SepBy1InitL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SContinue Int
n s
s -> Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c))
-> Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepBy1State s s ss -> Step (SepBy1State s s ss) c
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> SepBy1State s s ss
forall fs sp ss. Int -> fs -> sp -> SepBy1State fs sp ss
SepBy1InitL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SDone Int
n b
b ->
                m (Step s c)
-> Int
-> (s -> SepBy1State s s ss)
-> m (Step (SepBy1State s s ss) c)
forall {m :: * -> *} {t} {b} {s}.
Monad m =>
m (Step t b) -> Int -> (t -> s) -> m (Step s b)
processL (s -> b -> m (Step s c)
fstep s
fs b
b) Int
n s -> SepBy1State s s ss
forall fs sp ss. fs -> SepBy1State fs sp ss
SepBy1InitR
            SError String
err -> Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c))
-> Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (SepBy1State s s ss) c
forall s b. String -> Step s b
SError String
err

    {-# INLINE runStepL #-}
    runStepL :: Int -> s -> s -> a -> m (Step (SepBy1State s s ss) c)
runStepL Int
cnt s
fs s
sL a
a = do
        Step s b
r <- s -> a -> m (Step s b)
stepL s
sL a
a
        case Step s b
r of
            SPartial Int
n s
s -> Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c))
-> Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepBy1State s s ss -> Step (SepBy1State s s ss) c
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> SepBy1State s s ss
forall fs sp ss. Int -> fs -> sp -> SepBy1State fs sp ss
SepBy1L (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SContinue Int
n s
s -> Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c))
-> Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepBy1State s s ss -> Step (SepBy1State s s ss) c
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> SepBy1State s s ss
forall fs sp ss. Int -> fs -> sp -> SepBy1State fs sp ss
SepBy1L (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SDone Int
n b
b ->
                m (Step s c)
-> Int
-> (s -> SepBy1State s s ss)
-> m (Step (SepBy1State s s ss) c)
forall {m :: * -> *} {t} {b} {s}.
Monad m =>
m (Step t b) -> Int -> (t -> s) -> m (Step s b)
processL (s -> b -> m (Step s c)
fstep s
fs b
b) Int
n s -> SepBy1State s s ss
forall fs sp ss. fs -> SepBy1State fs sp ss
SepBy1InitR
            SError String
_ -> do
                c
xs <- s -> m c
ffinal s
fs
                Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c))
-> Step (SepBy1State s s ss) c -> m (Step (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (SepBy1State s s ss) c
forall s b. Int -> b -> Step s b
SDone (- Int
cnt) c
xs

    {-# INLINE processR #-}
    processR :: Int -> fs -> Int -> m (Step (SepBy1State fs s ss) b)
processR Int
cnt fs
fs Int
n = do
        Initial s b
res <- m (Initial s b)
initialL
        case Initial s b
res of
            IPartial s
ps -> Step (SepBy1State fs s ss) b -> m (Step (SepBy1State fs s ss) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepBy1State fs s ss) b -> m (Step (SepBy1State fs s ss) b))
-> Step (SepBy1State fs s ss) b -> m (Step (SepBy1State fs s ss) b)
forall a b. (a -> b) -> a -> b
$ Int -> SepBy1State fs s ss -> Step (SepBy1State fs s ss) b
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> fs -> s -> SepBy1State fs s ss
forall fs sp ss. Int -> fs -> sp -> SepBy1State fs sp ss
SepBy1L Int
cnt fs
fs s
ps)
            IDone b
_ -> String -> String -> m (Step (SepBy1State fs s ss) b)
forall {a}. String -> String -> a
errMsg String
"left" String
"succeed"
            IError String
_ -> String -> String -> m (Step (SepBy1State fs s ss) b)
forall {a}. String -> String -> a
errMsg String
"left" String
"fail"

    {-# INLINE runStepR #-}
    runStepR :: Int -> s -> s -> a -> m (Step (SepBy1State s s s) c)
runStepR Int
cnt s
fs s
sR a
a = do
        Step s x
r <- s -> a -> m (Step s x)
stepR s
sR a
a
        case Step s x
r of
            SPartial Int
n s
s -> Step (SepBy1State s s s) c -> m (Step (SepBy1State s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepBy1State s s s) c -> m (Step (SepBy1State s s s) c))
-> Step (SepBy1State s s s) c -> m (Step (SepBy1State s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepBy1State s s s -> Step (SepBy1State s s s) c
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> SepBy1State s s s
forall fs sp ss. Int -> fs -> ss -> SepBy1State fs sp ss
SepBy1R (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SContinue Int
n s
s -> Step (SepBy1State s s s) c -> m (Step (SepBy1State s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepBy1State s s s) c -> m (Step (SepBy1State s s s) c))
-> Step (SepBy1State s s s) c -> m (Step (SepBy1State s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepBy1State s s s -> Step (SepBy1State s s s) c
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> SepBy1State s s s
forall fs sp ss. Int -> fs -> ss -> SepBy1State fs sp ss
SepBy1R (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            -- XXX review, need tests for sepBy1
            SDone Int
n x
_ -> Int -> s -> Int -> m (Step (SepBy1State s s s) c)
forall {fs} {ss} {b}.
Int -> fs -> Int -> m (Step (SepBy1State fs s ss) b)
processR (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs Int
n
            SError String
_ -> do
                c
xs <- s -> m c
ffinal s
fs
                Step (SepBy1State s s s) c -> m (Step (SepBy1State s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SepBy1State s s s) c -> m (Step (SepBy1State s s s) c))
-> Step (SepBy1State s s s) c -> m (Step (SepBy1State s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (SepBy1State s s s) c
forall s b. Int -> b -> Step s b
SDone (-Int
cnt) c
xs

    step :: SepBy1State s s s -> a -> m (Step (SepBy1State s s s) c)
step (SepBy1InitL Int
cnt s
fs s
sL) a
a = Int -> s -> s -> a -> m (Step (SepBy1State s s s) c)
forall {ss}. Int -> s -> s -> a -> m (Step (SepBy1State s s ss) c)
runStepInitL Int
cnt s
fs s
sL a
a
    step (SepBy1L Int
cnt s
fs s
sL) a
a = Int -> s -> s -> a -> m (Step (SepBy1State s s s) c)
forall {ss}. Int -> s -> s -> a -> m (Step (SepBy1State s s ss) c)
runStepL Int
cnt s
fs s
sL a
a
    step (SepBy1InitR s
fs) a
a = do
        Initial s x
res <- m (Initial s x)
initialR
        case Initial s x
res of
            IPartial s
s -> Int -> s -> s -> a -> m (Step (SepBy1State s s s) c)
runStepR Int
0 s
fs s
s a
a
            IDone x
_ -> String -> String -> m (Step (SepBy1State s s s) c)
forall {a}. String -> String -> a
errMsg String
"right" String
"succeed"
            IError String
_ -> String -> String -> m (Step (SepBy1State s s s) c)
forall {a}. String -> String -> a
errMsg String
"right" String
"fail"
    step (SepBy1R Int
cnt s
fs s
sR) a
a = Int -> s -> s -> a -> m (Step (SepBy1State s s s) c)
runStepR Int
cnt s
fs s
sR a
a

    {-# INLINE extractResult #-}
    extractResult :: Int -> s -> b -> m (Final s c)
extractResult Int
n s
fs b
r = do
        Step s c
res <- s -> b -> m (Step s c)
fstep s
fs b
r
        case Step s c
res of
            FL.Partial s
fs1 -> (c -> Final s c) -> m c -> m (Final 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 s c
forall s b. Int -> b -> Final s b
FDone Int
n) (m c -> m (Final s c)) -> m c -> m (Final s c)
forall a b. (a -> b) -> a -> b
$ s -> m c
ffinal s
fs1
            FL.Done c
c -> Final s c -> m (Final s c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Final s c
forall s b. Int -> b -> Final s b
FDone Int
n c
c)

    extract :: SepBy1State s s ss -> m (Final (SepBy1State s s ss) c)
extract (SepBy1InitL Int
cnt s
fs s
sL) = do
        Final s b
r <- s -> m (Final s b)
extractL s
sL
        case Final s b
r of
            FDone Int
n b
b -> Int -> s -> b -> m (Final (SepBy1State s s ss) c)
forall {s}. Int -> s -> b -> m (Final s c)
extractResult Int
n s
fs b
b
            FContinue Int
n s
s -> Final (SepBy1State s s ss) c -> m (Final (SepBy1State s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SepBy1State s s ss) c -> m (Final (SepBy1State s s ss) c))
-> Final (SepBy1State s s ss) c -> m (Final (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepBy1State s s ss -> Final (SepBy1State s s ss) c
forall s b. Int -> s -> Final s b
FContinue Int
n (Int -> s -> s -> SepBy1State s s ss
forall fs sp ss. Int -> fs -> sp -> SepBy1State fs sp ss
SepBy1InitL (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            FError String
err -> Final (SepBy1State s s ss) c -> m (Final (SepBy1State s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SepBy1State s s ss) c -> m (Final (SepBy1State s s ss) c))
-> Final (SepBy1State s s ss) c -> m (Final (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ String -> Final (SepBy1State s s ss) c
forall s b. String -> Final s b
FError String
err
    extract (SepBy1L Int
cnt s
fs s
sL) = do
        Final s b
r <- s -> m (Final s b)
extractL s
sL
        case Final s b
r of
            FDone Int
n b
b -> Int -> s -> b -> m (Final (SepBy1State s s ss) c)
forall {s}. Int -> s -> b -> m (Final s c)
extractResult Int
n s
fs b
b
            FContinue Int
n s
s -> Final (SepBy1State s s ss) c -> m (Final (SepBy1State s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SepBy1State s s ss) c -> m (Final (SepBy1State s s ss) c))
-> Final (SepBy1State s s ss) c -> m (Final (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> SepBy1State s s ss -> Final (SepBy1State s s ss) c
forall s b. Int -> s -> Final s b
FContinue Int
n (Int -> s -> s -> SepBy1State s s ss
forall fs sp ss. Int -> fs -> sp -> SepBy1State fs sp ss
SepBy1L (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            FError String
_ -> do
                c
xs <- s -> m c
ffinal s
fs
                Final (SepBy1State s s ss) c -> m (Final (SepBy1State s s ss) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (SepBy1State s s ss) c -> m (Final (SepBy1State s s ss) c))
-> Final (SepBy1State s s ss) c -> m (Final (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Final (SepBy1State s s ss) c
forall s b. Int -> b -> Final s b
FDone (- Int
cnt) c
xs
    extract (SepBy1InitR s
fs) = (c -> Final (SepBy1State s s ss) c)
-> m c -> m (Final (SepBy1State s s ss) 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 (SepBy1State s s ss) c
forall s b. Int -> b -> Final s b
FDone Int
0) (m c -> m (Final (SepBy1State s s ss) c))
-> m c -> m (Final (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ s -> m c
ffinal s
fs
    extract (SepBy1R Int
cnt s
fs ss
_) = (c -> Final (SepBy1State s s ss) c)
-> m c -> m (Final (SepBy1State s s ss) 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 (SepBy1State s s ss) c
forall s b. Int -> b -> Final s b
FDone (- Int
cnt)) (m c -> m (Final (SepBy1State s s ss) c))
-> m c -> m (Final (SepBy1State s s ss) c)
forall a b. (a -> b) -> a -> b
$ s -> m c
ffinal s
fs

-------------------------------------------------------------------------------
-- Interleaving a collection of parsers
-------------------------------------------------------------------------------
--
-- | Apply a collection of parsers to an input stream in a round robin fashion.
-- Each parser is applied until it stops and then we repeat starting with the
-- the first parser again.
--
-- /Unimplemented/
--
{-# INLINE roundRobin #-}
roundRobin :: -- (Foldable t, Monad m) =>
    t (Parser a m b) -> Fold m b c -> Parser a m c
roundRobin :: forall (t :: * -> *) a (m :: * -> *) b c.
t (Parser a m b) -> Fold m b c -> Parser a m c
roundRobin t (Parser a m b)
_ps Fold m b c
_f = Parser a m c
forall a. HasCallStack => a
undefined

-------------------------------------------------------------------------------
-- Sequential Collection
-------------------------------------------------------------------------------

-- | @sequence f p@ collects sequential parses of parsers in a
-- serial stream @p@ using the fold @f@. Fails if the input ends or any
-- of the parsers fail.
--
-- /Pre-release/
--
{-# INLINE sequence #-}
sequence :: Monad m =>
    D.Stream m (Parser a m b) -> Fold m b c -> Parser a m c
sequence :: forall (m :: * -> *) a b c.
Monad m =>
Stream m (Parser a m b) -> Fold m b c -> Parser a m c
sequence (D.Stream State StreamK m (Parser a m b) -> s -> m (Step s (Parser a m b))
sstep s
sstate) (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
_ s -> m c
ffinal) =
    ((Maybe' (Parser a m b), s, s)
 -> a -> m (Step (Maybe' (Parser a m b), s, s) c))
-> m (Initial (Maybe' (Parser a m b), s, s) c)
-> ((Maybe' (Parser a m b), s, s)
    -> m (Final (Maybe' (Parser a m b), 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 (Maybe' (Parser a m b), s, s)
-> a -> m (Step (Maybe' (Parser a m b), s, s) c)
step m (Initial (Maybe' (Parser a m b), s, s) c)
forall {a}. m (Initial (Maybe' a, s, s) c)
initial (Maybe' (Parser a m b), s, s)
-> m (Final (Maybe' (Parser a m b), s, s) c)
forall {a} {b}.
(Maybe' (Parser a m b), b, s)
-> m (Final (Maybe' (Parser a m b), b, s) c)
extract

    where

    initial :: m (Initial (Maybe' a, s, s) c)
initial = do
        Step s c
fres <- m (Step s c)
finitial
        case Step s c
fres of
            FL.Partial s
fs -> Initial (Maybe' a, s, s) c -> m (Initial (Maybe' a, s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Maybe' a, s, s) c -> m (Initial (Maybe' a, s, s) c))
-> Initial (Maybe' a, s, s) c -> m (Initial (Maybe' a, s, s) c)
forall a b. (a -> b) -> a -> b
$ (Maybe' a, s, s) -> Initial (Maybe' a, s, s) c
forall s b. s -> Initial s b
IPartial (Maybe' a
forall a. Maybe' a
Nothing', s
sstate, s
fs)
            FL.Done c
c -> Initial (Maybe' a, s, s) c -> m (Initial (Maybe' a, s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (Maybe' a, s, s) c -> m (Initial (Maybe' a, s, s) c))
-> Initial (Maybe' a, s, s) c -> m (Initial (Maybe' a, s, s) c)
forall a b. (a -> b) -> a -> b
$ c -> Initial (Maybe' a, s, s) c
forall s b. b -> Initial s b
IDone c
c

    -- state does not contain any parser
    -- yield a new parser from the stream
    step :: (Maybe' (Parser a m b), s, s)
-> a -> m (Step (Maybe' (Parser a m b), s, s) c)
step (Maybe' (Parser a m b)
Nothing', s
ss, s
fs) a
_ = do
        Step s (Parser a m b)
sres <- State StreamK m (Parser a m b) -> s -> m (Step s (Parser a m b))
sstep State StreamK m (Parser a m b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
ss
        case Step s (Parser a m b)
sres of
            D.Yield Parser a m b
p s
ss1 -> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' (Parser a m b), s, s) c
 -> m (Step (Maybe' (Parser a m b), s, s) c))
-> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a b. (a -> b) -> a -> b
$ Int
-> (Maybe' (Parser a m b), s, s)
-> Step (Maybe' (Parser a m b), s, s) c
forall s b. Int -> s -> Step s b
SContinue Int
0 (Parser a m b -> Maybe' (Parser a m b)
forall a. a -> Maybe' a
Just' Parser a m b
p, s
ss1, s
fs)
            Step s (Parser a m b)
D.Stop -> do
                c
c <- s -> m c
ffinal s
fs
                Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' (Parser a m b), s, s) c
 -> m (Step (Maybe' (Parser a m b), s, s) c))
-> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (Maybe' (Parser a m b), s, s) c
forall s b. Int -> b -> Step s b
SDone Int
0 c
c
            D.Skip s
ss1 -> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' (Parser a m b), s, s) c
 -> m (Step (Maybe' (Parser a m b), s, s) c))
-> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a b. (a -> b) -> a -> b
$ Int
-> (Maybe' (Parser a m b), s, s)
-> Step (Maybe' (Parser a m b), s, s) c
forall s b. Int -> s -> Step s b
SContinue Int
0 (Maybe' (Parser a m b)
forall a. Maybe' a
Nothing', s
ss1, s
fs)

    -- state holds a parser that may or may not have been
    -- initialized. pinit holds the initial parser state
    -- or modified parser state respectively
    step (Just' (Parser s -> a -> m (Step s b)
pstep m (Initial s b)
pinit s -> m (Final s b)
pextr), s
ss, s
fs) a
a = do
        Initial s b
ps <- m (Initial s b)
pinit
        case Initial s b
ps of
            IPartial s
ps1 -> do
                Step s b
pres <- s -> a -> m (Step s b)
pstep s
ps1 a
a
                case Step s b
pres of
                    SPartial Int
n s
ps2 ->
                        let newP :: Maybe' (Parser a m b)
newP =
                              Parser a m b -> Maybe' (Parser a m b)
forall a. a -> Maybe' a
Just' (Parser a m b -> Maybe' (Parser a m b))
-> Parser a m b -> Maybe' (Parser a m b)
forall a b. (a -> b) -> a -> b
$ (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)
pstep (Initial s b -> m (Initial s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial s b -> m (Initial s b)) -> Initial s b -> m (Initial s b)
forall a b. (a -> b) -> a -> b
$ s -> Initial s b
forall s b. s -> Initial s b
IPartial s
ps2) s -> m (Final s b)
pextr
                        in Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' (Parser a m b), s, s) c
 -> m (Step (Maybe' (Parser a m b), s, s) c))
-> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a b. (a -> b) -> a -> b
$ Int
-> (Maybe' (Parser a m b), s, s)
-> Step (Maybe' (Parser a m b), s, s) c
forall s b. Int -> s -> Step s b
SPartial Int
n (Maybe' (Parser a m b)
newP, s
ss, s
fs)
                    SContinue Int
n s
ps2 ->
                        let newP :: Maybe' (Parser a m b)
newP =
                              Parser a m b -> Maybe' (Parser a m b)
forall a. a -> Maybe' a
Just' (Parser a m b -> Maybe' (Parser a m b))
-> Parser a m b -> Maybe' (Parser a m b)
forall a b. (a -> b) -> a -> b
$ (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)
pstep (Initial s b -> m (Initial s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial s b -> m (Initial s b)) -> Initial s b -> m (Initial s b)
forall a b. (a -> b) -> a -> b
$ s -> Initial s b
forall s b. s -> Initial s b
IPartial s
ps2) s -> m (Final s b)
pextr
                        in Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' (Parser a m b), s, s) c
 -> m (Step (Maybe' (Parser a m b), s, s) c))
-> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a b. (a -> b) -> a -> b
$ Int
-> (Maybe' (Parser a m b), s, s)
-> Step (Maybe' (Parser a m b), s, s) c
forall s b. Int -> s -> Step s b
SContinue Int
n (Maybe' (Parser a m b)
newP, s
ss, s
fs)
                    SDone Int
n b
b -> do
                        Step s c
fres <- s -> b -> m (Step s c)
fstep s
fs b
b
                        case Step s c
fres of
                            FL.Partial s
fs1 ->
                                Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' (Parser a m b), s, s) c
 -> m (Step (Maybe' (Parser a m b), s, s) c))
-> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a b. (a -> b) -> a -> b
$ Int
-> (Maybe' (Parser a m b), s, s)
-> Step (Maybe' (Parser a m b), s, s) c
forall s b. Int -> s -> Step s b
SPartial Int
n (Maybe' (Parser a m b)
forall a. Maybe' a
Nothing', s
ss, s
fs1)
                            FL.Done c
c -> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' (Parser a m b), s, s) c
 -> m (Step (Maybe' (Parser a m b), s, s) c))
-> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (Maybe' (Parser a m b), s, s) c
forall s b. Int -> b -> Step s b
SDone Int
n c
c
                    SError String
msg -> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' (Parser a m b), s, s) c
 -> m (Step (Maybe' (Parser a m b), s, s) c))
-> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (Maybe' (Parser a m b), s, s) c
forall s b. String -> Step s b
SError String
msg
            IDone b
b -> do
                Step s c
fres <- s -> b -> m (Step s c)
fstep s
fs b
b
                case Step s c
fres of
                    FL.Partial s
fs1 ->
                        Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' (Parser a m b), s, s) c
 -> m (Step (Maybe' (Parser a m b), s, s) c))
-> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a b. (a -> b) -> a -> b
$ Int
-> (Maybe' (Parser a m b), s, s)
-> Step (Maybe' (Parser a m b), s, s) c
forall s b. Int -> s -> Step s b
SPartial Int
0 (Maybe' (Parser a m b)
forall a. Maybe' a
Nothing', s
ss, s
fs1)
                    FL.Done c
c -> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' (Parser a m b), s, s) c
 -> m (Step (Maybe' (Parser a m b), s, s) c))
-> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (Maybe' (Parser a m b), s, s) c
forall s b. Int -> b -> Step s b
SDone Int
0 c
c
            IError String
err -> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' (Parser a m b), s, s) c
 -> m (Step (Maybe' (Parser a m b), s, s) c))
-> Step (Maybe' (Parser a m b), s, s) c
-> m (Step (Maybe' (Parser a m b), s, s) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (Maybe' (Parser a m b), s, s) c
forall s b. String -> Step s b
SError String
err

    extract :: (Maybe' (Parser a m b), b, s)
-> m (Final (Maybe' (Parser a m b), b, s) c)
extract (Maybe' (Parser a m b)
Nothing', b
_, s
fs) = (c -> Final (Maybe' (Parser a m b), b, s) c)
-> m c -> m (Final (Maybe' (Parser a m b), 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 (Maybe' (Parser a m b), b, s) c
forall s b. Int -> b -> Final s b
FDone Int
0) (m c -> m (Final (Maybe' (Parser a m b), b, s) c))
-> m c -> m (Final (Maybe' (Parser a m b), b, s) c)
forall a b. (a -> b) -> a -> b
$ s -> m c
ffinal s
fs
    extract (Just' (Parser s -> a -> m (Step s b)
pstep m (Initial s b)
pinit s -> m (Final s b)
pextr), b
ss, s
fs) = do
        Initial s b
ps <- m (Initial s b)
pinit
        case Initial s b
ps of
            IPartial s
ps1 ->  do
                Final s b
r <- s -> m (Final s b)
pextr s
ps1
                case Final s b
r of
                    FDone Int
n b
b -> do
                        Step s c
res <- s -> b -> m (Step s c)
fstep s
fs b
b
                        case Step s c
res of
                            FL.Partial s
fs1 -> (c -> Final (Maybe' (Parser a m b), b, s) c)
-> m c -> m (Final (Maybe' (Parser a m b), 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 (Maybe' (Parser a m b), b, s) c
forall s b. Int -> b -> Final s b
FDone Int
n) (m c -> m (Final (Maybe' (Parser a m b), b, s) c))
-> m c -> m (Final (Maybe' (Parser a m b), b, s) c)
forall a b. (a -> b) -> a -> b
$ s -> m c
ffinal s
fs1
                            FL.Done c
c -> Final (Maybe' (Parser a m b), b, s) c
-> m (Final (Maybe' (Parser a m b), b, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Final (Maybe' (Parser a m b), b, s) c
forall s b. Int -> b -> Final s b
FDone Int
n c
c)
                    FError String
err -> Final (Maybe' (Parser a m b), b, s) c
-> m (Final (Maybe' (Parser a m b), b, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (Maybe' (Parser a m b), b, s) c
 -> m (Final (Maybe' (Parser a m b), b, s) c))
-> Final (Maybe' (Parser a m b), b, s) c
-> m (Final (Maybe' (Parser a m b), b, s) c)
forall a b. (a -> b) -> a -> b
$ String -> Final (Maybe' (Parser a m b), b, s) c
forall s b. String -> Final s b
FError String
err
                    FContinue Int
n s
s -> Final (Maybe' (Parser a m b), b, s) c
-> m (Final (Maybe' (Parser a m b), b, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (Maybe' (Parser a m b), b, s) c
 -> m (Final (Maybe' (Parser a m b), b, s) c))
-> Final (Maybe' (Parser a m b), b, s) c
-> m (Final (Maybe' (Parser a m b), b, s) c)
forall a b. (a -> b) -> a -> b
$ Int
-> (Maybe' (Parser a m b), b, s)
-> Final (Maybe' (Parser a m b), b, s) c
forall s b. Int -> s -> Final s b
FContinue Int
n (Parser a m b -> Maybe' (Parser a m b)
forall a. a -> Maybe' a
Just' ((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)
pstep (Initial s b -> m (Initial s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> Initial s b
forall s b. s -> Initial s b
IPartial s
s)) s -> m (Final s b)
pextr), b
ss, s
fs)
            IDone b
b -> do
                Step s c
fres <- s -> b -> m (Step s c)
fstep s
fs b
b
                case Step s c
fres of
                    FL.Partial s
fs1 -> (c -> Final (Maybe' (Parser a m b), b, s) c)
-> m c -> m (Final (Maybe' (Parser a m b), 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 (Maybe' (Parser a m b), b, s) c
forall s b. Int -> b -> Final s b
FDone Int
0) (m c -> m (Final (Maybe' (Parser a m b), b, s) c))
-> m c -> m (Final (Maybe' (Parser a m b), b, s) c)
forall a b. (a -> b) -> a -> b
$ s -> m c
ffinal s
fs1
                    FL.Done c
c -> Final (Maybe' (Parser a m b), b, s) c
-> m (Final (Maybe' (Parser a m b), b, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Final (Maybe' (Parser a m b), b, s) c
forall s b. Int -> b -> Final s b
FDone Int
0 c
c)
            IError String
err -> Final (Maybe' (Parser a m b), b, s) c
-> m (Final (Maybe' (Parser a m b), b, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (Maybe' (Parser a m b), b, s) c
 -> m (Final (Maybe' (Parser a m b), b, s) c))
-> Final (Maybe' (Parser a m b), b, s) c
-> m (Final (Maybe' (Parser a m b), b, s) c)
forall a b. (a -> b) -> a -> b
$ String -> Final (Maybe' (Parser a m b), b, s) c
forall s b. String -> Final s b
FError String
err

-------------------------------------------------------------------------------
-- Alternative Collection
-------------------------------------------------------------------------------

{-
-- | @choice parsers@ applies the @parsers@ in order and returns the first
-- successful parse.
--
-- This is same as 'asum' but more efficient.
--
-- /Broken/
--
{-# INLINE choice #-}
choice :: (MonadCatch m, Foldable t) => t (Parser a m b) -> Parser a m b
choice = foldl1 shortest
-}

-------------------------------------------------------------------------------
-- Sequential Repetition
-------------------------------------------------------------------------------

-- | Like 'many' but uses a 'Parser' instead of a 'Fold' to collect the
-- results. Parsing stops or fails if the collecting parser stops or fails.
--
-- /Unimplemented/
--
{-# INLINE manyP #-}
manyP :: -- MonadCatch m =>
    Parser a m b -> Parser b m c -> Parser a m c
manyP :: forall a (m :: * -> *) b c.
Parser a m b -> Parser b m c -> Parser a m c
manyP Parser a m b
_p Parser b m c
_f = Parser a m c
forall a. HasCallStack => a
undefined

-- | Collect zero or more parses. Apply the supplied parser repeatedly on the
-- input stream and push the parse results to a downstream fold.
--
--  Stops: when the downstream fold stops or the parser fails.
--  Fails: never, produces zero or more results.
--
-- >>> many = Parser.countBetween 0 maxBound
--
-- Compare with 'Control.Applicative.many'.
--
{-# INLINE many #-}
many :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
many :: forall (m :: * -> *) a b c.
Monad m =>
Parser a m b -> Fold m b c -> Parser a m c
many = Parser a m b -> Fold m b c -> Parser a m c
forall (m :: * -> *) a b c.
Monad m =>
Parser a m b -> Fold m b c -> Parser a m c
splitMany
-- many = countBetween 0 maxBound

-- Note: many1 would perhaps be a better name for this and consistent with
-- other names like takeWhile1. But we retain the name "some" for
-- compatibility.

-- | Collect one or more parses. Apply the supplied parser repeatedly on the
-- input stream and push the parse results to a downstream fold.
--
--  Stops: when the downstream fold stops or the parser fails.
--  Fails: if it stops without producing a single result.
--
-- >>> some p f = Parser.manyP p (Parser.takeGE 1 f)
-- >>> some = Parser.countBetween 1 maxBound
--
-- Compare with 'Control.Applicative.some'.
--
{-# INLINE some #-}
some :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
some :: forall (m :: * -> *) a b c.
Monad m =>
Parser a m b -> Fold m b c -> Parser a m c
some = Parser a m b -> Fold m b c -> Parser a m c
forall (m :: * -> *) a b c.
Monad m =>
Parser a m b -> Fold m b c -> Parser a m c
splitSome
-- some p f = manyP p (takeGE 1 f)
-- some = countBetween 1 maxBound

-- | @countBetween m n f p@ collects between @m@ and @n@ sequential parses of
-- parser @p@ using the fold @f@. Stop after collecting @n@ results. Fails if
-- the input ends or the parser fails before @m@ results are collected.
--
-- >>> countBetween m n p f = Parser.manyP p (Parser.takeBetween m n f)
--
-- /Unimplemented/
--
{-# INLINE countBetween #-}
countBetween :: -- MonadCatch m =>
    Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c
countBetween :: forall a (m :: * -> *) b c.
Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c
countBetween Int
_m Int
_n Parser a m b
_p = Fold m b c -> Parser a m c
forall a. HasCallStack => a
undefined
-- countBetween m n p f = manyP p (takeBetween m n f)

-- | @count n f p@ collects exactly @n@ sequential parses of parser @p@ using
-- the fold @f@.  Fails if the input ends or the parser fails before @n@
-- results are collected.
--
-- >>> count n = Parser.countBetween n n
-- >>> count n p f = Parser.manyP p (Parser.takeEQ n f)
--
-- /Unimplemented/
--
{-# INLINE count #-}
count :: -- MonadCatch m =>
    Int -> Parser a m b -> Fold m b c -> Parser a m c
count :: forall a (m :: * -> *) b c.
Int -> Parser a m b -> Fold m b c -> Parser a m c
count Int
n = Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c
forall a (m :: * -> *) b c.
Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c
countBetween Int
n Int
n
-- count n p f = manyP p (takeEQ n f)

-- | Like 'manyTill' but uses a 'Parser' to collect the results instead of a
-- 'Fold'.  Parsing stops or fails if the collecting parser stops or fails.
--
-- We can implemnent parsers like the following using 'manyTillP':
--
-- @
-- countBetweenTill m n f p = manyTillP (takeBetween m n f) p
-- @
--
-- /Unimplemented/
--
{-# INLINE manyTillP #-}
manyTillP :: -- Monad m =>
    Parser a m b -> Parser a m x -> Parser b m c -> Parser a m c
manyTillP :: forall a (m :: * -> *) b x c.
Parser a m b -> Parser a m x -> Parser b m c -> Parser a m c
manyTillP Parser a m b
_p1 Parser a m x
_p2 Parser b m c
_f = Parser a m c
forall a. HasCallStack => a
undefined
    -- D.toParserK $ D.manyTillP (D.fromParserK p1) (D.fromParserK p2) f

{-# ANN type ManyTillState Fuse #-}
data ManyTillState fs sr sl
    = ManyTillR !Int !fs !sr
    | ManyTillL !fs !sl

-- | @manyTill p test f@ tries the parser @test@ on the input, if @test@
-- fails it backtracks and tries @p@, after @p@ succeeds @test@ is
-- tried again and so on. The parser stops when @test@ succeeds.  The output of
-- @test@ is discarded and the output of @p@ is accumulated by the
-- supplied fold. The parser fails if @p@ fails.
--
-- Stops when the fold @f@ stops.
--
{-# INLINE manyTill #-}
manyTill :: Monad m
    => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
manyTill :: forall (m :: * -> *) a b x c.
Monad m =>
Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
manyTill (Parser s -> a -> m (Step s b)
stepL m (Initial s b)
initialL s -> m (Final s b)
extractL)
         (Parser s -> a -> m (Step s x)
stepR m (Initial s x)
initialR s -> m (Final s x)
_)
         (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
_ s -> m c
ffinal) =
    (ManyTillState s s s -> a -> m (Step (ManyTillState s s s) c))
-> m (Initial (ManyTillState s s s) c)
-> (ManyTillState s s s -> m (Final (ManyTillState s 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 ManyTillState s s s -> a -> m (Step (ManyTillState s s s) c)
step m (Initial (ManyTillState s s s) c)
initial ManyTillState s s s -> m (Final (ManyTillState s s s) c)
forall {sr} {sr}.
ManyTillState s sr s -> m (Final (ManyTillState s sr s) c)
extract

    where

    -- Caution: Mutual recursion

    scrutL :: s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutL s
fs ManyTillState s s sl -> b
p ManyTillState s sr s -> b
c c -> b
d String -> b
e = do
        Initial s b
resL <- m (Initial s b)
initialL
        case Initial s b
resL of
            IPartial s
sl -> 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
$ ManyTillState s sr s -> b
c (s -> s -> ManyTillState s sr s
forall fs sr sl. fs -> sl -> ManyTillState fs sr sl
ManyTillL s
fs s
sl)
            IDone b
bl -> do
                Step s c
fr <- s -> b -> m (Step s c)
fstep s
fs b
bl
                case Step s c
fr of
                    FL.Partial s
fs1 -> s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutR s
fs1 ManyTillState s s sl -> b
p ManyTillState s sr s -> b
c c -> b
d String -> b
e
                    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
d c
fb
            IError String
err -> 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
$ String -> b
e String
err

    scrutR :: s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutR s
fs ManyTillState s s sl -> b
p ManyTillState s sr s -> b
c c -> b
d String -> b
e = do
        Initial s x
resR <- m (Initial s x)
initialR
        case Initial s x
resR of
            IPartial s
sr -> 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
$ ManyTillState s s sl -> b
p (Int -> s -> s -> ManyTillState s s sl
forall fs sr sl. Int -> fs -> sr -> ManyTillState fs sr sl
ManyTillR Int
0 s
fs s
sr)
            IDone x
_ -> c -> b
d (c -> b) -> m c -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
ffinal s
fs
            IError String
_ -> s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutL s
fs ManyTillState s s sl -> b
p ManyTillState s sr s -> b
c c -> b
d String -> b
e

    initial :: m (Initial (ManyTillState s s s) c)
initial = do
        Step s c
res <- m (Step s c)
finitial
        case Step s c
res of
            FL.Partial s
fs -> s
-> (ManyTillState s s s -> Initial (ManyTillState s s s) c)
-> (ManyTillState s s s -> Initial (ManyTillState s s s) c)
-> (c -> Initial (ManyTillState s s s) c)
-> (String -> Initial (ManyTillState s s s) c)
-> m (Initial (ManyTillState s s s) c)
forall {sl} {b} {sr}.
s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutR s
fs ManyTillState s s s -> Initial (ManyTillState s s s) c
forall s b. s -> Initial s b
IPartial ManyTillState s s s -> Initial (ManyTillState s s s) c
forall s b. s -> Initial s b
IPartial c -> Initial (ManyTillState s s s) c
forall s b. b -> Initial s b
IDone String -> Initial (ManyTillState s s s) c
forall s b. String -> Initial s b
IError
            FL.Done c
b -> Initial (ManyTillState s s s) c
-> m (Initial (ManyTillState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (ManyTillState s s s) c
 -> m (Initial (ManyTillState s s s) c))
-> Initial (ManyTillState s s s) c
-> m (Initial (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ c -> Initial (ManyTillState s s s) c
forall s b. b -> Initial s b
IDone c
b

    step :: ManyTillState s s s -> a -> m (Step (ManyTillState s s s) c)
step (ManyTillR Int
cnt s
fs s
st) a
a = do
        Step s x
r <- s -> a -> m (Step s x)
stepR s
st a
a
        case Step s x
r of
            SPartial Int
n s
s -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
SPartial Int
n (Int -> s -> s -> ManyTillState s s s
forall fs sr sl. Int -> fs -> sr -> ManyTillState fs sr sl
ManyTillR Int
0 s
fs 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 (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
SContinue Int
n (Int -> s -> s -> ManyTillState s s s
forall fs sr sl. Int -> fs -> sr -> ManyTillState fs sr sl
ManyTillR (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
fs s
s)
            SDone Int
n x
_ -> do
                c
b <- s -> m c
ffinal s
fs
                Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (ManyTillState s s s) c
forall s b. Int -> b -> Step s b
SDone Int
n c
b
            SError String
_ -> do
                Initial s b
resL <- m (Initial s b)
initialL
                case Initial s b
resL of
                    IPartial s
sl ->
                        Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
SContinue (Int -> Int
forall a. Num a => a -> a
negate Int
cnt) (s -> s -> ManyTillState s s s
forall fs sr sl. fs -> sl -> ManyTillState fs sr sl
ManyTillL s
fs s
sl)
                    IDone b
bl -> do
                        Step s c
fr <- s -> b -> m (Step s c)
fstep s
fs b
bl
                        -- XXX review, need tests for manyTill
                        case Step s c
fr of
                            FL.Partial s
fs1 ->
                                s
-> (ManyTillState s s s -> Step (ManyTillState s s s) c)
-> (ManyTillState s s s -> Step (ManyTillState s s s) c)
-> (c -> Step (ManyTillState s s s) c)
-> (String -> Step (ManyTillState s s s) c)
-> m (Step (ManyTillState s s s) c)
forall {sl} {b} {sr}.
s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutR
                                    s
fs1
                                    (Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
SPartial (-Int
cnt))
                                    (Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
SContinue (-Int
cnt))
                                    (Int -> c -> Step (ManyTillState s s s) c
forall s b. Int -> b -> Step s b
SDone (-Int
cnt))
                                    String -> Step (ManyTillState s s s) c
forall s b. String -> Step s b
SError
                            FL.Done c
fb -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (ManyTillState s s s) c
forall s b. Int -> b -> Step s b
SDone (-Int
cnt) c
fb
                    IError String
err -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (ManyTillState s s s) c
forall s b. String -> Step s b
SError String
err
    step (ManyTillL s
fs 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 (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
SPartial Int
n (s -> s -> ManyTillState s s s
forall fs sr sl. fs -> sl -> ManyTillState fs sr sl
ManyTillL s
fs s
s)
            SContinue Int
n s
s -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
SContinue Int
n (s -> s -> ManyTillState s s s
forall fs sr sl. fs -> sl -> ManyTillState fs sr sl
ManyTillL s
fs s
s)
            SDone Int
n b
b -> do
                Step s c
fs1 <- s -> b -> m (Step s c)
fstep s
fs b
b
                case Step s c
fs1 of
                    FL.Partial s
s ->
                        s
-> (ManyTillState s s s -> Step (ManyTillState s s s) c)
-> (ManyTillState s s s -> Step (ManyTillState s s s) c)
-> (c -> Step (ManyTillState s s s) c)
-> (String -> Step (ManyTillState s s s) c)
-> m (Step (ManyTillState s s s) c)
forall {sl} {b} {sr}.
s
-> (ManyTillState s s sl -> b)
-> (ManyTillState s sr s -> b)
-> (c -> b)
-> (String -> b)
-> m b
scrutR s
s (Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
SPartial Int
n) (Int -> ManyTillState s s s -> Step (ManyTillState s s s) c
forall s b. Int -> s -> Step s b
SContinue Int
n) (Int -> c -> Step (ManyTillState s s s) c
forall s b. Int -> b -> Step s b
SDone Int
n) String -> Step (ManyTillState s s s) c
forall s b. String -> Step s b
SError
                    FL.Done c
b1 -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ Int -> c -> Step (ManyTillState s s s) c
forall s b. Int -> b -> Step s b
SDone Int
n c
b1
            SError String
err -> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c))
-> Step (ManyTillState s s s) c -> m (Step (ManyTillState s s s) c)
forall a b. (a -> b) -> a -> b
$ String -> Step (ManyTillState s s s) c
forall s b. String -> Step s b
SError String
err

    extract :: ManyTillState s sr s -> m (Final (ManyTillState s sr s) c)
extract (ManyTillL s
fs s
sR) = do
        Final s b
res <- s -> m (Final s b)
extractL s
sR
        case Final s b
res of
            FDone Int
n b
b -> do
                Step s c
r <- s -> b -> m (Step s c)
fstep s
fs b
b
                case Step s c
r of
                    FL.Partial s
fs1 -> (c -> Final (ManyTillState s sr s) c)
-> m c -> m (Final (ManyTillState s sr 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 (ManyTillState s sr s) c
forall s b. Int -> b -> Final s b
FDone Int
n) (m c -> m (Final (ManyTillState s sr s) c))
-> m c -> m (Final (ManyTillState s sr s) c)
forall a b. (a -> b) -> a -> b
$ s -> m c
ffinal s
fs1
                    FL.Done c
c -> Final (ManyTillState s sr s) c
-> m (Final (ManyTillState s sr s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> c -> Final (ManyTillState s sr s) c
forall s b. Int -> b -> Final s b
FDone Int
n c
c)
            FError String
err -> Final (ManyTillState s sr s) c
-> m (Final (ManyTillState s sr s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (ManyTillState s sr s) c
 -> m (Final (ManyTillState s sr s) c))
-> Final (ManyTillState s sr s) c
-> m (Final (ManyTillState s sr s) c)
forall a b. (a -> b) -> a -> b
$ String -> Final (ManyTillState s sr s) c
forall s b. String -> Final s b
FError String
err
            FContinue Int
n s
s -> Final (ManyTillState s sr s) c
-> m (Final (ManyTillState s sr s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (ManyTillState s sr s) c
 -> m (Final (ManyTillState s sr s) c))
-> Final (ManyTillState s sr s) c
-> m (Final (ManyTillState s sr s) c)
forall a b. (a -> b) -> a -> b
$ Int -> ManyTillState s sr s -> Final (ManyTillState s sr s) c
forall s b. Int -> s -> Final s b
FContinue Int
n (s -> s -> ManyTillState s sr s
forall fs sr sl. fs -> sl -> ManyTillState fs sr sl
ManyTillL s
fs s
s)
    extract (ManyTillR Int
_ s
fs sr
_) = (c -> Final (ManyTillState s sr s) c)
-> m c -> m (Final (ManyTillState s sr 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 (ManyTillState s sr s) c
forall s b. Int -> b -> Final s b
FDone Int
0) (m c -> m (Final (ManyTillState s sr s) c))
-> m c -> m (Final (ManyTillState s sr s) c)
forall a b. (a -> b) -> a -> b
$ s -> m c
ffinal s
fs

-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and
-- collects the output in the supplied fold. If the the parser @collect@ fails,
-- parser @recover@ is run until it stops and then we start repeating the
-- parser @collect@ again. The parser fails if the recovery parser fails.
--
-- For example, this can be used to find a key frame in a video stream after an
-- error.
--
-- /Unimplemented/
--
{-# INLINE manyThen #-}
manyThen :: -- (Foldable t, Monad m) =>
    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
manyThen :: forall a (m :: * -> *) b x c.
Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
manyThen Parser a m b
_parser Parser a m x
_recover Fold m b c
_f = Parser a m c
forall a. HasCallStack => a
undefined

-------------------------------------------------------------------------------
-- Repeated Alternatives
-------------------------------------------------------------------------------

-- | Keep trying a parser up to a maximum of @n@ failures.  When the parser
-- fails the input consumed till now is dropped and the new instance is tried
-- on the fresh input.
--
-- /Unimplemented/
--
{-# INLINE retryMaxTotal #-}
retryMaxTotal :: -- (Monad m) =>
    Int -> Parser a m b -> Fold m b c -> Parser a m c
retryMaxTotal :: forall a (m :: * -> *) b c.
Int -> Parser a m b -> Fold m b c -> Parser a m c
retryMaxTotal Int
_n Parser a m b
_p Fold m b c
_f  = Parser a m c
forall a. HasCallStack => a
undefined

-- | Like 'retryMaxTotal' but aborts after @n@ successive failures.
--
-- /Unimplemented/
--
{-# INLINE retryMaxSuccessive #-}
retryMaxSuccessive :: -- (Monad m) =>
    Int -> Parser a m b -> Fold m b c -> Parser a m c
retryMaxSuccessive :: forall a (m :: * -> *) b c.
Int -> Parser a m b -> Fold m b c -> Parser a m c
retryMaxSuccessive Int
_n Parser a m b
_p Fold m b c
_f = Parser a m c
forall a. HasCallStack => a
undefined

-- | Keep trying a parser until it succeeds.  When the parser fails the input
-- consumed till now is dropped and the new instance is tried on the fresh
-- input.
--
-- /Unimplemented/
--
{-# INLINE retry #-}
retry :: -- (Monad m) =>
    Parser a m b -> Parser a m b
retry :: forall a (m :: * -> *) b. Parser a m b -> Parser a m b
retry Parser a m b
_p = Parser a m b
forall a. HasCallStack => a
undefined