-- |
-- 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
    , 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
    ( getIndexUnsafeWith
    )
import qualified Streamly.Internal.Data.Array.Generic as GenArr
import qualified Streamly.Internal.Data.Parser.Type as ParserD

-- 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)
--
data Input a = None | Chunk a

-- | 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 (Input a -> m (Step a m r))
    | Continue !Int (Input a -> m (Step 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) = 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 Input a -> m (Step a m a)
k) = forall a (m :: * -> *) r.
Int -> (Input a -> m (Step a m r)) -> Step a m r
Partial Int
n (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input a -> m (Step a m a)
k)
    fmap a -> b
f (Continue Int
n Input a -> m (Step a m a)
k) = forall a (m :: * -> *) r.
Int -> (Input a -> m (Step a m r)) -> Step a m r
Continue Int
n (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input a -> m (Step a m a)
k)
    fmap a -> b
_ (Error Int
n String
e) = 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) = forall b. Int -> b -> ParseResult b
Success Int
n (a -> b
f a
b)
    fmap a -> b
_ (Failure Int
n String
e) = 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 -> Input a -> m (Step a m r))
   -> Int -> Int -> Input a -> m (Step 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.
           --
           (ParseResult b -> Int -> Input a -> m (Step 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
           -- The second argument is the used count as described above. The
           -- current input position is carried as part of 'Success'
           -- constructor of 'ParseResult'.
        -> Input a
        -> m (Step 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 a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> Input a -> m (Step a m r))
 -> Int -> Int -> Input a -> m (Step a m r))
-> ParserK a m b
MkParser forall a b. (a -> b) -> a -> b
$ \ParseResult b -> Int -> Input a -> m (Step a m r)
k Int
n Int
st Input a
arr ->
        let k1 :: ParseResult a -> Int -> Input a -> m (Step a m r)
k1 ParseResult a
res = ParseResult b -> Int -> Input a -> m (Step a m r)
k (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ParseResult a
res)
         in forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> Input a -> m (Step a m r))
   -> Int -> Int -> Input a -> m (Step a m r)
runParser ParserK a m a
parser ParseResult a -> Int -> Input a -> m (Step a m r)
k1 Int
n Int
st Input a
arr

-------------------------------------------------------------------------------
-- 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 a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> Input a -> m (Step a m r))
 -> Int -> Int -> Input a -> m (Step a m r))
-> ParserK a m b
MkParser forall a b. (a -> b) -> a -> b
$ \ParseResult b -> Int -> Input a -> m (Step a m r)
k Int
n Int
st Input a
arr -> ParseResult b -> Int -> Input a -> m (Step a m r)
k (forall b. Int -> b -> ParseResult b
Success Int
n b
b) Int
st Input a
arr

-- | 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 a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> Input a -> m (Step a m r))
 -> Int -> Int -> Input a -> m (Step a m r))
-> ParserK a m b
MkParser forall a b. (a -> b) -> a -> b
$ \ParseResult b -> Int -> Input a -> m (Step a m r)
k Int
n Int
st Input a
arr -> m b
eff forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
b -> ParseResult b -> Int -> Input a -> m (Step a m r)
k (forall b. Int -> b -> ParseResult b
Success Int
n b
b) Int
st Input a
arr

-- | @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 = 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
(<*>) = 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 a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> Input a -> m (Step a m r))
 -> Int -> Int -> Input a -> m (Step a m r))
-> ParserK a m b
MkParser forall a b. (a -> b) -> a -> b
$ \ParseResult b -> Int -> Input a -> m (Step a m r)
k Int
n Int
st Input a
arr ->
        let k1 :: ParseResult b -> Int -> Input a -> m (Step a m r)
k1 (Success Int
n1 b
_) Int
s Input a
input = forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> Input a -> m (Step a m r))
   -> Int -> Int -> Input a -> m (Step a m r)
runParser ParserK a m b
p2 ParseResult b -> Int -> Input a -> m (Step a m r)
k Int
n1 Int
s Input a
input
            k1 (Failure Int
n1 String
e) Int
s Input a
input = ParseResult b -> Int -> Input a -> m (Step a m r)
k (forall b. Int -> String -> ParseResult b
Failure Int
n1 String
e) Int
s Input a
input
        in forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> Input a -> m (Step a m r))
   -> Int -> Int -> Input a -> m (Step a m r)
runParser ParserK a m a
p1 forall {b}. ParseResult b -> Int -> Input a -> m (Step a m r)
k1 Int
n Int
st Input a
arr

    {-# 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 a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> Input a -> m (Step a m r))
 -> Int -> Int -> Input a -> m (Step a m r))
-> ParserK a m b
MkParser forall a b. (a -> b) -> a -> b
$ \ParseResult a -> Int -> Input a -> m (Step a m r)
k Int
n Int
st Input a
arr ->
        let k1 :: ParseResult a -> Int -> Input a -> m (Step a m r)
k1 (Success Int
n1 a
b) Int
s1 Input a
input =
                let k2 :: ParseResult b -> Int -> Input a -> m (Step a m r)
k2 (Success Int
n2 b
_) Int
s2 Input a
input2  = ParseResult a -> Int -> Input a -> m (Step a m r)
k (forall b. Int -> b -> ParseResult b
Success Int
n2 a
b) Int
s2 Input a
input2
                    k2 (Failure Int
n2 String
e) Int
s2 Input a
input2  = ParseResult a -> Int -> Input a -> m (Step a m r)
k (forall b. Int -> String -> ParseResult b
Failure Int
n2 String
e) Int
s2 Input a
input2
                in forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> Input a -> m (Step a m r))
   -> Int -> Int -> Input a -> m (Step a m r)
runParser ParserK a m b
p2 forall {b}. ParseResult b -> Int -> Input a -> m (Step a m r)
k2 Int
n1 Int
s1 Input a
input
            k1 (Failure Int
n1 String
e) Int
s1 Input a
input = ParseResult a -> Int -> Input a -> m (Step a m r)
k (forall b. Int -> String -> ParseResult b
Failure Int
n1 String
e) Int
s1 Input a
input
        in forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> Input a -> m (Step a m r))
   -> Int -> Int -> Input a -> m (Step a m r)
runParser ParserK a m a
p1 ParseResult a -> Int -> Input a -> m (Step a m r)
k1 Int
n Int
st Input a
arr

    {-# 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 = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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 a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> Input a -> m (Step a m r))
 -> Int -> Int -> Input a -> m (Step a m r))
-> ParserK a m b
MkParser (\ParseResult b -> Int -> Input a -> m (Step a m r)
k Int
n Int
st Input a
arr -> ParseResult b -> Int -> Input a -> m (Step a m r)
k (forall b. Int -> String -> ParseResult b
Failure Int
n String
err) Int
st Input a
arr)

-- | 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 = 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 a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> Input a -> m (Step a m r))
 -> Int -> Int -> Input a -> m (Step a m r))
-> ParserK a m b
MkParser forall a b. (a -> b) -> a -> b
$ \ParseResult b -> Int -> Input a -> m (Step a m r)
k Int
n Int
st Input a
arr ->
        let k1 :: ParseResult a -> Int -> Input a -> m (Step a m r)
k1 (Success Int
n1 a
b) Int
s1 Input a
inp = forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> Input a -> m (Step a m r))
   -> Int -> Int -> Input a -> m (Step a m r)
runParser (a -> ParserK a m b
f a
b) ParseResult b -> Int -> Input a -> m (Step a m r)
k Int
n1 Int
s1 Input a
inp
            k1 (Failure Int
n1 String
e) Int
s1 Input a
inp = ParseResult b -> Int -> Input a -> m (Step a m r)
k (forall b. Int -> String -> ParseResult b
Failure Int
n1 String
e) Int
s1 Input a
inp
         in forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> Input a -> m (Step a m r))
   -> Int -> Int -> Input a -> m (Step a m r)
runParser ParserK a m a
p ParseResult a -> Int -> Input a -> m (Step a m r)
k1 Int
n Int
st Input a
arr

    {-# INLINE (>>) #-}
    >> :: 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 = 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 = forall (m :: * -> *) b a. Monad m => m b -> ParserK a m b
fromEffect forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> Input a -> m (Step a m r))
 -> Int -> Int -> Input a -> m (Step a m r))
-> ParserK a m b
MkParser forall a b. (a -> b) -> a -> b
$ \ParseResult a -> Int -> Input a -> m (Step a m r)
k Int
n Int
_ Input a
arr ->
        let
            k1 :: ParseResult a -> Int -> Input a -> m (Step a m r)
k1 (Failure Int
pos String
_) Int
used Input a
input = forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> Input a -> m (Step a m r))
   -> Int -> Int -> Input a -> m (Step a m r)
runParser ParserK a m a
p2 ParseResult a -> Int -> Input a -> m (Step a m r)
k (Int
pos forall a. Num a => a -> a -> a
- Int
used) Int
0 Input a
input
            k1 ParseResult a
success Int
_ Input a
input = ParseResult a -> Int -> Input a -> m (Step a m r)
k ParseResult a
success Int
0 Input a
input
        in forall a (m :: * -> *) b.
ParserK a m b
-> forall r.
   (ParseResult b -> Int -> Input a -> m (Step a m r))
   -> Int -> Int -> Input a -> m (Step a m r)
runParser ParserK a m a
p1 ParseResult a -> Int -> Input a -> m (Step a m r)
k1 Int
n Int
0 Input a
arr

    -- 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        some_v :: ParserK a m [a]
some_v = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserK a m a
v 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        some_v :: ParserK a m [a]
some_v = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserK a m a
v 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 = 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 = 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 (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 (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 forall a. Ord a => a -> a -> Bool
>= Int
0
         then SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC (Int
start forall a. Num a => a -> a -> a
+ Int
offset forall a. Num a => a -> a -> a
* SIZE_OF(a)) state
         else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) r.
Int -> (Input a -> m (Step 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 =
            forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
<= 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 (forall b. Int -> b -> ParseResult b
Success Int
n b
b) (Int
count forall a. Num a => a -> a -> a
+ Int
n forall a. Num a => a -> a -> a
- Int
offset) (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 =
            forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n forall a. Ord a => a -> a -> Bool
>= forall a. Unbox a => Array a -> Int
Array.length Array a
arr)
                (forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Num a => a -> a -> a
+ Int
n forall a. Num a => a -> a -> a
- Int
offset) s
pst1))

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

        {-# INLINE onContinue #-}
        onContinue :: Int -> s -> m (Step (Array a) m r)
onContinue = forall {m :: * -> *} {a}.
Monad m =>
(Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a)
-> Int -> s -> m a
callParseCont forall a (m :: * -> *) r.
Int -> (Input a -> m (Step 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 (forall b. Int -> String -> ParseResult b
Failure Int
n String
err) (Int
count forall a. Num a => a -> a -> a
+ Int
n forall a. Num a => a -> a -> a
- Int
offset) (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 forall a. Num a => a -> a -> a
- Int
start
             in if Int
pos 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 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 forall a. Ord a => a -> a -> Bool
>= Int
end =
            Int -> s -> m (Step (Array a) m r)
onContinue ((Int
end forall a. Num a => a -> a -> a
- Int
start) forall a. Integral a => a -> a -> a
`div` SIZE_OF(a))  pst
        go !SPEC
_ !Int
cur !s
pst = do
            let !x :: a
x = forall a. IO a -> a
unsafeInlineIO forall a b. (a -> b) -> a -> b
$ 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 forall a. Num a => a -> a -> a
- Int
n forall a. Num a => a -> a -> a
* Int
elemSize
                curOff :: Int
curOff = (Int
cur forall a. Num a => a -> a -> a
- Int
start) forall a. Integral a => a -> a -> a
`div` Int
elemSize
                nextOff :: Int
nextOff = (Int
next forall a. Num a => a -> a -> a
- Int
start) 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 forall a. Num a => a -> a -> a
- Int
start) 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 ->
                forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
>= Int
0)
                    (ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (forall b. Int -> b -> ParseResult b
Success (- Int
n) b
b) (Int
count forall a. Num a => a -> a -> a
- Int
n) forall a. Input a
None)
            ParserD.Continue Int
n s
pst1 ->
                forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
>= Int
0)
                    (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) r.
Int -> (Input a -> m (Step a m r)) -> Step a m r
Continue (- Int
n) (Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont (Int
count 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 (forall b. Int -> String -> ParseResult b
Failure Int
0 String
err) Int
count forall a. Input a
None
            ParserD.Partial Int
_ s
_ -> 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 a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> Input a -> m (Step a m r))
 -> Int -> Int -> Input a -> m (Step a m r))
-> ParserK a m b
MkParser forall a b. (a -> b) -> a -> b
$ 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
            -- XXX can we come here with relPos 1?
            if Int
relPos forall a. Eq a => a -> a -> Bool
== Int
0
            then
                case Input a
input of
                    Chunk a
arr -> Int -> s -> a -> m (Step a m r)
parseContChunk Int
usedCount s
pst a
arr
                    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 forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) r.
Int -> (Input a -> m (Step 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 (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 (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
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
            case Step s b
pRes of
                ParserD.Done Int
0 b
b ->
                    ParseResult b -> Int -> Input a -> m (Step a m r)
cont (forall b. Int -> b -> ParseResult b
Success Int
1 b
b) (Int
count forall a. Num a => a -> a -> a
+ Int
1) (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 (forall b. Int -> b -> ParseResult b
Success Int
0 b
b) Int
count (forall a. a -> Input a
Chunk a
x)
                ParserD.Done Int
n b
b ->
                    ParseResult b -> Int -> Input a -> m (Step a m r)
cont (forall b. Int -> b -> ParseResult b
Success (Int
1 forall a. Num a => a -> a -> a
- Int
n) b
b) (Int
count forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
- Int
n) (forall a. a -> Input a
Chunk a
x)
                ParserD.Partial Int
0 s
pst1 ->
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) r.
Int -> (Input a -> m (Step a m r)) -> Step a m r
Partial Int
1 (Int -> s -> Input a -> m (Step a m r)
parseCont (Int
count forall a. Num a => a -> a -> a
+ Int
1) s
pst1)
                ParserD.Partial Int
1 s
pst1 ->
                    -- XXX Since we got Partial, the driver should drop the
                    -- buffer, we should call the driver here?
                    SPEC -> s -> m (Step a m r)
go SPEC
SPEC s
pst1
                ParserD.Partial Int
n s
pst1 ->
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) r.
Int -> (Input a -> m (Step a m r)) -> Step a m r
Partial (Int
1 forall a. Num a => a -> a -> a
- Int
n) (Int -> s -> Input a -> m (Step a m r)
parseCont (Int
count forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
- Int
n) s
pst1)
                ParserD.Continue Int
0 s
pst1 ->
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) r.
Int -> (Input a -> m (Step a m r)) -> Step a m r
Continue Int
1 (Int -> s -> Input a -> m (Step a m r)
parseCont (Int
count forall a. Num a => a -> a -> a
+ Int
1) s
pst1)
                ParserD.Continue Int
1 s
pst1 ->
                    SPEC -> s -> m (Step a m r)
go SPEC
SPEC s
pst1
                ParserD.Continue Int
n s
pst1 ->
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) r.
Int -> (Input a -> m (Step a m r)) -> Step a m r
Continue (Int
1 forall a. Num a => a -> a -> a
- Int
n) (Int -> s -> Input a -> m (Step a m r)
parseCont (Int
count forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
- Int
n) s
pst1)
                ParserD.Error String
err ->
                    -- XXX fix undefined
                    ParseResult b -> Int -> Input a -> m (Step a m r)
cont (forall b. Int -> String -> ParseResult b
Failure Int
0 String
err) Int
count (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 array.
            ParserD.Done Int
n b
b ->
                forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
>= Int
0)
                    (ParseResult b -> Int -> Input a -> m (Step a m r)
cont (forall b. Int -> b -> ParseResult b
Success (- Int
n) b
b) (Int
count forall a. Num a => a -> a -> a
- Int
n) forall a. Input a
None)
            ParserD.Continue Int
n s
pst1 ->
                forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
>= Int
0)
                    (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) r.
Int -> (Input a -> m (Step a m r)) -> Step a m r
Continue (- Int
n) (Int -> s -> Input a -> m (Step a m r)
parseCont (Int
count 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 a -> m (Step a m r)
cont (forall b. Int -> String -> ParseResult b
Failure Int
0 String
err) Int
count forall a. Input a
None
            ParserD.Partial Int
_ s
_ -> 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 a -> m (Step a m r)
parseCont !Int
cnt !s
pst (Chunk a
arr) = Int -> s -> a -> m (Step a m r)
parseContChunk Int
cnt s
pst a
arr
    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 a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> Input a -> m (Step a m r))
 -> Int -> Int -> Input a -> m (Step a m r))
-> ParserK a m b
MkParser forall a b. (a -> b) -> a -> b
$ 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 (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 (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
len) = do
         if Int
offset forall a. Ord a => a -> a -> Bool
>= Int
0
         then SPEC -> Int -> s -> m (Step (Array a) m r)
go SPEC
SPEC (Int
start forall a. Num a => a -> a -> a
+ Int
offset) s
state
         else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) r.
Int -> (Input a -> m (Step 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 end #-}
        end :: Int
end = Int
start forall a. Num a => a -> a -> a
+ Int
len

        {-# INLINE onDone #-}
        onDone :: Int -> b -> m (Step (Array a) m r)
onDone Int
n b
b =
            forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
<= forall a. Array a -> Int
GenArr.length Array a
arr)
                (ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (forall b. Int -> b -> ParseResult b
Success Int
n b
b) (Int
count forall a. Num a => a -> a -> a
+ Int
n forall a. Num a => a -> a -> a
- Int
offset) (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 =
            forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n forall a. Ord a => a -> a -> Bool
>= forall a. Array a -> Int
GenArr.length Array a
arr)
                (forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Num a => a -> a -> a
+ Int
n forall a. Num a => a -> a -> a
- Int
offset) s
pst1))

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

        {-# INLINE onContinue #-}
        onContinue :: Int -> s -> m (Step (Array a) m r)
onContinue = forall {m :: * -> *} {a}.
Monad m =>
(Int -> (Input (Array a) -> m (Step (Array a) m r)) -> a)
-> Int -> s -> m a
callParseCont forall a (m :: * -> *) r.
Int -> (Input a -> m (Step 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 (forall b. Int -> String -> ParseResult b
Failure Int
n String
err) (Int
count forall a. Num a => a -> a -> a
+ Int
n forall a. Num a => a -> a -> a
- Int
offset) (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 forall a. Num a => a -> a -> a
- Int
start
             in if Int
pos 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 forall a. Ord a => a -> a -> Bool
>= Int
end =
            Int -> s -> m (Step (Array a) m r)
onContinue Int
len  s
pst
        go !SPEC
_ !Int
cur !s
pst = do
            let !x :: a
x = forall a. IO a -> a
unsafeInlineIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadIO m =>
MutableArray# RealWorld a -> Int -> m a
GenArr.getIndexUnsafeWith 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 forall a. Num a => a -> a -> a
+ Int
1
                back :: Int -> Int
back Int
n = Int
next forall a. Num a => a -> a -> a
- Int
n
                curOff :: Int
curOff = Int
cur forall a. Num a => a -> a -> a
- Int
start
                nextOff :: Int
nextOff = Int
next 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 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 ->
                forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
>= Int
0)
                    (ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r)
cont (forall b. Int -> b -> ParseResult b
Success (- Int
n) b
b) (Int
count forall a. Num a => a -> a -> a
- Int
n) forall a. Input a
None)
            ParserD.Continue Int
n s
pst1 ->
                forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
>= Int
0)
                    (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) r.
Int -> (Input a -> m (Step a m r)) -> Step a m r
Continue (- Int
n) (Int -> s -> Input (Array a) -> m (Step (Array a) m r)
parseCont (Int
count 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 (forall b. Int -> String -> ParseResult b
Failure Int
0 String
err) Int
count forall a. Input a
None
            ParserD.Partial Int
_ s
_ -> 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 a (m :: * -> *) b.
(forall r.
 (ParseResult b -> Int -> Input a -> m (Step a m r))
 -> Int -> Int -> Input a -> m (Step a m r))
-> ParserK a m b
MkParser forall a b. (a -> b) -> a -> b
$ 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 (Success n b) _ None = return $ Done n b
parserDone (Failure n e) _ None = return $ Error n e
parserDone _ _ _ = error "Bug: toParser: called with input"

-- | 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 parser = ParserD.Parser step initial extract

    where

    initial = pure (ParserD.IPartial (\x -> runParser parser 0 0 x parserDone))

    step cont a = do
        r <- cont (Single a)
        return $ case r of
            Done n b -> ParserD.Done n b
            Error _ e -> ParserD.Error e
            Partial n cont1 -> ParserD.Partial n cont1
            Continue n cont1 -> ParserD.Continue n cont1

    extract cont = do
        r <- cont None
        case r of
            Done n b -> return $ ParserD.Done n b
            Error _ e -> return $ ParserD.Error e
            Partial _ cont1 -> extract cont1
            Continue n cont1 -> return $ ParserD.Continue n cont1

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