{-# LANGUAGE CPP #-}
-- |
-- Module      : Streamly.Internal.Data.Parser.ParserK.Type
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- CPS style implementation of parsers.
--
-- The CPS representation allows linear performance for Applicative, sequence,
-- Monad, Alternative, and choice operations compared to the quadratic
-- complexity of the corresponding direct style operations. However, direct
-- style operations allow fusion with ~10x better performance than CPS.
--
-- The direct style representation does not allow for recursive definitions of
-- "some" and "many" whereas CPS allows that.
--
module Streamly.Internal.Data.ParserK.Type
    (
    -- * Setup
    -- | To execute the code examples provided in this module in ghci, please
    -- run the following commands first.
    --
    -- $setup

    -- * Types
      Step (..)
    , Input (..)
    , ParseResult (..)
    , ParserK (..)

    -- * Adapting from Parser
    , parserDone
    , toParserK -- XXX move to StreamK module
    , toParser -- XXX unParserK, unK, unPK

    -- * Basic Parsers
    , fromPure
    , fromEffect
    , die

    -- * Expression Parsers
    , chainl
    , chainl1
    , chainr
    , chainr1

    -- * Deprecated
    , adapt
    )
where

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

#if !MIN_VERSION_base(4,18,0)
import Control.Applicative (liftA2)
#endif
import Control.Applicative (Alternative(..))
import Control.Monad (MonadPlus(..), ap)
import Control.Monad.IO.Class (MonadIO, liftIO)
-- import Control.Monad.Trans.Class (MonadTrans(lift))
import GHC.Types (SPEC(..))

import qualified Control.Monad.Fail as Fail
import qualified Streamly.Internal.Data.Parser.Type as ParserD

#include "DocTestDataParserK.hs"

-------------------------------------------------------------------------------
-- Developer Notes
-------------------------------------------------------------------------------

-- MonadReader cannot be implemented using continuations for ParserK
--
-- "local" (and hence "MonadReader") cannot be implemented for ParserK because
-- there is no way to override all continuations.
--
-- We can implement `MonadReader` for ParserK via ParserD:
--
-- @
-- instance (Show r, MonadReader r m) => MonadReader r (Parser a m) where
--     {-# INLINE ask #-}
--     ask = Parser.fromEffect ask
--     {-# INLINE local #-}
--     local f (Parser step initial extract) =
--         Parser
--             ((local f .) . step)
--             (local f initial)
--             (local f . extract)
--
-- instance (Show r, MonadReader r m) => MonadReader r (ParserK a m) where
--     {-# INLINE ask #-}
--     ask = ParserK.fromEffect ask
--     {-# INLINE local #-}
--     local f parser = ParserK.adapt $ local f $ ParserK.toParser parser
-- @

-------------------------------------------------------------------------------
-- Types
-------------------------------------------------------------------------------

-- Note: We cannot use an Array directly as input because we need to identify
-- the end of input case using None. We cannot do that using nil Array as nil
-- Arrays can be encountered in normal input as well.
--
-- We could specialize the ParserK type to use an Array directly, that provides
-- some performance improvement. The best advantage of that is when we consume
-- one element at a time from the array. If we really want that perf
-- improvement we can use a special ParserK type with the following Input.
--
-- data Input a = None | Chunk {-# UNPACK #-} !(Array a)
--
-- XXX Rename Chunk to Some.
data Input a = None | Chunk a

-- Note: Step should ideally be called StepResult and StepParser should be just
-- Step, but then it will not be consistent with Parser/Stream.

-- Using "Input" in runParser is not necessary but it avoids making
-- one more function call to get the input. This could be helpful
-- for cases where we process just one element per call.

-- | A parsing function that parses a single input object.
type StepParser a m r = Input a -> m (Step a m r)

-- | The intermediate result of running a parser step. The parser driver may
-- (1) stop with a final result ('Done') with no more inputs to be accepted,
-- (2) generate an intermediate result ('Partial') and accept more inputs, (3)
-- generate no result but wait for more input ('Continue'), (4) or fail with an
-- error ('Error').
--
-- The Int is a count by which the current stream position should be adjusted
-- before calling the next parsing step.
--
-- See the documentation of 'Streamly.Data.Parser.Step' for more details, this
-- has the same semantics.
--
-- /Pre-release/
--
data Step a m r =
      Done !Int r
    | Partial !Int (StepParser a m r)
    | Continue !Int (StepParser a m r)
    -- The Error constructor in ParserK Step carries a count, but the 'Parser'
    -- Step does not carry a count - this is because in ParserK we can have
    -- chunked drivers which can consume multiple inputs before returning a
    -- result or error. In such cases, if an error occurs the parser has to
    -- tell us the offset where the error occurred. In case of 'Parser' type we
    -- do not have chunked drivers, we always drive it one element at a time,
    -- therefore, the offset is not required on Error, the driver already knows
    -- where we are. However, if we ever build a chunked driver for 'Parser' we
    -- will need this argument in Parser Step as well.
    | Error !Int String

instance Functor m => Functor (Step a m) where
    fmap :: forall a b. (a -> b) -> Step a m a -> Step a m b
fmap a -> b
f (Done Int
n a
r) = Int -> b -> Step a m b
forall a (m :: * -> *) r. Int -> r -> Step a m r
Done Int
n (a -> b
f a
r)
    fmap a -> b
f (Partial Int
n StepParser a m a
k) = Int -> StepParser a m b -> Step a m b
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Partial Int
n ((Step a m a -> Step a m b) -> m (Step a m a) -> m (Step a m b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Step a m a -> Step a m b
forall a b. (a -> b) -> Step a m a -> Step a m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (m (Step a m a) -> m (Step a m b))
-> StepParser a m a -> StepParser a m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StepParser a m a
k)
    fmap a -> b
f (Continue Int
n StepParser a m a
k) = Int -> StepParser a m b -> Step a m b
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue Int
n ((Step a m a -> Step a m b) -> m (Step a m a) -> m (Step a m b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Step a m a -> Step a m b
forall a b. (a -> b) -> Step a m a -> Step a m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (m (Step a m a) -> m (Step a m b))
-> StepParser a m a -> StepParser a m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StepParser a m a
k)
    fmap a -> b
_ (Error Int
n String
e) = Int -> String -> Step a m b
forall a (m :: * -> *) r. Int -> String -> Step a m r
Error Int
n String
e

-- Note: Passing position index separately instead of passing it with the
-- result causes huge regression in expression parsing becnhmarks.

-- | The parser's result.
--
-- Int is the position index in the stream relative to the position on entry
-- i.e. when the parser started running. When the parser enters the position
-- index is zero. If the parser consumed n elements then the new position index
-- would be n. If the parser is backtracking then the position index would be
-- negative.
--
-- /Pre-release/
--
data ParseResult b =
      Success !Int !b      -- Position index, result
    | Failure !Int !String -- Position index, error

-- | Map a function over 'Success'.
instance Functor ParseResult where
    fmap :: forall a b. (a -> b) -> ParseResult a -> ParseResult b
fmap a -> b
f (Success Int
n a
b) = Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success Int
n (a -> b
f a
b)
    fmap a -> b
_ (Failure Int
n String
e) = Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
n String
e

-- XXX Change the type to the shape (a -> m r -> m r) -> (m r -> m r) -> m r
--
-- The parse continuation would be: Array a -> m (Step a m r) -> m (Step a m r)
-- The extract continuation would be: m (Step a m r) -> m (Step a m r)
--
-- Use Step itself in place of ParseResult.

-- | A continuation passing style parser representation.

-- A parser is a continuation of 'Step's, each step passes a state and a parse
-- result to the next 'Step'. The resulting 'Step' may carry a continuation
-- that consumes input 'a' and results in another 'Step'. Essentially, the
-- continuation may either consume input without a result or return a result
-- with no further input to be consumed.
--
-- The first argument of runParser is a continuation to be invoked after the
-- parser is done, it is of the following shape:
--
-- >>> type Cont = ParseResult b -> Int -> StepParser a m r
--
-- First argument of the continuation is the 'ParseResult'. The current stream
-- position is carried as part of the 'Success' or 'Failure' constructors of
-- 'ParseResult'. The second argument of the continuation is a count of the
-- elements used in the current alterantive in an alternative composition, if
-- the alternative fails we need to backtrack by this amount before invoking
-- the next alternative.
--
-- The second argument of runParser is the incoming stream position adjustment.
-- The parser driver needs to adjust the current position of the stream by this
-- amount before consuming further input. A positive value means move forward
-- by that much in the stream and a negative value means backward. See the
-- 'Step' and 'Streamly.Data.Parser.Step' documentation for more details.
--
-- The third argument is the incoming cumulative used element count for the
-- current alternative, same as described for the continuation above.
--
newtype ParserK a m b = MkParser
    { forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
runParser :: forall r.
           -- Do not eta reduce the applications of this continuation.
           -- Continuation to be invoked after the parser is done
           (ParseResult b -> Int -> StepParser a m r)
           -- stream position adjustment before the parser starts.
        -> Int
           -- initial used count for the current alternative.
        -> Int
            -- final parse result, when the last continuation is done.
        -> StepParser a m r
    }

-------------------------------------------------------------------------------
-- Functor
-------------------------------------------------------------------------------

-- XXX rewrite this using ParserD, expose rmapM from ParserD.

-- | Map a function on the result i.e. on @b@ in @Parser a m b@.
instance Functor m => Functor (ParserK a m) where
    {-# INLINE fmap #-}
    fmap :: forall a b. (a -> b) -> ParserK a m a -> ParserK a m b
fmap a -> b
f ParserK a m a
parser = (forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
forall a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
MkParser ((forall r.
  (ParseResult b -> Int -> StepParser a m r)
  -> Int -> Int -> StepParser a m r)
 -> ParserK a m b)
-> (forall r.
    (ParseResult b -> Int -> StepParser a m r)
    -> Int -> Int -> StepParser a m r)
-> ParserK a m b
forall a b. (a -> b) -> a -> b
$ \ParseResult b -> Int -> StepParser a m r
k Int
pos Int
used Input a
inp ->
        let k1 :: ParseResult a -> Int -> StepParser a m r
k1 ParseResult a
res = ParseResult b -> Int -> StepParser a m r
k ((a -> b) -> ParseResult a -> ParseResult b
forall a b. (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ParseResult a
res)
         in ParserK a m a
-> forall r.
   (ParseResult a -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
runParser ParserK a m a
parser ParseResult a -> Int -> StepParser a m r
k1 Int
pos Int
used Input a
inp

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

-- This is the dual of stream "fromPure".

-- | A parser that always yields a pure value without consuming any input.
--
-- /Pre-release/
--
{-# INLINE fromPure #-}
fromPure :: b -> ParserK a m b
fromPure :: forall b a (m :: * -> *). b -> ParserK a m b
fromPure b
b = (forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
forall a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
MkParser ((forall r.
  (ParseResult b -> Int -> StepParser a m r)
  -> Int -> Int -> StepParser a m r)
 -> ParserK a m b)
-> (forall r.
    (ParseResult b -> Int -> StepParser a m r)
    -> Int -> Int -> StepParser a m r)
-> ParserK a m b
forall a b. (a -> b) -> a -> b
$ \ParseResult b -> Int -> StepParser a m r
k Int
pos Int
used Input a
inp -> ParseResult b -> Int -> StepParser a m r
k (Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success Int
pos b
b) Int
used Input a
inp

-- | See 'Streamly.Internal.Data.Parser.fromEffect'.
--
-- /Pre-release/
--
{-# INLINE fromEffect #-}
fromEffect :: Monad m => m b -> ParserK a m b
fromEffect :: forall (m :: * -> *) b a. Monad m => m b -> ParserK a m b
fromEffect m b
eff =
    (forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
forall a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
MkParser ((forall r.
  (ParseResult b -> Int -> StepParser a m r)
  -> Int -> Int -> StepParser a m r)
 -> ParserK a m b)
-> (forall r.
    (ParseResult b -> Int -> StepParser a m r)
    -> Int -> Int -> StepParser a m r)
-> ParserK a m b
forall a b. (a -> b) -> a -> b
$ \ParseResult b -> Int -> StepParser a m r
k Int
pos Int
used Input a
inp -> m b
eff m b -> (b -> m (Step a m r)) -> m (Step a m r)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
b -> ParseResult b -> Int -> StepParser a m r
k (Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success Int
pos b
b) Int
used Input a
inp

-- | @f \<$> p1 \<*> p2@ applies parsers p1 and p2 sequentially to an input
-- stream. The first parser runs and processes the input, the remaining input
-- is then passed to the second parser. If both parsers succeed, their outputs
-- are applied to the function @f@. If either parser fails, the operation
-- fails.
--
instance Monad m => Applicative (ParserK a m) where
    {-# INLINE pure #-}
    pure :: forall a. a -> ParserK a m a
pure = a -> ParserK a m a
forall b a (m :: * -> *). b -> ParserK a m b
fromPure

    {-# INLINE (<*>) #-}
    <*> :: forall a b. ParserK a m (a -> b) -> ParserK a m a -> ParserK a m b
(<*>) = ParserK a m (a -> b) -> ParserK a m a -> ParserK a m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

    {-# INLINE (*>) #-}
    ParserK a m a
p1 *> :: forall a b. ParserK a m a -> ParserK a m b -> ParserK a m b
*> ParserK a m b
p2 = (forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
forall a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
MkParser ((forall r.
  (ParseResult b -> Int -> StepParser a m r)
  -> Int -> Int -> StepParser a m r)
 -> ParserK a m b)
-> (forall r.
    (ParseResult b -> Int -> StepParser a m r)
    -> Int -> Int -> StepParser a m r)
-> ParserK a m b
forall a b. (a -> b) -> a -> b
$ \ParseResult b -> Int -> StepParser a m r
k Int
pos Int
used Input a
input ->
        let k1 :: ParseResult b -> Int -> StepParser a m r
k1 (Success Int
pos1 b
_) Int
u Input a
inp = ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
runParser ParserK a m b
p2 ParseResult b -> Int -> StepParser a m r
k Int
pos1 Int
u Input a
inp
            k1 (Failure Int
pos1 String
e) Int
u Input a
inp = ParseResult b -> Int -> StepParser a m r
k (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
pos1 String
e) Int
u Input a
inp
        in ParserK a m a
-> forall r.
   (ParseResult a -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
runParser ParserK a m a
p1 ParseResult a -> Int -> StepParser a m r
forall {b}. ParseResult b -> Int -> StepParser a m r
k1 Int
pos Int
used Input a
input

    {-# INLINE (<*) #-}
    ParserK a m a
p1 <* :: forall a b. ParserK a m a -> ParserK a m b -> ParserK a m a
<* ParserK a m b
p2 = (forall r.
 (ParseResult a -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m a
forall a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
MkParser ((forall r.
  (ParseResult a -> Int -> StepParser a m r)
  -> Int -> Int -> StepParser a m r)
 -> ParserK a m a)
-> (forall r.
    (ParseResult a -> Int -> StepParser a m r)
    -> Int -> Int -> StepParser a m r)
-> ParserK a m a
forall a b. (a -> b) -> a -> b
$ \ParseResult a -> Int -> StepParser a m r
k Int
pos Int
used Input a
input ->
        let k1 :: ParseResult a -> Int -> StepParser a m r
k1 (Success Int
pos1 a
b) Int
u1 Input a
inp =
                let k2 :: ParseResult b -> Int -> StepParser a m r
k2 (Success Int
pos2 b
_) Int
u2 Input a
inp2 = ParseResult a -> Int -> StepParser a m r
k (Int -> a -> ParseResult a
forall b. Int -> b -> ParseResult b
Success Int
pos2 a
b) Int
u2 Input a
inp2
                    k2 (Failure Int
pos2 String
e) Int
u2 Input a
inp2 = ParseResult a -> Int -> StepParser a m r
k (Int -> String -> ParseResult a
forall b. Int -> String -> ParseResult b
Failure Int
pos2 String
e) Int
u2 Input a
inp2
                in ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
runParser ParserK a m b
p2 ParseResult b -> Int -> StepParser a m r
forall {b}. ParseResult b -> Int -> StepParser a m r
k2 Int
pos1 Int
u1 Input a
inp
            k1 (Failure Int
pos1 String
e) Int
u1 Input a
inp = ParseResult a -> Int -> StepParser a m r
k (Int -> String -> ParseResult a
forall b. Int -> String -> ParseResult b
Failure Int
pos1 String
e) Int
u1 Input a
inp
        in ParserK a m a
-> forall r.
   (ParseResult a -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
runParser ParserK a m a
p1 ParseResult a -> Int -> StepParser a m r
k1 Int
pos Int
used Input a
input

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

-------------------------------------------------------------------------------
-- Monad
-------------------------------------------------------------------------------

-- This is the dual of "nil".
--
-- | A parser that always fails with an error message without consuming
-- any input.
--
-- /Pre-release/
--
{-# INLINE die #-}
die :: String -> ParserK a m b
die :: forall a (m :: * -> *) b. String -> ParserK a m b
die String
err = (forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
forall a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
MkParser (\ParseResult b -> Int -> StepParser a m r
k Int
pos Int
used Input a
inp -> ParseResult b -> Int -> StepParser a m r
k (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
pos String
err) Int
used Input a
inp)

-- | Monad composition can be used for lookbehind parsers, we can dynamically
-- compose new parsers based on the results of the previously parsed values.
instance Monad m => Monad (ParserK a m) where
    {-# INLINE return #-}
    return :: forall a. a -> ParserK a m a
return = a -> ParserK a m a
forall a. a -> ParserK a m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    {-# INLINE (>>=) #-}
    ParserK a m a
p >>= :: forall a b. ParserK a m a -> (a -> ParserK a m b) -> ParserK a m b
>>= a -> ParserK a m b
f = (forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
forall a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
MkParser ((forall r.
  (ParseResult b -> Int -> StepParser a m r)
  -> Int -> Int -> StepParser a m r)
 -> ParserK a m b)
-> (forall r.
    (ParseResult b -> Int -> StepParser a m r)
    -> Int -> Int -> StepParser a m r)
-> ParserK a m b
forall a b. (a -> b) -> a -> b
$ \ParseResult b -> Int -> StepParser a m r
k Int
pos Int
used Input a
input ->
        let k1 :: ParseResult a -> Int -> StepParser a m r
k1 (Success Int
pos1 a
b) Int
u1 Input a
inp = ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
runParser (a -> ParserK a m b
f a
b) ParseResult b -> Int -> StepParser a m r
k Int
pos1 Int
u1 Input a
inp
            k1 (Failure Int
pos1 String
e) Int
u1 Input a
inp = ParseResult b -> Int -> StepParser a m r
k (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
pos1 String
e) Int
u1 Input a
inp
         in ParserK a m a
-> forall r.
   (ParseResult a -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
runParser ParserK a m a
p ParseResult a -> Int -> StepParser a m r
k1 Int
pos Int
used Input a
input

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

#if !(MIN_VERSION_base(4,13,0))
    -- This is redefined instead of just being Fail.fail to be
    -- compatible with base 4.8.
    {-# INLINE fail #-}
    fail = die
#endif
instance Monad m => Fail.MonadFail (ParserK a m) where
    {-# INLINE fail #-}
    fail :: forall a. String -> ParserK a m a
fail = String -> ParserK a m a
forall a (m :: * -> *) b. String -> ParserK a m b
die

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

-------------------------------------------------------------------------------
-- Alternative
-------------------------------------------------------------------------------

-- | @p1 \<|> p2@ passes the input to parser p1, if it succeeds, the result is
-- returned. However, if p1 fails, the parser driver backtracks and tries the
-- same input on the alternative parser p2, returning the result if it
-- succeeds.
--
instance Monad m => Alternative (ParserK a m) where
    {-# INLINE empty #-}
    empty :: forall a. ParserK a m a
empty = String -> ParserK a m a
forall a (m :: * -> *) b. String -> ParserK a m b
die String
"empty"

    {-# INLINE (<|>) #-}
    ParserK a m a
p1 <|> :: forall a. ParserK a m a -> ParserK a m a -> ParserK a m a
<|> ParserK a m a
p2 = (forall r.
 (ParseResult a -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m a
forall a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
MkParser ((forall r.
  (ParseResult a -> Int -> StepParser a m r)
  -> Int -> Int -> StepParser a m r)
 -> ParserK a m a)
-> (forall r.
    (ParseResult a -> Int -> StepParser a m r)
    -> Int -> Int -> StepParser a m r)
-> ParserK a m a
forall a b. (a -> b) -> a -> b
$ \ParseResult a -> Int -> StepParser a m r
k Int
pos Int
_ Input a
input ->
        let
            k1 :: ParseResult a -> Int -> StepParser a m r
k1 (Failure Int
pos1 String
_) Int
used Input a
inp = ParserK a m a
-> forall r.
   (ParseResult a -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
runParser ParserK a m a
p2 ParseResult a -> Int -> StepParser a m r
k (Int
pos1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
used) Int
0 Input a
inp
            k1 ParseResult a
success Int
_ Input a
inp = ParseResult a -> Int -> StepParser a m r
k ParseResult a
success Int
0 Input a
inp
        in ParserK a m a
-> forall r.
   (ParseResult a -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
runParser ParserK a m a
p1 ParseResult a -> Int -> StepParser a m r
k1 Int
pos Int
0 Input a
input

    -- some and many are implemented here instead of using default definitions
    -- so that we can use INLINE on them. It gives 50% performance improvement.

    {-# INLINE many #-}
    many :: forall a. ParserK a m a -> ParserK a m [a]
many ParserK a m a
v = ParserK a m [a]
many_v

        where

        many_v :: ParserK a m [a]
many_v = ParserK a m [a]
some_v ParserK a m [a] -> ParserK a m [a] -> ParserK a m [a]
forall a. ParserK a m a -> ParserK a m a -> ParserK a m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> ParserK a m [a]
forall a. a -> ParserK a m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        some_v :: ParserK a m [a]
some_v = (:) (a -> [a] -> [a]) -> ParserK a m a -> ParserK a m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserK a m a
v ParserK a m ([a] -> [a]) -> ParserK a m [a] -> ParserK a m [a]
forall a b. ParserK a m (a -> b) -> ParserK a m a -> ParserK a m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserK a m [a]
many_v

    {-# INLINE some #-}
    some :: forall a. ParserK a m a -> ParserK a m [a]
some ParserK a m a
v = ParserK a m [a]
some_v

        where

        many_v :: ParserK a m [a]
many_v = ParserK a m [a]
some_v ParserK a m [a] -> ParserK a m [a] -> ParserK a m [a]
forall a. ParserK a m a -> ParserK a m a -> ParserK a m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> ParserK a m [a]
forall a. a -> ParserK a m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        some_v :: ParserK a m [a]
some_v = (:) (a -> [a] -> [a]) -> ParserK a m a -> ParserK a m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserK a m a
v ParserK a m ([a] -> [a]) -> ParserK a m [a] -> ParserK a m [a]
forall a b. ParserK a m (a -> b) -> ParserK a m a -> ParserK a m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserK a m [a]
many_v

-- | 'mzero' is same as 'empty', it aborts the parser. 'mplus' is same as
-- '<|>', it selects the first succeeding parser.
--
instance Monad m => MonadPlus (ParserK a m) where
    {-# INLINE mzero #-}
    mzero :: forall a. ParserK a m a
mzero = String -> ParserK a m a
forall a (m :: * -> *) b. String -> ParserK a m b
die String
"mzero"

    {-# INLINE mplus #-}
    mplus :: forall a. ParserK a m a -> ParserK a m a -> ParserK a m a
mplus = ParserK a m a -> ParserK a m a -> ParserK a m a
forall a. ParserK a m a -> ParserK a m a -> ParserK a m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

{-
instance MonadTrans (ParserK a) where
    {-# INLINE lift #-}
    lift = fromEffect
-}

--------------------------------------------------------------------------------
-- Make a ParserK from Parser
--------------------------------------------------------------------------------

{-# INLINE adaptWith #-}
adaptWith
    :: forall m a s b r. (Monad m)
    => (s -> a -> m (ParserD.Step s b))
    -> m (ParserD.Initial s b)
    -> (s -> m (ParserD.Final s b))
    -> (ParseResult b -> Int -> Input a -> m (Step a m r))
    -> Int
    -> Int
    -> Input a
    -> m (Step a m r)
adaptWith :: forall (m :: * -> *) a s b r.
Monad m =>
(s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m (Final s b))
-> (ParseResult b -> Int -> Input a -> m (Step a m r))
-> Int
-> Int
-> Input a
-> m (Step a m r)
adaptWith s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m (Final s b)
extract ParseResult b -> Int -> Input a -> m (Step a m r)
cont !Int
relPos !Int
usedCount !Input a
input = do
    Initial s b
res <- m (Initial s b)
initial
    case Initial s b
res of
        ParserD.IPartial s
pst -> do
            if Int
relPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then
                case Input a
input of
                    -- In element parser case chunk is just one element
                    Chunk a
element -> Int -> s -> a -> m (Step a m r)
parseContChunk Int
usedCount s
pst a
element
                    Input a
None -> Int -> s -> m (Step a m r)
parseContNothing Int
usedCount s
pst
            -- XXX Previous code was using Continue in this case
            else
                -- We consumed previous input, need to fetch the next
                -- input from the driver.
                Step a m r -> m (Step a m r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step a m r -> m (Step a m r)) -> Step a m r -> m (Step a m r)
forall a b. (a -> b) -> a -> b
$ Int -> (Input a -> m (Step a m r)) -> Step a m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Partial Int
relPos (Int -> s -> Input a -> m (Step a m r)
parseCont Int
usedCount s
pst)
        ParserD.IDone b
b -> ParseResult b -> Int -> Input a -> m (Step a m r)
cont (Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success Int
relPos b
b) Int
usedCount Input a
input
        ParserD.IError String
err -> ParseResult b -> Int -> Input a -> m (Step a m r)
cont (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
relPos String
err) Int
usedCount Input a
input

    where

    {-# NOINLINE parseContChunk #-}
    parseContChunk :: Int -> s -> a -> m (Step a m r)
parseContChunk !Int
count !s
state a
x = do
         SPEC -> s -> m (Step a m r)
go SPEC
SPEC s
state

        where

        go :: SPEC -> s -> m (Step a m r)
go !SPEC
_ !s
pst = do
            Step s b
r <- s -> a -> m (Step s b)
pstep s
pst a
x
            case Step s b
r of
                -- Done, call the next continuation
                ParserD.SDone Int
1 b
b ->
                    ParseResult b -> Int -> Input a -> m (Step a m r)
cont (Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success Int
1 b
b) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a -> Input a
forall a. a -> Input a
Chunk a
x)
                ParserD.SDone Int
0 b
b ->
                    ParseResult b -> Int -> Input a -> m (Step a m r)
cont (Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success Int
0 b
b) Int
count (a -> Input a
forall a. a -> Input a
Chunk a
x)
                ParserD.SDone Int
m b
b -> -- n > 1
                    let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
                     in ParseResult b -> Int -> Input a -> m (Step a m r)
cont (Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) b
b) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (a -> Input a
forall a. a -> Input a
Chunk a
x)

                -- Not done yet, return the parseCont continuation
                ParserD.SPartial Int
1 s
pst1 ->
                    Step a m r -> m (Step a m r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step a m r -> m (Step a m r)) -> Step a m r -> m (Step a m r)
forall a b. (a -> b) -> a -> b
$ Int -> (Input a -> m (Step a m r)) -> Step a m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Partial Int
1 (Int -> s -> Input a -> m (Step a m r)
parseCont (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) s
pst1)
                ParserD.SPartial Int
0 s
pst1 ->
                    -- XXX if we recurse we are not dropping backtrack buffer
                    -- on partial.
                    -- XXX recurse or call the driver?
                    SPEC -> s -> m (Step a m r)
go SPEC
SPEC s
pst1
                ParserD.SPartial Int
m s
pst1 -> -- n > 0
                    let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
                     in Step a m r -> m (Step a m r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step a m r -> m (Step a m r)) -> Step a m r -> m (Step a m r)
forall a b. (a -> b) -> a -> b
$ Int -> (Input a -> m (Step a m r)) -> Step a m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Partial (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (Int -> s -> Input a -> m (Step a m r)
parseCont (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
pst1)
                ParserD.SContinue Int
1 s
pst1 ->
                    Step a m r -> m (Step a m r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step a m r -> m (Step a m r)) -> Step a m r -> m (Step a m r)
forall a b. (a -> b) -> a -> b
$ Int -> (Input a -> m (Step a m r)) -> Step a m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue Int
1 (Int -> s -> Input a -> m (Step a m r)
parseCont (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) s
pst1)
                ParserD.SContinue Int
0 s
pst1 ->
                    -- XXX recurse or call the driver?
                    SPEC -> s -> m (Step a m r)
go SPEC
SPEC s
pst1
                ParserD.SContinue Int
m s
pst1 -> -- n > 0
                    let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
                     in Step a m r -> m (Step a m r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step a m r -> m (Step a m r)) -> Step a m r -> m (Step a m r)
forall a b. (a -> b) -> a -> b
$ Int -> (Input a -> m (Step a m r)) -> Step a m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (Int -> s -> Input a -> m (Step a m r)
parseCont (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
pst1)

                -- SError case
                ParserD.SError String
err ->
                    ParseResult b -> Int -> Input a -> m (Step a m r)
cont (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
0 String
err) Int
count (a -> Input a
forall a. a -> Input a
Chunk a
x)

    {-# NOINLINE parseContNothing #-}
    parseContNothing :: Int -> s -> m (Step a m r)
parseContNothing !Int
count !s
pst = do
        Final s b
r <- s -> m (Final s b)
extract s
pst
        case Final s b
r of
            ParserD.FDone Int
n b
b ->
                Bool -> m (Step a m r) -> m (Step a m r)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0)
                    (ParseResult b -> Int -> Input a -> m (Step a m r)
cont (Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success Int
n b
b) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Input a
forall a. Input a
None)
            ParserD.FContinue Int
n s
pst1 ->
                Bool -> m (Step a m r) -> m (Step a m r)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0)
                    (Step a m r -> m (Step a m r)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step a m r -> m (Step a m r)) -> Step a m r -> m (Step a m r)
forall a b. (a -> b) -> a -> b
$ Int -> (Input a -> m (Step a m r)) -> Step a m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue Int
n (Int -> s -> Input a -> m (Step a m r)
parseCont (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
pst1))
            ParserD.FError String
err ->
                -- XXX It is called only when there is no input chunk. So using
                -- 0 as the position is correct?
                ParseResult b -> Int -> Input a -> m (Step a m r)
cont (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
0 String
err) Int
count Input a
forall a. Input a
None

    -- XXX Maybe we can use two separate continuations instead of using
    -- Just/Nothing cases here. That may help in avoiding the parseContJust
    -- function call.
    {-# INLINE parseCont #-}
    parseCont :: Int -> s -> Input a -> m (Step a m r)
parseCont !Int
cnt !s
pst (Chunk a
element) = Int -> s -> a -> m (Step a m r)
parseContChunk Int
cnt s
pst a
element
    parseCont !Int
cnt !s
pst Input a
None = Int -> s -> m (Step a m r)
parseContNothing Int
cnt s
pst

-- | Convert a 'Parser' to 'ParserK'.
--
-- /Pre-release/
--
{-# INLINE_LATE toParserK #-}
toParserK, adapt :: Monad m => ParserD.Parser a m b -> ParserK a m b
toParserK :: forall (m :: * -> *) a b. Monad m => Parser a m b -> ParserK a m b
toParserK (ParserD.Parser s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m (Final s b)
extract) =
    (forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
forall a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> StepParser a m r)
 -> Int -> Int -> StepParser a m r)
-> ParserK a m b
MkParser ((forall r.
  (ParseResult b -> Int -> StepParser a m r)
  -> Int -> Int -> StepParser a m r)
 -> ParserK a m b)
-> (forall r.
    (ParseResult b -> Int -> StepParser a m r)
    -> Int -> Int -> StepParser a m r)
-> ParserK 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))
-> (ParseResult b -> Int -> Input a -> m (Step a m r))
-> Int
-> Int
-> Input a
-> m (Step a m r)
forall (m :: * -> *) a s b r.
Monad m =>
(s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m (Final s b))
-> (ParseResult b -> Int -> Input a -> m (Step a m r))
-> Int
-> Int
-> Input a
-> m (Step a m r)
adaptWith s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m (Final s b)
extract

RENAME(adapt,toParserK)

-------------------------------------------------------------------------------
-- Convert CPS style 'Parser' to direct style 'D.Parser'
-------------------------------------------------------------------------------

-- | A continuation to extract the result when a CPS parser is done.
{-# INLINE parserDone #-}
parserDone :: Applicative m =>
    ParseResult b -> Int -> Input a -> m (Step a m b)
parserDone :: forall (m :: * -> *) b a.
Applicative m =>
ParseResult b -> Int -> Input a -> m (Step a m b)
parserDone (Success Int
n b
b) Int
_ Input a
_ =
    -- trace ("parserDone Success n: " ++ show n) $
        Bool -> Any -> Any
forall a. (?callStack::CallStack) => Bool -> a -> a
assert(Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1) (Any -> Any) -> m (Step a m b) -> m (Step a m b)
forall a b. a -> b -> b
`seq` Step a m b -> m (Step a m b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> b -> Step a m b
forall a (m :: * -> *) r. Int -> r -> Step a m r
Done Int
n b
b)
parserDone (Failure Int
n String
e) Int
_ Input a
_ =
    -- trace ("parserDone Failure n: " ++ show n) $
        Bool -> Any -> Any
forall a. (?callStack::CallStack) => Bool -> a -> a
assert(Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1) (Any -> Any) -> m (Step a m b) -> m (Step a m b)
forall a b. a -> b -> b
`seq` Step a m b -> m (Step a m b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> String -> Step a m b
forall a (m :: * -> *) r. Int -> String -> Step a m r
Error Int
n String
e)

-- XXX Note that this works only for single element parsers and not for Array
-- input parsers. The asserts will fail for array parsers.
-- XXX We should move this to StreamK module along with toParserK

-- | Convert a CPS style 'ParserK' to a direct style 'Parser'.
--
-- /Pre-release/
--
{-# INLINE_LATE toParser #-}
toParser :: Monad m => ParserK a m b -> ParserD.Parser a m b
toParser :: forall (m :: * -> *) a b. Monad m => ParserK a m b -> Parser a m b
toParser ParserK a m b
parser = ((Input a -> m (Step a m b))
 -> a -> m (Step (Input a -> m (Step a m b)) b))
-> m (Initial (Input a -> m (Step a m b)) b)
-> ((Input a -> m (Step a m b))
    -> m (Final (Input a -> m (Step a m 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
ParserD.Parser (Input a -> m (Step a m b))
-> a -> m (Step (Input a -> m (Step a m b)) b)
forall {m :: * -> *} {a} {a} {m :: * -> *} {b}.
Monad m =>
(Input a -> m (Step a m b)) -> a -> m (Step (StepParser a m b) b)
step m (Initial (Input a -> m (Step a m b)) b)
forall {b}. m (Initial (Input a -> m (Step a m b)) b)
initial (Input a -> m (Step a m b))
-> m (Final (Input a -> m (Step a m b)) b)
forall {m :: * -> *} {a} {b}.
Monad m =>
StepParser a m b -> m (Final (StepParser a m b) b)
extract

    where

    initial :: m (Initial (Input a -> m (Step a m b)) b)
initial = Initial (Input a -> m (Step a m b)) b
-> m (Initial (Input a -> m (Step a m b)) b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Input a -> m (Step a m b))
-> Initial (Input a -> m (Step a m b)) b
forall s b. s -> Initial s b
ParserD.IPartial (ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> StepParser a m r)
   -> Int -> Int -> StepParser a m r
runParser ParserK a m b
parser ParseResult b -> Int -> Input a -> m (Step a m b)
forall (m :: * -> *) b a.
Applicative m =>
ParseResult b -> Int -> Input a -> m (Step a m b)
parserDone Int
0 Int
0))

    step :: (Input a -> m (Step a m b)) -> a -> m (Step (StepParser a m b) b)
step Input a -> m (Step a m b)
cont a
a = do
        Step a m b
r <- Input a -> m (Step a m b)
cont (a -> Input a
forall a. a -> Input a
Chunk a
a)
        Step (StepParser a m b) b -> m (Step (StepParser a m b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (StepParser a m b) b -> m (Step (StepParser a m b) b))
-> Step (StepParser a m b) b -> m (Step (StepParser a m b) b)
forall a b. (a -> b) -> a -> b
$ case Step a m b
r of
            Done Int
n b
b -> Bool -> Step (StepParser a m b) b -> Step (StepParser a m b) b
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1) (Int -> b -> Step (StepParser a m b) b
forall s b. Int -> b -> Step s b
ParserD.SDone Int
n b
b)
            Error Int
_ String
e -> String -> Step (StepParser a m b) b
forall s b. String -> Step s b
ParserD.SError String
e
            Partial Int
n StepParser a m b
cont1 -> Bool -> Step (StepParser a m b) b -> Step (StepParser a m b) b
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1) (Int -> StepParser a m b -> Step (StepParser a m b) b
forall s b. Int -> s -> Step s b
ParserD.SPartial Int
n StepParser a m b
cont1)
            Continue Int
n StepParser a m b
cont1 -> Bool -> Step (StepParser a m b) b -> Step (StepParser a m b) b
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1) (Int -> StepParser a m b -> Step (StepParser a m b) b
forall s b. Int -> s -> Step s b
ParserD.SContinue Int
n StepParser a m b
cont1)

    extract :: StepParser a m b -> m (Final (StepParser a m b) b)
extract StepParser a m b
cont = do
        Step a m b
r <- StepParser a m b
cont Input a
forall a. Input a
None
        case Step a m b
r of
            Done Int
n b
b ->  Bool
-> m (Final (StepParser a m b) b) -> m (Final (StepParser a m b) b)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (Final (StepParser a m b) b -> m (Final (StepParser a m b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (StepParser a m b) b -> m (Final (StepParser a m b) b))
-> Final (StepParser a m b) b -> m (Final (StepParser a m b) b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Final (StepParser a m b) b
forall s b. Int -> b -> Final s b
ParserD.FDone Int
n b
b)
            Error Int
_ String
e -> Final (StepParser a m b) b -> m (Final (StepParser a m b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (StepParser a m b) b -> m (Final (StepParser a m b) b))
-> Final (StepParser a m b) b -> m (Final (StepParser a m b) b)
forall a b. (a -> b) -> a -> b
$ String -> Final (StepParser a m b) b
forall s b. String -> Final s b
ParserD.FError String
e
            Partial Int
_ StepParser a m b
cont1 -> StepParser a m b -> m (Final (StepParser a m b) b)
extract StepParser a m b
cont1
            Continue Int
n StepParser a m b
cont1 ->
                Bool
-> m (Final (StepParser a m b) b) -> m (Final (StepParser a m b) b)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (Final (StepParser a m b) b -> m (Final (StepParser a m b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Final (StepParser a m b) b -> m (Final (StepParser a m b) b))
-> Final (StepParser a m b) b -> m (Final (StepParser a m b) b)
forall a b. (a -> b) -> a -> b
$ Int -> StepParser a m b -> Final (StepParser a m b) b
forall s b. Int -> s -> Final s b
ParserD.FContinue Int
n StepParser a m b
cont1)

{-# RULES "toParserK/toParser fusion" [2]
    forall s. toParser (toParserK s) = s #-}
{-# RULES "toParser/toParserK fusion" [2]
    forall s. toParserK (toParser s) = s #-}

-- | @chainl1 p op x@ parses /one/ or more occurrences of @p@, separated by
-- @op@. Returns a value obtained by a /left/ associative application of all
-- functions returned by @op@ to the values returned by @p@.
--
-- >>> num = Parser.decimal
-- >>> plus = Parser.char '+' *> pure (+)
-- >>> expr = ParserK.chainl1 (StreamK.toParserK num) (StreamK.toParserK plus)
-- >>> StreamK.parse expr $ StreamK.fromStream $ Stream.fromList "1+2+3"
-- Right 6
--
-- If you're building full expression parsers with operator precedence and
-- associativity, consider using @makeExprParser@ from the @parser-combinators@
-- package.
--
-- See also 'Streamly.Internal.Data.Parser.deintercalate'.
--
{-# INLINE chainl1 #-}
chainl1 :: ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a
chainl1 :: forall b a.
ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a
chainl1 ParserK b IO a
p ParserK b IO (a -> a -> a)
op = ParserK b IO a
p ParserK b IO a -> (a -> ParserK b IO a) -> ParserK b IO a
forall a b.
ParserK b IO a -> (a -> ParserK b IO b) -> ParserK b IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParserK b IO a
go

    where

    go :: a -> ParserK b IO a
go a
l = a -> ParserK b IO a
step a
l ParserK b IO a -> ParserK b IO a -> ParserK b IO a
forall a. ParserK b IO a -> ParserK b IO a -> ParserK b IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> ParserK b IO a
forall a. a -> ParserK b IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
l

    step :: a -> ParserK b IO a
step a
l = do
        a -> a -> a
f <- ParserK b IO (a -> a -> a)
op
        a
r <- ParserK b IO a
p
        a -> ParserK b IO a
go (a -> a -> a
f a
l a
r)

-- | @chainl p op x@ is like 'chainl1' but allows /zero/ or more occurrences of
-- @p@, separated by @op@. If there are zero occurrences of @p@, the value @x@
-- is returned.
{-# INLINE chainl #-}
chainl :: ParserK b IO a -> ParserK b IO (a -> a -> a) -> a -> ParserK b IO a
chainl :: forall b a.
ParserK b IO a -> ParserK b IO (a -> a -> a) -> a -> ParserK b IO a
chainl ParserK b IO a
p ParserK b IO (a -> a -> a)
op a
x = ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a
forall b a.
ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a
chainl1 ParserK b IO a
p ParserK b IO (a -> a -> a)
op ParserK b IO a -> ParserK b IO a -> ParserK b IO a
forall a. ParserK b IO a -> ParserK b IO a -> ParserK b IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> ParserK b IO a
forall a. a -> ParserK b IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-- | Like chainl1 but parses right associative application of the operator
-- instead of left associative.
--
-- >>> num = Parser.decimal
-- >>> pow = Parser.char '^' *> pure (^)
-- >>> expr = ParserK.chainr1 (StreamK.toParserK num) (StreamK.toParserK pow)
-- >>> StreamK.parse expr $ StreamK.fromStream $ Stream.fromList "2^3^2"
-- Right 512
--
{-# INLINE chainr1 #-}
chainr1 :: ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a
chainr1 :: forall b a.
ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a
chainr1 ParserK b IO a
p ParserK b IO (a -> a -> a)
op = ParserK b IO a
p ParserK b IO a -> (a -> ParserK b IO a) -> ParserK b IO a
forall a b.
ParserK b IO a -> (a -> ParserK b IO b) -> ParserK b IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParserK b IO a
go

    where

    go :: a -> ParserK b IO a
go a
l = a -> ParserK b IO a
step a
l ParserK b IO a -> ParserK b IO a -> ParserK b IO a
forall a. ParserK b IO a -> ParserK b IO a -> ParserK b IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> ParserK b IO a
forall a. a -> ParserK b IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
l

    step :: a -> ParserK b IO a
step a
l = do
        a -> a -> a
f <- ParserK b IO (a -> a -> a)
op
        a
r <- ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a
forall b a.
ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a
chainr1 ParserK b IO a
p ParserK b IO (a -> a -> a)
op
        a -> ParserK b IO a
forall a. a -> ParserK b IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a
f a
l a
r)

-- | @chainr p op x@ is like 'chainr1' but allows /zero/ or more occurrences of
-- @p@, separated by @op@. If there are zero occurrences of @p@, the value @x@
-- is returned.
{-# INLINE chainr #-}
chainr :: ParserK b IO a -> ParserK b IO (a -> a -> a) -> a -> ParserK b IO a
chainr :: forall b a.
ParserK b IO a -> ParserK b IO (a -> a -> a) -> a -> ParserK b IO a
chainr ParserK b IO a
p ParserK b IO (a -> a -> a)
op a
x = ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a
forall b a.
ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a
chainr1 ParserK b IO a
p ParserK b IO (a -> a -> a)
op ParserK b IO a -> ParserK b IO a -> ParserK b IO a
forall a. ParserK b IO a -> ParserK b IO a -> ParserK b IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> ParserK b IO a
forall a. a -> ParserK b IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x