-- |
-- 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.
--
-- 'Applicative' and 'Control.Applicative.Alternative' type class based
-- combinators from the
-- <http://hackage.haskell.org/package/parser-combinators parser-combinators>
-- package can also be used with the 'ParserK' type.

module Streamly.Internal.Data.ParserK.Type
    (
      Step (..)
    , Input (..)
    , ParseResult (..)
    , ParserK (..)
    , adaptC
    , adapt
    , adaptCG
    , toParser -- XXX unParserK, unK, unPK
    , fromPure
    , fromEffect
    , die
    )
where

#include "ArrayMacros.h"
#include "assert.hs"
#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 Data.Proxy (Proxy(..))
import GHC.Types (SPEC(..))
import Streamly.Internal.Data.Array.Type (Array(..))
import Streamly.Internal.Data.Unbox (Unbox(..))
import Streamly.Internal.System.IO (unsafeInlineIO)

import qualified Control.Monad.Fail as Fail
import qualified Streamly.Internal.Data.Array.Type as Array
import qualified Streamly.Internal.Data.MutArray.Generic as GenArr
    ( unsafeGetIndexWith
    )
import qualified Streamly.Internal.Data.Array.Generic as GenArr
import qualified Streamly.Internal.Data.Parser.Type as ParserD

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

-- XXX Step should be renamed to StepResult.
-- XXX and StepParser should be just Step.

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

-- | The intermediate result of running a parser step. The parser driver may
-- stop with a final result, pause with a continuation to resume, or fail with
-- an error.
--
-- See ParserD docs. This is the same as the ParserD Step except that it uses a
-- continuation in Partial and Continue constructors instead of a state in case
-- of ParserD.
--
-- /Pre-release/
--
data Step a m r =
    -- The Int is the current stream position index wrt to the start of the
    -- array.
      Done !Int r
    | Partial !Int (StepParser a m r)
    | Continue !Int (StepParser a m r)
    | 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 into the current input array. Could be negative.
-- Cannot be beyond the input array max bound.
--
-- /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 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.
--
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.
           -- 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.
           --
           -- Do not eta reduce the applications of this continuation.
           --
           -- The current stream position index is carried as part of 'Success'
           -- constructor of 'ParseResult'. The second argument is the used
           -- elem count.
           (ParseResult b -> Int -> StepParser a m r)
           -- XXX Maintain and pass the original position in the stream. that
           -- way we can also report better errors. Use a Context structure for
           -- passing the state.

           -- Stream position index wrt to the current input array start. If
           -- negative then backtracking is required before using the array.
           -- The parser should use "Continue -n" in this case if it needs to
           -- consume input. Negative value cannot be beyond the current
           -- backtrack buffer. Positive value cannot be beyond array length.
           -- If the parser needs to advance beyond the array length it should
           -- use "Continue +n".
        -> Int
           -- used elem count, a count of elements consumed by the parser. If
           -- an Alternative fails we need to backtrack by this amount.
        -> Int
        -> 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
-}

-------------------------------------------------------------------------------
-- Convert ParserD to ParserK
-------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- Chunked
--------------------------------------------------------------------------------

{-# INLINE adaptCWith #-}
adaptCWith
    :: forall m a s b r. (Monad m, Unbox a)
    => (s -> a -> m (ParserD.Step s b))
    -> m (ParserD.Initial s b)
    -> (s -> m (ParserD.Step s b))
    -> (ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r))
    -> Int
    -> Int
    -> Input (Array a)
    -> m (Step (Array a) m r)
adaptCWith :: forall (m :: * -> *) a s b r.
(Monad m, Unbox a) =>
(s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m (Step s b))
-> (ParseResult b
    -> Int -> Input (Array a) -> m (Step (Array a) m r))
-> Int
-> Int
-> Input (Array a)
-> m (Step (Array a) m r)
adaptCWith s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m (Step s b)
extract ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont !Int
offset0 !Int
usedCount !Input (Array a)
input = do
    Initial s b
res <- m (Initial s b)
initial
    case Initial s b
res of
        ParserD.IPartial s
pst -> do
            case Input (Array a)
input of
                Chunk Array a
arr -> Int -> Int -> s -> Array a -> m (Step (Array a) m r)
parseContChunk Int
usedCount Int
offset0 s
pst Array a
arr
                Input (Array a)
None -> Int -> s -> m (Step (Array a) m r)
parseContNothing Int
usedCount s
pst
        ParserD.IDone b
b -> ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success Int
offset0 b
b) Int
usedCount Input (Array a)
input
        ParserD.IError String
err -> ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
offset0 String
err) Int
usedCount Input (Array a)
input

    where

    -- XXX We can maintain an absolute position instead of relative that will
    -- help in reporting of error location in the stream.
    {-# NOINLINE parseContChunk #-}
    parseContChunk :: Int -> Int -> s -> Array a -> m (Step (Array a) m r)
parseContChunk !Int
count !Int
offset !s
state arr :: Array a
arr@(Array MutByteArray
contents Int
start Int
end) = do
         if Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
         then SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)) state
         else Step (Array a) m r -> m (Step (Array a) m r)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Array a) m r -> m (Step (Array a) m r))
-> Step (Array a) m r -> m (Step (Array a) m r)
forall a b. (a -> b) -> a -> b
$ Int
-> (Input (Array a) -> m (Step (Array a) m r))
-> Step (Array a) m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue Int
offset (Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont Int
count s
state)

        where

        {-# INLINE onDone #-}
        onDone :: Int -> b -> m (Step (Array a) m r)
onDone Int
n b
b =
            Bool -> m (Step (Array a) m r) -> m (Step (Array a) m r)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Array a -> Int
forall a. Unbox a => Array a -> Int
Array.length Array a
arr)
                (ParseResult b -> Int -> Input (Array a) -> m (Step (Array 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) (Array a -> Input (Array a)
forall a. a -> Input a
Chunk Array a
arr))

        {-# INLINE callParseCont #-}
        callParseCont :: (Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a)
-> Int -> s -> m a
callParseCont Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a
constr Int
n s
pst1 =
            Bool -> m a -> m a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Array a -> Int
forall a. Unbox a => Array a -> Int
Array.length Array a
arr)
                (a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a
constr Int
n (Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) s
pst1))

        {-# INLINE onPartial #-}
        onPartial :: Int -> s -> m (Step (Array a) m r)
onPartial = (Int
 -> (Input (Array a) -> m (Step (Array a) m r))
 -> Step (Array a) m r)
-> Int -> s -> m (Step (Array a) m r)
forall {m :: * -> *} {a}.
Monad m =>
(Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a)
-> Int -> s -> m a
callParseCont Int
-> (Input (Array a) -> m (Step (Array a) m r))
-> Step (Array a) m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Partial

        {-# INLINE onContinue #-}
        onContinue :: Int -> s -> m (Step (Array a) m r)
onContinue = (Int
 -> (Input (Array a) -> m (Step (Array a) m r))
 -> Step (Array a) m r)
-> Int -> s -> m (Step (Array a) m r)
forall {m :: * -> *} {a}.
Monad m =>
(Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a)
-> Int -> s -> m a
callParseCont Int
-> (Input (Array a) -> m (Step (Array a) m r))
-> Step (Array a) m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue

        {-# INLINE onError #-}
        onError :: Int -> String -> m (Step (Array a) m r)
onError Int
n String
err =
            ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
n String
err) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) (Array a -> Input (Array a)
forall a. a -> Input a
Chunk Array a
arr)

        {-# INLINE onBack #-}
        onBack :: Int
-> Int
-> (Int -> s -> m (Step (Array a) m r))
-> s
-> m (Step (Array a) m r)
onBack Int
offset1 Int
elemSize Int -> s -> m (Step (Array a) m r)
constr s
pst = do
            let pos :: Int
pos = Int
offset1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
             in if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
                then SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
offset1 s
pst
                else Int -> s -> m (Step (Array a) m r)
constr (Int
pos Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
elemSize) s
pst

        -- Note: div may be expensive but the alternative is to maintain an element
        -- offset in addition to a byte offset or just the element offset and use
        -- multiplication to get the byte offset every time, both these options
        -- turned out to be more expensive than using div.
        go :: SPEC -> Int -> s -> m (Step (Array a) m r)
go !SPEC
_ !Int
cur !s
pst | Int
cur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end =
            Int -> s -> m (Step (Array a) m r)
onContinue ((Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` SIZE_OF(a))  pst
        go !SPEC
_ !Int
cur !s
pst = do
            let !x :: a
x = IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
cur MutByteArray
contents
            Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
            let elemSize :: Int
elemSize = SIZE_OF(a)
                next :: Int
next = INDEX_NEXT(cur,a)
                back :: Int -> Int
back Int
n = Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
elemSize
                curOff :: Int
curOff = (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
elemSize
                nextOff :: Int
nextOff = (Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
elemSize
            -- The "n" here is stream position index wrt the array start, and
            -- not the backtrack count as returned by byte stream parsers.
            case Step s b
pRes of
                ParserD.Done Int
0 b
b ->
                    Int -> b -> m (Step (Array a) m r)
onDone Int
nextOff b
b
                ParserD.Done Int
1 b
b ->
                    Int -> b -> m (Step (Array a) m r)
onDone Int
curOff b
b
                ParserD.Done Int
n b
b ->
                    Int -> b -> m (Step (Array a) m r)
onDone ((Int -> Int
back Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
elemSize) b
b
                ParserD.Partial Int
0 s
pst1 ->
                    SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
next s
pst1
                ParserD.Partial Int
1 s
pst1 ->
                    SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
cur s
pst1
                ParserD.Partial Int
n s
pst1 ->
                    Int
-> Int
-> (Int -> s -> m (Step (Array a) m r))
-> s
-> m (Step (Array a) m r)
onBack (Int -> Int
back Int
n) Int
elemSize Int -> s -> m (Step (Array a) m r)
onPartial s
pst1
                ParserD.Continue Int
0 s
pst1 ->
                    SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
next s
pst1
                ParserD.Continue Int
1 s
pst1 ->
                    SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
cur s
pst1
                ParserD.Continue Int
n s
pst1 ->
                    Int
-> Int
-> (Int -> s -> m (Step (Array a) m r))
-> s
-> m (Step (Array a) m r)
onBack (Int -> Int
back Int
n) Int
elemSize Int -> s -> m (Step (Array a) m r)
onContinue s
pst1
                ParserD.Error String
err ->
                    Int -> String -> m (Step (Array a) m r)
onError Int
curOff String
err

    {-# NOINLINE parseContNothing #-}
    parseContNothing :: Int -> s -> m (Step (Array a) m r)
parseContNothing !Int
count !s
pst = do
        Step s b
r <- s -> m (Step s b)
extract s
pst
        case Step s b
r of
            -- IMPORTANT: the n here is from the byte stream parser, that means
            -- it is the backtrack element count and not the stream position
            -- index into the current input array.
            ParserD.Done Int
n b
b ->
                Bool -> m (Step (Array a) m r) -> m (Step (Array 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 (Array a) -> m (Step (Array 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 (Array a)
forall a. Input a
None)
            ParserD.Continue Int
n s
pst1 ->
                Bool -> m (Step (Array a) m r) -> m (Step (Array 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 (Array a) m r -> m (Step (Array a) m r)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Array a) m r -> m (Step (Array a) m r))
-> Step (Array a) m r -> m (Step (Array a) m r)
forall a b. (a -> b) -> a -> b
$ Int
-> (Input (Array a) -> m (Step (Array a) m r))
-> Step (Array a) m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue (- Int
n) (Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
pst1))
            ParserD.Error String
err ->
                -- XXX It is called only when there is no input arr. So using 0
                -- as the position is correct?
                ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
0 String
err) Int
count Input (Array a)
forall a. Input a
None
            ParserD.Partial Int
_ s
_ -> String -> m (Step (Array a) m r)
forall a. (?callStack::CallStack) => String -> a
error String
"Bug: adaptCWith Partial unreachable"

    -- 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 (Array a) -> m (Step (Array a) m r)
parseCont !Int
cnt !s
pst (Chunk Array a
arr) = Int -> Int -> s -> Array a -> m (Step (Array a) m r)
parseContChunk Int
cnt Int
0 s
pst Array a
arr
    parseCont !Int
cnt !s
pst Input (Array a)
None = Int -> s -> m (Step (Array a) m r)
parseContNothing Int
cnt s
pst

-- | Convert an element 'Parser' to a chunked 'ParserK'. A chunked parser is
-- more efficient than an element parser.
--
-- /Pre-release/
--
{-# INLINE_LATE adaptC #-}
adaptC :: (Monad m, Unbox a) => ParserD.Parser a m b -> ParserK (Array a) m b
adaptC :: forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Parser a m b -> ParserK (Array a) m b
adaptC (ParserD.Parser s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m (Step s b)
extract) =
    (forall r.
 (ParseResult b -> Int -> StepParser (Array a) m r)
 -> Int -> Int -> StepParser (Array a) m r)
-> ParserK (Array 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 (Array a) m r)
  -> Int -> Int -> StepParser (Array a) m r)
 -> ParserK (Array a) m b)
-> (forall r.
    (ParseResult b -> Int -> StepParser (Array a) m r)
    -> Int -> Int -> StepParser (Array a) m r)
-> ParserK (Array a) m b
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m (Step s b))
-> (ParseResult b
    -> Int -> Input (Array a) -> m (Step (Array a) m r))
-> Int
-> Int
-> Input (Array a)
-> m (Step (Array a) m r)
forall (m :: * -> *) a s b r.
(Monad m, Unbox a) =>
(s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m (Step s b))
-> (ParseResult b
    -> Int -> Input (Array a) -> m (Step (Array a) m r))
-> Int
-> Int
-> Input (Array a)
-> m (Step (Array a) m r)
adaptCWith s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m (Step s b)
extract

--------------------------------------------------------------------------------
-- Singular
--------------------------------------------------------------------------------

{-# 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.Step 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 (Step 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 (Step 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

    -- XXX We can maintain an absolute position instead of relative that will
    -- help in reporting of error location in the stream.
    {-# 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.Done 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
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.Done 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
0 b
b) Int
count (a -> Input a
forall a. a -> Input a
Chunk a
x)
                ParserD.Done Int
n b
b -> -- n > 1
                    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.Partial Int
0 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.Partial Int
1 s
pst1 ->
                    -- XXX recurse or call the driver?
                    SPEC -> s -> m (Step a m r)
go SPEC
SPEC s
pst1
                ParserD.Partial Int
n s
pst1 -> -- n > 0
                    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.Continue Int
0 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.Continue Int
1 s
pst1 ->
                    -- XXX recurse or call the driver?
                    SPEC -> s -> m (Step a m r)
go SPEC
SPEC s
pst1
                ParserD.Continue Int
n s
pst1 -> -- n > 0
                    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)

                -- Error case
                ParserD.Error 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
        Step s b
r <- s -> m (Step s b)
extract s
pst
        case Step s b
r of
            -- IMPORTANT: the n here is from the byte stream parser, that means
            -- it is the backtrack element count and not the stream position
            -- index into the current input chunk.
            ParserD.Done 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.Continue 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.Error 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
            ParserD.Partial Int
_ s
_ -> String -> m (Step a m r)
forall a. (?callStack::CallStack) => String -> a
error String
"Bug: adaptWith Partial unreachable"

    -- 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 adapt #-}
adapt :: Monad m => ParserD.Parser a m b -> ParserK a m b
adapt :: forall (m :: * -> *) a b. Monad m => Parser a m b -> ParserK a m b
adapt (ParserD.Parser s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m (Step 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 (Step 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 (Step 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 (Step s b)
extract

--------------------------------------------------------------------------------
-- Chunked Generic
--------------------------------------------------------------------------------

{-# INLINE adaptCGWith #-}
adaptCGWith
    :: forall m a s b r. (Monad m)
    => (s -> a -> m (ParserD.Step s b))
    -> m (ParserD.Initial s b)
    -> (s -> m (ParserD.Step s b))
    -> (ParseResult b -> Int -> Input (GenArr.Array a) -> m (Step (GenArr.Array a) m r))
    -> Int
    -> Int
    -> Input (GenArr.Array a)
    -> m (Step (GenArr.Array a) m r)
adaptCGWith :: forall (m :: * -> *) a s b r.
Monad m =>
(s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m (Step s b))
-> (ParseResult b
    -> Int -> Input (Array a) -> m (Step (Array a) m r))
-> Int
-> Int
-> Input (Array a)
-> m (Step (Array a) m r)
adaptCGWith s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m (Step s b)
extract ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont !Int
offset0 !Int
usedCount !Input (Array a)
input = do
    Initial s b
res <- m (Initial s b)
initial
    case Initial s b
res of
        ParserD.IPartial s
pst -> do
            case Input (Array a)
input of
                Chunk Array a
arr -> Int -> Int -> s -> Array a -> m (Step (Array a) m r)
parseContChunk Int
usedCount Int
offset0 s
pst Array a
arr
                Input (Array a)
None -> Int -> s -> m (Step (Array a) m r)
parseContNothing Int
usedCount s
pst
        ParserD.IDone b
b -> ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> b -> ParseResult b
forall b. Int -> b -> ParseResult b
Success Int
offset0 b
b) Int
usedCount Input (Array a)
input
        ParserD.IError String
err -> ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
offset0 String
err) Int
usedCount Input (Array a)
input

    where

    {-# NOINLINE parseContChunk #-}
    parseContChunk :: Int -> Int -> s -> Array a -> m (Step (Array a) m r)
parseContChunk !Int
count !Int
offset !s
state arr :: Array a
arr@(GenArr.Array MutableArray# RealWorld a
contents Int
start Int
end) = do
         if Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
         then SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) s
state
         else Step (Array a) m r -> m (Step (Array a) m r)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Array a) m r -> m (Step (Array a) m r))
-> Step (Array a) m r -> m (Step (Array a) m r)
forall a b. (a -> b) -> a -> b
$ Int
-> (Input (Array a) -> m (Step (Array a) m r))
-> Step (Array a) m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue Int
offset (Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont Int
count s
state)

        where

        {-# INLINE onDone #-}
        onDone :: Int -> b -> m (Step (Array a) m r)
onDone Int
n b
b =
            Bool -> m (Step (Array a) m r) -> m (Step (Array a) m r)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Array a -> Int
forall a. Array a -> Int
GenArr.length Array a
arr)
                (ParseResult b -> Int -> Input (Array a) -> m (Step (Array 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) (Array a -> Input (Array a)
forall a. a -> Input a
Chunk Array a
arr))

        {-# INLINE callParseCont #-}
        callParseCont :: (Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a)
-> Int -> s -> m a
callParseCont Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a
constr Int
n s
pst1 =
            Bool -> m a -> m a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Array a -> Int
forall a. Array a -> Int
GenArr.length Array a
arr)
                (a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a
constr Int
n (Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) s
pst1))

        {-# INLINE onPartial #-}
        onPartial :: Int -> s -> m (Step (Array a) m r)
onPartial = (Int
 -> (Input (Array a) -> m (Step (Array a) m r))
 -> Step (Array a) m r)
-> Int -> s -> m (Step (Array a) m r)
forall {m :: * -> *} {a}.
Monad m =>
(Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a)
-> Int -> s -> m a
callParseCont Int
-> (Input (Array a) -> m (Step (Array a) m r))
-> Step (Array a) m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Partial

        {-# INLINE onContinue #-}
        onContinue :: Int -> s -> m (Step (Array a) m r)
onContinue = (Int
 -> (Input (Array a) -> m (Step (Array a) m r))
 -> Step (Array a) m r)
-> Int -> s -> m (Step (Array a) m r)
forall {m :: * -> *} {a}.
Monad m =>
(Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a)
-> Int -> s -> m a
callParseCont Int
-> (Input (Array a) -> m (Step (Array a) m r))
-> Step (Array a) m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue

        {-# INLINE onError #-}
        onError :: Int -> String -> m (Step (Array a) m r)
onError Int
n String
err =
            ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
n String
err) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) (Array a -> Input (Array a)
forall a. a -> Input a
Chunk Array a
arr)

        {-# INLINE onBack #-}
        onBack :: Int
-> (Int -> s -> m (Step (Array a) m r))
-> s
-> m (Step (Array a) m r)
onBack Int
offset1 Int -> s -> m (Step (Array a) m r)
constr s
pst = do
            let pos :: Int
pos = Int
offset1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
             in if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
                then SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
offset1 s
pst
                else Int -> s -> m (Step (Array a) m r)
constr Int
pos s
pst

        go :: SPEC -> Int -> s -> m (Step (Array a) m r)
go !SPEC
_ !Int
cur !s
pst | Int
cur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end =
            Int -> s -> m (Step (Array a) m r)
onContinue (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start)  s
pst
        go !SPEC
_ !Int
cur !s
pst = do
            let !x :: a
x = IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ MutableArray# RealWorld a -> Int -> IO a
forall (m :: * -> *) a.
MonadIO m =>
MutableArray# RealWorld a -> Int -> m a
GenArr.unsafeGetIndexWith MutableArray# RealWorld a
contents Int
cur
            Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
            let next :: Int
next = Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                back :: Int -> Int
back Int
n = Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n
                curOff :: Int
curOff = Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
                nextOff :: Int
nextOff = Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
            -- The "n" here is stream position index wrt the array start, and
            -- not the backtrack count as returned by byte stream parsers.
            case Step s b
pRes of
                ParserD.Done Int
0 b
b ->
                    Int -> b -> m (Step (Array a) m r)
onDone Int
nextOff b
b
                ParserD.Done Int
1 b
b ->
                    Int -> b -> m (Step (Array a) m r)
onDone Int
curOff b
b
                ParserD.Done Int
n b
b ->
                    Int -> b -> m (Step (Array a) m r)
onDone (Int -> Int
back Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) b
b
                ParserD.Partial Int
0 s
pst1 ->
                    SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
next s
pst1
                ParserD.Partial Int
1 s
pst1 ->
                    SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
cur s
pst1
                ParserD.Partial Int
n s
pst1 ->
                    Int
-> (Int -> s -> m (Step (Array a) m r))
-> s
-> m (Step (Array a) m r)
onBack (Int -> Int
back Int
n) Int -> s -> m (Step (Array a) m r)
onPartial s
pst1
                ParserD.Continue Int
0 s
pst1 ->
                    SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
next s
pst1
                ParserD.Continue Int
1 s
pst1 ->
                    SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC Int
cur s
pst1
                ParserD.Continue Int
n s
pst1 ->
                    Int
-> (Int -> s -> m (Step (Array a) m r))
-> s
-> m (Step (Array a) m r)
onBack (Int -> Int
back Int
n) Int -> s -> m (Step (Array a) m r)
onContinue s
pst1
                ParserD.Error String
err ->
                    Int -> String -> m (Step (Array a) m r)
onError Int
curOff String
err

    {-# NOINLINE parseContNothing #-}
    parseContNothing :: Int -> s -> m (Step (Array a) m r)
parseContNothing !Int
count !s
pst = do
        Step s b
r <- s -> m (Step s b)
extract s
pst
        case Step s b
r of
            -- IMPORTANT: the n here is from the byte stream parser, that means
            -- it is the backtrack element count and not the stream position
            -- index into the current input array.
            ParserD.Done Int
n b
b ->
                Bool -> m (Step (Array a) m r) -> m (Step (Array 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 (Array a) -> m (Step (Array 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 (Array a)
forall a. Input a
None)
            ParserD.Continue Int
n s
pst1 ->
                Bool -> m (Step (Array a) m r) -> m (Step (Array 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 (Array a) m r -> m (Step (Array a) m r)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Array a) m r -> m (Step (Array a) m r))
-> Step (Array a) m r -> m (Step (Array a) m r)
forall a b. (a -> b) -> a -> b
$ Int
-> (Input (Array a) -> m (Step (Array a) m r))
-> Step (Array a) m r
forall a (m :: * -> *) r. Int -> StepParser a m r -> Step a m r
Continue (- Int
n) (Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) s
pst1))
            ParserD.Error String
err ->
                -- XXX It is called only when there is no input arr. So using 0
                -- as the position is correct?
                ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (Int -> String -> ParseResult b
forall b. Int -> String -> ParseResult b
Failure Int
0 String
err) Int
count Input (Array a)
forall a. Input a
None
            ParserD.Partial Int
_ s
_ -> String -> m (Step (Array a) m r)
forall a. (?callStack::CallStack) => String -> a
error String
"Bug: adaptCGWith Partial unreachable"

    {-# INLINE parseCont #-}
    parseCont :: Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont !Int
cnt !s
pst (Chunk Array a
arr) = Int -> Int -> s -> Array a -> m (Step (Array a) m r)
parseContChunk Int
cnt Int
0 s
pst Array a
arr
    parseCont !Int
cnt !s
pst Input (Array a)
None = Int -> s -> m (Step (Array a) m r)
parseContNothing Int
cnt s
pst

-- | A generic 'adaptC'. Similar to 'adaptC' but is not constrained to 'Unbox'
-- types.
--
-- /Pre-release/
--
{-# INLINE_LATE adaptCG #-}
adaptCG ::
       Monad m => ParserD.Parser a m b -> ParserK (GenArr.Array a) m b
adaptCG :: forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> ParserK (Array a) m b
adaptCG (ParserD.Parser s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m (Step s b)
extract) =
    (forall r.
 (ParseResult b -> Int -> StepParser (Array a) m r)
 -> Int -> Int -> StepParser (Array a) m r)
-> ParserK (Array 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 (Array a) m r)
  -> Int -> Int -> StepParser (Array a) m r)
 -> ParserK (Array a) m b)
-> (forall r.
    (ParseResult b -> Int -> StepParser (Array a) m r)
    -> Int -> Int -> StepParser (Array a) m r)
-> ParserK (Array a) m b
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m (Step s b))
-> (ParseResult b
    -> Int -> Input (Array a) -> m (Step (Array a) m r))
-> Int
-> Int
-> Input (Array a)
-> m (Step (Array a) m r)
forall (m :: * -> *) a s b r.
Monad m =>
(s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m (Step s b))
-> (ParseResult b
    -> Int -> Input (Array a) -> m (Step (Array a) m r))
-> Int
-> Int
-> Input (Array a)
-> m (Step (Array a) m r)
adaptCGWith s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m (Step s b)
extract

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

-- | A continuation to extract the result when a CPS parser is done.
{-# INLINE parserDone #-}
parserDone :: Monad m => ParseResult b -> Int -> Input a -> m (Step a m b)
parserDone :: forall (m :: * -> *) b a.
Monad m =>
ParseResult b -> Int -> Input a -> m (Step a m b)
parserDone (Success Int
n b
b) Int
_ Input a
_ = do
    assertM(Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1)
    Step a m b -> m (Step a m b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step a m b -> m (Step a m b)) -> Step a m b -> m (Step a m b)
forall a b. (a -> b) -> a -> b
$ 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
_ = do
    assertM(Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1)
    Step a m b -> m (Step a m b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step a m b -> m (Step a m b)) -> Step a m b -> m (Step a m b)
forall a b. (a -> b) -> a -> b
$ 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.

-- | Convert a CPS style 'ParserK' to a direct style 'ParserD.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 (Step (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 (Step 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 (Step (Input a -> m (Step a m b)) b)
forall {m :: * -> *} {a} {b}.
Monad m =>
StepParser a m b -> m (Step (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.
Monad 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.Done (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) b
b)
            Error Int
_ String
e -> String -> Step (StepParser a m b) b
forall s b. String -> Step s b
ParserD.Error 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.Partial (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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.Continue (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) StepParser a m b
cont1)

    extract :: StepParser a m b -> m (Step (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
            -- This is extract so no input has been given, therefore, the
            -- translation here is (0 - n) rather than (1 - n).
            Done Int
n b
b ->  Bool
-> m (Step (StepParser a m b) b) -> m (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
0) (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
$ Int -> b -> Step (StepParser a m b) b
forall s b. Int -> b -> Step s b
ParserD.Done (Int -> Int
forall a. Num a => a -> a
negate Int
n) b
b)
            Error Int
_ String
e -> 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
$ String -> Step (StepParser a m b) b
forall s b. String -> Step s b
ParserD.Error String
e
            Partial Int
_ StepParser a m b
cont1 -> StepParser a m b -> m (Step (StepParser a m b) b)
extract StepParser a m b
cont1
            Continue Int
n StepParser a m b
cont1 ->
                Bool
-> m (Step (StepParser a m b) b) -> m (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
0) (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
$ Int -> StepParser a m b -> Step (StepParser a m b) b
forall s b. Int -> s -> Step s b
ParserD.Continue (Int -> Int
forall a. Num a => a -> a
negate Int
n) StepParser a m b
cont1)

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