-- |
-- 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.Parser.ParserK.Type
    (
      Step (..)
    , Input (..)
    , ParseResult (..)
    , ParserK (..)
    , fromParser
    -- , toParser
    , fromPure
    , fromEffect
    , die
    )
where

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

import Control.Applicative (Alternative(..), liftA2)
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.Unboxed (peekWith, sizeOf, 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.Parser.ParserD.Type as ParserD

data Input a = None | Chunk {-# UNPACK #-} !(Array 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
      -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.
      -- measure if that works any better.
      -- Array a -> m (Step a m r), m (Step a m 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'.
           -- XXX Use Array a, determine eof by using a nil array
        -> Input a
        -> m (Step a m r)
    }

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

-- XXX rewrite this using ParserD, expose rmapM from ParserD.
-- | Maps a function over the output of the parser.
--
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

-- | 'Applicative' form of 'Streamly.Internal.Data.Parser.splitWith'. Note that
-- this operation does not fuse, use 'Streamly.Internal.Data.Parser.splitWith'
-- when fusion is important.
--
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 make the
-- future parses depend on the previously parsed values.
--
-- If we have to parse "a9" or "9a" but not "99" or "aa" we can use the
-- following parser:
--
-- @
-- backtracking :: MonadCatch m => PR.Parser Char m String
-- backtracking =
--     sequence [PR.satisfy isDigit, PR.satisfy isAlpha]
--     '<|>'
--     sequence [PR.satisfy isAlpha, PR.satisfy isDigit]
-- @
--
-- We know that if the first parse resulted in a digit at the first place then
-- the second parse is going to fail.  However, we waste that information and
-- parse the first character again in the second parse only to know that it is
-- not an alphabetic char.  By using lookbehind in a 'Monad' composition we can
-- avoid redundant work:
--
-- @
-- data DigitOrAlpha = Digit Char | Alpha Char
--
-- lookbehind :: MonadCatch m => PR.Parser Char m String
-- lookbehind = do
--     x1 \<-    Digit '<$>' PR.satisfy isDigit
--          '<|>' Alpha '<$>' PR.satisfy isAlpha
--
--     -- Note: the parse depends on what we parsed already
--     x2 <- case x1 of
--         Digit _ -> PR.satisfy isAlpha
--         Alpha _ -> PR.satisfy isDigit
--
--     return $ case x1 of
--         Digit x -> [x,x2]
--         Alpha x -> [x,x2]
-- @
--
-- See also 'Streamly.Internal.Data.Parser.concatMap'. This monad instance
-- does not fuse, use 'Streamly.Internal.Data.Parser.concatMap' when you need
-- fusion.
--
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
-------------------------------------------------------------------------------

-- | 'Alternative' form of 'Streamly.Internal.Data.Parser.alt'. Backtrack and
-- run the second parser if the first one fails.
--
-- The "some" and "many" operations of alternative accumulate results in a pure
-- list which is not scalable and streaming. Instead use
-- 'Streamly.Internal.Data.Parser.some' and
-- 'Streamly.Internal.Data.Parser.many' for fusible operations with composable
-- accumulation of results.
--
-- See also 'Streamly.Internal.Data.Parser.alt'. This 'Alternative' instance
-- does not fuse, use 'Streamly.Internal.Data.Parser.alt' when you need
-- fusion.
--
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
-------------------------------------------------------------------------------

{-# INLINE parseDToK #-}
parseDToK
    :: 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 a -> m (Step a m r))
    -> Int
    -> Int
    -> Input a
    -> m (Step a m r)
parseDToK :: 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 a -> m (Step a m r))
-> Int
-> Int
-> Input a
-> m (Step a m r)
parseDToK 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
offset0 !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
            case Input a
input of
                Chunk Array a
arr -> Int -> Int -> s -> Array a -> m (Step a m r)
parseContChunk Int
usedCount Int
offset0 s
pst Array a
arr
                Input a
None -> Int -> s -> m (Step a m r)
parseContNothing 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
offset0 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
offset0 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 -> Int -> s -> Array a -> m (Step a m r)
parseContChunk !Int
count !Int
offset !s
state arr :: Array a
arr@(Array MutableByteArray
contents Int
start Int
end) = do
         if Int
offset forall a. Ord a => a -> a -> Bool
>= Int
0
         then SPEC -> Int -> s -> m (Step 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 a -> m (Step a m r)
parseCont Int
count s
state)

        where

        {-# INLINE onDone #-}
        onDone :: Int -> b -> m (Step 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 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. Num a => a -> a -> a
- Int
offset) (forall a. Array a -> Input a
Chunk Array a
arr))

        {-# INLINE callParseCont #-}
        callParseCont :: (Int -> (Input a -> m (Step a m r)) -> a) -> Int -> s -> m a
callParseCont Int -> (Input a -> m (Step 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 a -> m (Step a m r)) -> a
constr Int
n (Int -> s -> Input a -> m (Step 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 a m r)
onPartial = forall {m :: * -> *} {a}.
Monad m =>
(Int -> (Input a -> m (Step 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 a m r)
onContinue = forall {m :: * -> *} {a}.
Monad m =>
(Int -> (Input a -> m (Step 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 a m r)
onError Int
n String
err =
            ParseResult b -> Int -> Input a -> m (Step 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. Array a -> Input a
Chunk Array a
arr)

        {-# INLINE onBack #-}
        onBack :: Int -> Int -> (Int -> s -> m (Step a m r)) -> s -> m (Step a m r)
onBack Int
offset1 Int
elemSize Int -> s -> m (Step 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 a m r)
go SPEC
SPEC Int
offset1 s
pst
                else Int -> s -> m (Step 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 a m r)
go !SPEC
_ !Int
cur !s
pst | Int
cur forall a. Ord a => a -> a -> Bool
>= Int
end =
            Int -> s -> m (Step 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 => MutableByteArray -> Int -> IO a
peekWith MutableByteArray
contents Int
cur
            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 a m r)
onDone Int
nextOff b
b
                ParserD.Done Int
1 b
b ->
                    Int -> b -> m (Step a m r)
onDone Int
curOff b
b
                ParserD.Done Int
n b
b ->
                    Int -> b -> m (Step 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 a m r)
go SPEC
SPEC Int
next s
pst1
                ParserD.Partial Int
1 s
pst1 ->
                    SPEC -> Int -> s -> m (Step a m r)
go SPEC
SPEC Int
cur s
pst1
                ParserD.Partial Int
n s
pst1 ->
                    Int -> Int -> (Int -> s -> m (Step a m r)) -> s -> m (Step a m r)
onBack (Int -> Int
back Int
n) Int
elemSize Int -> s -> m (Step a m r)
onPartial s
pst1
                ParserD.Continue Int
0 s
pst1 ->
                    SPEC -> Int -> s -> m (Step a m r)
go SPEC
SPEC Int
next s
pst1
                ParserD.Continue Int
1 s
pst1 ->
                    SPEC -> Int -> s -> m (Step a m r)
go SPEC
SPEC Int
cur s
pst1
                ParserD.Continue Int
n s
pst1 ->
                    Int -> Int -> (Int -> s -> m (Step a m r)) -> s -> m (Step a m r)
onBack (Int -> Int
back Int
n) Int
elemSize Int -> s -> m (Step a m r)
onContinue s
pst1
                ParserD.Error String
err ->
                    Int -> String -> m (Step a m r)
onError Int
curOff String
err

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

-- | Convert a raw byte 'Parser' to a chunked 'ParserK'.
--
-- /Pre-release/
--
{-# INLINE_LATE fromParser #-}
fromParser :: (Monad m, Unbox a) => ParserD.Parser a m b -> ParserK a m b
fromParser :: forall (m :: * -> *) a b.
(Monad m, Unbox a) =>
Parser a m b -> ParserK a m b
fromParser (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 a -> m (Step a m r))
-> Int
-> Int
-> Input a
-> m (Step a m r)
parseDToK 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

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