#include "inline.hs"

-- |
-- 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, sequenceA,
-- Monad, sequence, and Alternative, choice operations compared to the
-- quadratic complexity of the corresponding direct style operations. However,
-- direct style operations allow fusion with ~10x better performance than CPS.
--
-- The direct style representation does not allow for recursive definitions of
-- "some" and "many" whereas CPS allows that.

module Streamly.Internal.Data.Parser.ParserK.Type
    (
      Parser (..)
    , fromPure
    , fromEffect
    , die

    -- * Conversion
    , toParserK
    , fromParserK
    )
where

import Control.Applicative (Alternative(..), liftA2)
import Control.Exception (assert, Exception(..))
import Control.Monad (MonadPlus(..), ap)
import Control.Monad.Catch (MonadCatch, MonadThrow(..), try)
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
#if !(MIN_VERSION_base(4,10,0))
import Data.Semigroup ((<>))
#endif
import Streamly.Internal.Control.Exception

import qualified Streamly.Internal.Data.Parser.ParserD.Type as D

-- | The parse driver result. The driver may stop with a final result, pause
-- with a continuation to resume, or fail with an error.
--
-- /Pre-release/
--
data Driver m a r =
      Stop !Int r
      -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.
      -- measure if that works any better.
    | Partial !Int (Maybe a -> m (Driver m a r))
    | Continue !Int (Maybe a -> m (Driver m a r))
    | Failed String

instance Functor m => Functor (Driver m a) where
    fmap :: (a -> b) -> Driver m a a -> Driver m a b
fmap a -> b
f (Stop Int
n a
r) = Int -> b -> Driver m a b
forall (m :: * -> *) a r. Int -> r -> Driver m a r
Stop Int
n (a -> b
f a
r)
    fmap a -> b
f (Partial Int
n Maybe a -> m (Driver m a a)
yld) = Int -> (Maybe a -> m (Driver m a b)) -> Driver m a b
forall (m :: * -> *) a r.
Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
Partial Int
n ((Driver m a a -> Driver m a b)
-> m (Driver m a a) -> m (Driver m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Driver m a a -> Driver m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (m (Driver m a a) -> m (Driver m a b))
-> (Maybe a -> m (Driver m a a)) -> Maybe a -> m (Driver m a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> m (Driver m a a)
yld)
    fmap a -> b
f (Continue Int
n Maybe a -> m (Driver m a a)
yld) = Int -> (Maybe a -> m (Driver m a b)) -> Driver m a b
forall (m :: * -> *) a r.
Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
Continue Int
n ((Driver m a a -> Driver m a b)
-> m (Driver m a a) -> m (Driver m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Driver m a a -> Driver m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (m (Driver m a a) -> m (Driver m a b))
-> (Maybe a -> m (Driver m a a)) -> Maybe a -> m (Driver m a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> m (Driver m a a)
yld)
    fmap a -> b
_ (Failed String
e) = String -> Driver m a b
forall (m :: * -> *) a r. String -> Driver m a r
Failed String
e

-- The parser's result.
--
-- /Pre-release/
--
data Parse b =
      Done !Int !b      -- Done, no more input needed
    | Error !String     -- Failed

instance Functor Parse where
    fmap :: (a -> b) -> Parse a -> Parse b
fmap a -> b
f (Done Int
n a
b) = Int -> b -> Parse b
forall b. Int -> b -> Parse b
Done Int
n (a -> b
f a
b)
    fmap a -> b
_ (Error String
e) = String -> Parse b
forall b. String -> Parse b
Error String
e

-- | A continuation passing style parser representation.
newtype Parser m a b = MkParser
    { Parser m a b
-> forall r.
   Int
   -> (Int, Int)
   -> ((Int, Int) -> Parse b -> m (Driver m a r))
   -> m (Driver m a r)
runParser :: forall r.
           -- The number of elements that were not used by the previous
           -- consumer and should be carried forward.
           Int
           -- (nesting level, used elem count). Nesting level is increased
           -- whenever we enter an Alternative composition and decreased when
           -- it is done. The used element count is a count of elements
           -- consumed by the Alternative. If the Alternative fails we need to
           -- backtrack by this amount.
           --
           -- The nesting level is used in parseDToK to optimize the case when
           -- we are not in an alternative, in that case we do not need to
           -- maintain the element count for backtracking.
        -> (Int, Int)
           -- The first argument is the (nest level, used count) tuple as
           -- described above. The leftover element count is carried as part of
           -- 'Done' constructor of 'Parse'.
        -> ((Int, Int) -> Parse b -> m (Driver m a r))
        -> m (Driver m a r)
    }

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

-- XXX Unlike the direct style folds/parsers, the initial action in CPS parsers
-- is not performed when the fold is initialized. It is performed when the
-- first element is processed by the fold or if no elements are processed then
-- at the extraction. We should either make the direct folds like this or make
-- the CPS folds behavior also like the direct ones.
--
-- | Convert a direct style parser ('D.Parser') to a CPS style parser
-- ('Parser').
--
{-# INLINE_NORMAL parseDToK #-}
parseDToK
    :: MonadCatch m
    => (s -> a -> m (D.Step s b))
    -> m (D.Initial s b)
    -> (s -> m b)
    -> Int
    -> (Int, Int)
    -> ((Int, Int) -> Parse b -> m (Driver m a r))
    -> m (Driver m a r)

parseDToK :: (s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m b)
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse b -> m (Driver m a r))
-> m (Driver m a r)
parseDToK s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m b
extract Int
leftover (Int
0, Int
_) (Int, Int) -> Parse b -> m (Driver m a r)
cont = do
    Initial s b
res <- m (Initial s b)
initial
    case Initial s b
res of
        D.IPartial s
r -> Driver m a r -> m (Driver m a r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Driver m a r -> m (Driver m a r))
-> Driver m a r -> m (Driver m a r)
forall a b. (a -> b) -> a -> b
$ Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
forall (m :: * -> *) a r.
Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
Continue Int
leftover (m s -> Maybe a -> m (Driver m a r)
parseCont (s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return s
r))
        D.IDone b
b -> (Int, Int) -> Parse b -> m (Driver m a r)
cont (Int
0,Int
0) (Int -> b -> Parse b
forall b. Int -> b -> Parse b
Done Int
0 b
b)
        D.IError String
err -> (Int, Int) -> Parse b -> m (Driver m a r)
cont (Int
0,Int
0) (String -> Parse b
forall b. String -> Parse b
Error String
err)

    where

    parseCont :: m s -> Maybe a -> m (Driver m a r)
parseCont m s
pst (Just a
x) = do
        s
r <- m s
pst
        Step s b
pRes <- s -> a -> m (Step s b)
pstep s
r a
x
        case Step s b
pRes of
            D.Done Int
n b
b -> (Int, Int) -> Parse b -> m (Driver m a r)
cont (Int
0,Int
0) (Int -> b -> Parse b
forall b. Int -> b -> Parse b
Done Int
n b
b)
            D.Error String
err -> (Int, Int) -> Parse b -> m (Driver m a r)
cont (Int
0,Int
0) (String -> Parse b
forall b. String -> Parse b
Error String
err)
            D.Partial Int
n s
pst1 -> Driver m a r -> m (Driver m a r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Driver m a r -> m (Driver m a r))
-> Driver m a r -> m (Driver m a r)
forall a b. (a -> b) -> a -> b
$ Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
forall (m :: * -> *) a r.
Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
Partial Int
n (m s -> Maybe a -> m (Driver m a r)
parseCont (s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return s
pst1))
            D.Continue Int
n s
pst1 -> Driver m a r -> m (Driver m a r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Driver m a r -> m (Driver m a r))
-> Driver m a r -> m (Driver m a r)
forall a b. (a -> b) -> a -> b
$ Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
forall (m :: * -> *) a r.
Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
Continue Int
n (m s -> Maybe a -> m (Driver m a r)
parseCont (s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return s
pst1))

    parseCont m s
acc Maybe a
Nothing = do
        s
pst <- m s
acc
        Either ParseError b
r <- m b -> m (Either ParseError b)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m b -> m (Either ParseError b)) -> m b -> m (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ s -> m b
extract s
pst
        case Either ParseError b
r of
            Left (ParseError
e :: D.ParseError) -> (Int, Int) -> Parse b -> m (Driver m a r)
cont (Int
0,Int
0) (String -> Parse b
forall b. String -> Parse b
Error (ParseError -> String
forall e. Exception e => e -> String
displayException ParseError
e))
            Right b
b -> (Int, Int) -> Parse b -> m (Driver m a r)
cont (Int
0,Int
0) (Int -> b -> Parse b
forall b. Int -> b -> Parse b
Done Int
0 b
b)

parseDToK s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m b
extract Int
leftover (Int
level, Int
count) (Int, Int) -> Parse b -> m (Driver m a r)
cont = do
    Initial s b
res <- m (Initial s b)
initial
    case Initial s b
res of
        D.IPartial s
r -> Driver m a r -> m (Driver m a r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Driver m a r -> m (Driver m a r))
-> Driver m a r -> m (Driver m a r)
forall a b. (a -> b) -> a -> b
$ Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
forall (m :: * -> *) a r.
Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
Continue Int
leftover (Int -> m s -> Maybe a -> m (Driver m a r)
parseCont Int
count (s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return s
r))
        D.IDone b
b -> (Int, Int) -> Parse b -> m (Driver m a r)
cont (Int
level,Int
count) (Int -> b -> Parse b
forall b. Int -> b -> Parse b
Done Int
0 b
b)
        D.IError String
err -> (Int, Int) -> Parse b -> m (Driver m a r)
cont (Int
level,Int
count) (String -> Parse b
forall b. String -> Parse b
Error String
err)

    where

    parseCont :: Int -> m s -> Maybe a -> m (Driver m a r)
parseCont !Int
cnt m s
pst (Just a
x) = do
        let !cnt1 :: Int
cnt1 = Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        s
r <- m s
pst
        Step s b
pRes <- s -> a -> m (Step s b)
pstep s
r a
x
        case Step s b
pRes of
            D.Done Int
n b
b -> do
                Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cnt1) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                (Int, Int) -> Parse b -> m (Driver m a r)
cont (Int
level, Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (Int -> b -> Parse b
forall b. Int -> b -> Parse b
Done Int
n b
b)
            D.Error String
err ->
                (Int, Int) -> Parse b -> m (Driver m a r)
cont (Int
level, Int
cnt1) (String -> Parse b
forall b. String -> Parse b
Error String
err)
            D.Partial Int
n s
pst1 -> do
                Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cnt1) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                Driver m a r -> m (Driver m a r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Driver m a r -> m (Driver m a r))
-> Driver m a r -> m (Driver m a r)
forall a b. (a -> b) -> a -> b
$ Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
forall (m :: * -> *) a r.
Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
Partial Int
n (Int -> m s -> Maybe a -> m (Driver m a r)
parseCont (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return s
pst1))
            D.Continue Int
n s
pst1 -> do
                Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cnt1) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                Driver m a r -> m (Driver m a r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Driver m a r -> m (Driver m a r))
-> Driver m a r -> m (Driver m a r)
forall a b. (a -> b) -> a -> b
$ Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
forall (m :: * -> *) a r.
Int -> (Maybe a -> m (Driver m a r)) -> Driver m a r
Continue Int
n (Int -> m s -> Maybe a -> m (Driver m a r)
parseCont (Int
cnt1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return s
pst1))
    parseCont Int
cnt m s
acc Maybe a
Nothing = do
        s
pst <- m s
acc
        Either ParseError b
r <- m b -> m (Either ParseError b)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m b -> m (Either ParseError b)) -> m b -> m (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ s -> m b
extract s
pst
        let s :: (Int, Int)
s = (Int
level, Int
cnt)
        case Either ParseError b
r of
            Left (ParseError
e :: D.ParseError) -> (Int, Int) -> Parse b -> m (Driver m a r)
cont (Int, Int)
s (String -> Parse b
forall b. String -> Parse b
Error (ParseError -> String
forall e. Exception e => e -> String
displayException ParseError
e))
            Right b
b -> (Int, Int) -> Parse b -> m (Driver m a r)
cont (Int, Int)
s (Int -> b -> Parse b
forall b. Int -> b -> Parse b
Done Int
0 b
b)

-- | Convert a direct style 'D.Parser' to a CPS style 'Parser'.
--
-- /Pre-release/
--
{-# INLINE_LATE toParserK #-}
toParserK :: MonadCatch m => D.Parser m a b -> Parser m a b
toParserK :: Parser m a b -> Parser m a b
toParserK (D.Parser s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m b
extract) =
    (forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
forall (m :: * -> *) a b.
(forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
MkParser ((forall r.
  Int
  -> (Int, Int)
  -> ((Int, Int) -> Parse b -> m (Driver m a r))
  -> m (Driver m a r))
 -> Parser m a b)
-> (forall r.
    Int
    -> (Int, Int)
    -> ((Int, Int) -> Parse b -> m (Driver m a r))
    -> m (Driver m a r))
-> Parser m a b
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m b)
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse b -> m (Driver m a r))
-> m (Driver m a r)
forall (m :: * -> *) s a b r.
MonadCatch m =>
(s -> a -> m (Step s b))
-> m (Initial s b)
-> (s -> m b)
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse b -> m (Driver m a r))
-> m (Driver m a r)
parseDToK s -> a -> m (Step s b)
step m (Initial s b)
initial s -> m 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 => (Int, Int) -> Parse b -> m (Driver m a b)
parserDone :: (Int, Int) -> Parse b -> m (Driver m a b)
parserDone (Int
0,Int
_) (Done Int
n b
b) = Driver m a b -> m (Driver m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Driver m a b -> m (Driver m a b))
-> Driver m a b -> m (Driver m a b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Driver m a b
forall (m :: * -> *) a r. Int -> r -> Driver m a r
Stop Int
n b
b
parserDone (Int, Int)
st (Done Int
_ b
_) =
    String -> m (Driver m a b)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Driver m a b)) -> String -> m (Driver m a b)
forall a b. (a -> b) -> a -> b
$ String
"Bug: fromParserK: inside alternative: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int, Int)
st
parserDone (Int, Int)
_ (Error String
e) = Driver m a b -> m (Driver m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Driver m a b -> m (Driver m a b))
-> Driver m a b -> m (Driver m a b)
forall a b. (a -> b) -> a -> b
$ String -> Driver m a b
forall (m :: * -> *) a r. String -> Driver m a r
Failed String
e

-- | When there is no more input to feed, extract the result from the Parser.
--
-- /Pre-release/
--
extractParse :: MonadThrow m => (Maybe a -> m (Driver m a b)) -> m b
extractParse :: (Maybe a -> m (Driver m a b)) -> m b
extractParse Maybe a -> m (Driver m a b)
cont = do
    Driver m a b
r <- Maybe a -> m (Driver m a b)
cont Maybe a
forall a. Maybe a
Nothing
    case Driver m a b
r of
        Stop Int
_ b
b -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
        Partial Int
_ Maybe a -> m (Driver m a b)
_ -> String -> m b
forall a. (?callStack::CallStack) => String -> a
error String
"Bug: extractParse got Partial"
        Continue Int
_ Maybe a -> m (Driver m a b)
cont1 -> (Maybe a -> m (Driver m a b)) -> m b
forall (m :: * -> *) a b.
MonadThrow m =>
(Maybe a -> m (Driver m a b)) -> m b
extractParse Maybe a -> m (Driver m a b)
cont1
        Failed String
e -> ParseError -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ String -> ParseError
D.ParseError String
e

data FromParserK b c = FPKDone !Int !b | FPKCont c

-- | Convert a CPS style 'Parser' to a direct style 'D.Parser'.
--
-- "initial" returns a continuation which can be called one input at a time
-- using the "step" function.
--
-- /Pre-release/
--
{-# INLINE_LATE fromParserK #-}
fromParserK :: MonadThrow m => Parser m a b -> D.Parser m a b
fromParserK :: Parser m a b -> Parser m a b
fromParserK Parser m a b
parser = (FromParserK b (Maybe a -> m (Driver m a b))
 -> a -> m (Step (FromParserK b (Maybe a -> m (Driver m a b))) b))
-> m (Initial (FromParserK b (Maybe a -> m (Driver m a b))) b)
-> (FromParserK b (Maybe a -> m (Driver m a b)) -> m b)
-> Parser m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
D.Parser FromParserK b (Maybe a -> m (Driver m a b))
-> a -> m (Step (FromParserK b (Maybe a -> m (Driver m a b))) b)
forall (m :: * -> *) b a (m :: * -> *) a b.
Monad m =>
FromParserK b (Maybe a -> m (Driver m a b))
-> a -> m (Step (FromParserK b (Maybe a -> m (Driver m a b))) b)
step m (Initial (FromParserK b (Maybe a -> m (Driver m a b))) b)
forall b.
m (Initial (FromParserK b (Maybe a -> m (Driver m a b))) b)
initial FromParserK b (Maybe a -> m (Driver m a b)) -> m b
forall (m :: * -> *) a a.
MonadThrow m =>
FromParserK a (Maybe a -> m (Driver m a a)) -> m a
extract

    where

    initial :: m (Initial (FromParserK b (Maybe a -> m (Driver m a b))) b)
initial = do
        Driver m a b
r <- Parser m a b
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse b -> m (Driver m a b))
-> m (Driver m a b)
forall (m :: * -> *) a b.
Parser m a b
-> forall r.
   Int
   -> (Int, Int)
   -> ((Int, Int) -> Parse b -> m (Driver m a r))
   -> m (Driver m a r)
runParser Parser m a b
parser Int
0 (Int
0,Int
0) (Int, Int) -> Parse b -> m (Driver m a b)
forall (m :: * -> *) b a.
Monad m =>
(Int, Int) -> Parse b -> m (Driver m a b)
parserDone
        Initial (FromParserK b (Maybe a -> m (Driver m a b))) b
-> m (Initial (FromParserK b (Maybe a -> m (Driver m a b))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (FromParserK b (Maybe a -> m (Driver m a b))) b
 -> m (Initial (FromParserK b (Maybe a -> m (Driver m a b))) b))
-> Initial (FromParserK b (Maybe a -> m (Driver m a b))) b
-> m (Initial (FromParserK b (Maybe a -> m (Driver m a b))) b)
forall a b. (a -> b) -> a -> b
$ case Driver m a b
r of
            Stop Int
n b
b -> FromParserK b (Maybe a -> m (Driver m a b))
-> Initial (FromParserK b (Maybe a -> m (Driver m a b))) b
forall s b. s -> Initial s b
D.IPartial (FromParserK b (Maybe a -> m (Driver m a b))
 -> Initial (FromParserK b (Maybe a -> m (Driver m a b))) b)
-> FromParserK b (Maybe a -> m (Driver m a b))
-> Initial (FromParserK b (Maybe a -> m (Driver m a b))) b
forall a b. (a -> b) -> a -> b
$ Int -> b -> FromParserK b (Maybe a -> m (Driver m a b))
forall b c. Int -> b -> FromParserK b c
FPKDone Int
n b
b
            Failed String
e -> String -> Initial (FromParserK b (Maybe a -> m (Driver m a b))) b
forall s b. String -> Initial s b
D.IError String
e
            Partial Int
_ Maybe a -> m (Driver m a b)
cont -> FromParserK b (Maybe a -> m (Driver m a b))
-> Initial (FromParserK b (Maybe a -> m (Driver m a b))) b
forall s b. s -> Initial s b
D.IPartial (FromParserK b (Maybe a -> m (Driver m a b))
 -> Initial (FromParserK b (Maybe a -> m (Driver m a b))) b)
-> FromParserK b (Maybe a -> m (Driver m a b))
-> Initial (FromParserK b (Maybe a -> m (Driver m a b))) b
forall a b. (a -> b) -> a -> b
$ (Maybe a -> m (Driver m a b))
-> FromParserK b (Maybe a -> m (Driver m a b))
forall b c. c -> FromParserK b c
FPKCont Maybe a -> m (Driver m a b)
cont -- XXX can we get this?
            Continue Int
_ Maybe a -> m (Driver m a b)
cont -> FromParserK b (Maybe a -> m (Driver m a b))
-> Initial (FromParserK b (Maybe a -> m (Driver m a b))) b
forall s b. s -> Initial s b
D.IPartial (FromParserK b (Maybe a -> m (Driver m a b))
 -> Initial (FromParserK b (Maybe a -> m (Driver m a b))) b)
-> FromParserK b (Maybe a -> m (Driver m a b))
-> Initial (FromParserK b (Maybe a -> m (Driver m a b))) b
forall a b. (a -> b) -> a -> b
$ (Maybe a -> m (Driver m a b))
-> FromParserK b (Maybe a -> m (Driver m a b))
forall b c. c -> FromParserK b c
FPKCont Maybe a -> m (Driver m a b)
cont

    -- Note, we can only reach FPKDone and FPKError from "initial". FPKCont
    -- always transitions to only FPKCont.  The input remains unconsumed in
    -- this case so we use "n + 1".
    step :: FromParserK b (Maybe a -> m (Driver m a b))
-> a -> m (Step (FromParserK b (Maybe a -> m (Driver m a b))) b)
step (FPKDone Int
n b
b) a
_ = do
        Bool -> m ()
forall (f :: * -> *). Applicative f => Bool -> f ()
assertM (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
        Step (FromParserK b (Maybe a -> m (Driver m a b))) b
-> m (Step (FromParserK b (Maybe a -> m (Driver m a b))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromParserK b (Maybe a -> m (Driver m a b))) b
 -> m (Step (FromParserK b (Maybe a -> m (Driver m a b))) b))
-> Step (FromParserK b (Maybe a -> m (Driver m a b))) b
-> m (Step (FromParserK b (Maybe a -> m (Driver m a b))) b)
forall a b. (a -> b) -> a -> b
$ Int -> b -> Step (FromParserK b (Maybe a -> m (Driver m a b))) b
forall s b. Int -> b -> Step s b
D.Done (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) b
b
    step (FPKCont Maybe a -> m (Driver m a b)
cont) a
a = do
        Driver m a b
r <- Maybe a -> m (Driver m a b)
cont (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
        Step (FromParserK b (Maybe a -> m (Driver m a b))) b
-> m (Step (FromParserK b (Maybe a -> m (Driver m a b))) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FromParserK b (Maybe a -> m (Driver m a b))) b
 -> m (Step (FromParserK b (Maybe a -> m (Driver m a b))) b))
-> Step (FromParserK b (Maybe a -> m (Driver m a b))) b
-> m (Step (FromParserK b (Maybe a -> m (Driver m a b))) b)
forall a b. (a -> b) -> a -> b
$ case Driver m a b
r of
            Stop Int
n b
b -> Int -> b -> Step (FromParserK b (Maybe a -> m (Driver m a b))) b
forall s b. Int -> b -> Step s b
D.Done Int
n b
b
            Failed String
e -> String -> Step (FromParserK b (Maybe a -> m (Driver m a b))) b
forall s b. String -> Step s b
D.Error String
e
            Partial Int
n Maybe a -> m (Driver m a b)
cont1 -> Int
-> FromParserK b (Maybe a -> m (Driver m a b))
-> Step (FromParserK b (Maybe a -> m (Driver m a b))) b
forall s b. Int -> s -> Step s b
D.Partial Int
n ((Maybe a -> m (Driver m a b))
-> FromParserK b (Maybe a -> m (Driver m a b))
forall b c. c -> FromParserK b c
FPKCont Maybe a -> m (Driver m a b)
cont1)
            Continue Int
n Maybe a -> m (Driver m a b)
cont1 -> Int
-> FromParserK b (Maybe a -> m (Driver m a b))
-> Step (FromParserK b (Maybe a -> m (Driver m a b))) b
forall s b. Int -> s -> Step s b
D.Continue Int
n ((Maybe a -> m (Driver m a b))
-> FromParserK b (Maybe a -> m (Driver m a b))
forall b c. c -> FromParserK b c
FPKCont Maybe a -> m (Driver m a b)
cont1)

    -- Note, we can only reach FPKDone and FPKError from "initial".
    extract :: FromParserK a (Maybe a -> m (Driver m a a)) -> m a
extract (FPKDone Int
_ a
b) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b
    extract (FPKCont Maybe a -> m (Driver m a a)
cont) = (Maybe a -> m (Driver m a a)) -> m a
forall (m :: * -> *) a b.
MonadThrow m =>
(Maybe a -> m (Driver m a b)) -> m b
extractParse Maybe a -> m (Driver m a a)
cont

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

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

-- | Maps a function over the output of the parser.
--
instance Functor m => Functor (Parser m a) where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> Parser m a a -> Parser m a b
fmap a -> b
f Parser m a a
parser = (forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
forall (m :: * -> *) a b.
(forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
MkParser ((forall r.
  Int
  -> (Int, Int)
  -> ((Int, Int) -> Parse b -> m (Driver m a r))
  -> m (Driver m a r))
 -> Parser m a b)
-> (forall r.
    Int
    -> (Int, Int)
    -> ((Int, Int) -> Parse b -> m (Driver m a r))
    -> m (Driver m a r))
-> Parser m a b
forall a b. (a -> b) -> a -> b
$ \Int
lo (Int, Int)
st (Int, Int) -> Parse b -> m (Driver m a r)
yieldk ->
        let yld :: (Int, Int) -> Parse a -> m (Driver m a r)
yld (Int, Int)
s Parse a
res = (Int, Int) -> Parse b -> m (Driver m a r)
yieldk (Int, Int)
s ((a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Parse a
res)
         in Parser m a a
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse a -> m (Driver m a r))
-> m (Driver m a r)
forall (m :: * -> *) a b.
Parser m a b
-> forall r.
   Int
   -> (Int, Int)
   -> ((Int, Int) -> Parse b -> m (Driver m a r))
   -> m (Driver m a r)
runParser Parser m a a
parser Int
lo (Int, Int)
st (Int, Int) -> Parse a -> m (Driver m a r)
yld

-------------------------------------------------------------------------------
-- 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 -> Parser m a b
fromPure :: b -> Parser m a b
fromPure b
b = (forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
forall (m :: * -> *) a b.
(forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
MkParser ((forall r.
  Int
  -> (Int, Int)
  -> ((Int, Int) -> Parse b -> m (Driver m a r))
  -> m (Driver m a r))
 -> Parser m a b)
-> (forall r.
    Int
    -> (Int, Int)
    -> ((Int, Int) -> Parse b -> m (Driver m a r))
    -> m (Driver m a r))
-> Parser m a b
forall a b. (a -> b) -> a -> b
$ \Int
lo (Int, Int)
st (Int, Int) -> Parse b -> m (Driver m a r)
yieldk -> (Int, Int) -> Parse b -> m (Driver m a r)
yieldk (Int, Int)
st (Int -> b -> Parse b
forall b. Int -> b -> Parse b
Done Int
lo b
b)

-- | See 'Streamly.Internal.Data.Parser.fromEffect'.
--
-- /Pre-release/
--
{-# INLINE fromEffect #-}
fromEffect :: Monad m => m b -> Parser m a b
fromEffect :: m b -> Parser m a b
fromEffect m b
eff = (forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
forall (m :: * -> *) a b.
(forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
MkParser ((forall r.
  Int
  -> (Int, Int)
  -> ((Int, Int) -> Parse b -> m (Driver m a r))
  -> m (Driver m a r))
 -> Parser m a b)
-> (forall r.
    Int
    -> (Int, Int)
    -> ((Int, Int) -> Parse b -> m (Driver m a r))
    -> m (Driver m a r))
-> Parser m a b
forall a b. (a -> b) -> a -> b
$ \Int
lo (Int, Int)
st (Int, Int) -> Parse b -> m (Driver m a r)
yieldk -> m b
eff m b -> (b -> m (Driver m a r)) -> m (Driver m a r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
b -> (Int, Int) -> Parse b -> m (Driver m a r)
yieldk (Int, Int)
st (Int -> b -> Parse b
forall b. Int -> b -> Parse b
Done Int
lo b
b)

-- | 'Applicative' form of 'Streamly.Internal.Data.Parser.serialWith'. Note that
-- this operation does not fuse, use 'Streamly.Internal.Data.Parser.serialWith'
-- when fusion is important.
--
instance Monad m => Applicative (Parser m a) where
    {-# INLINE pure #-}
    pure :: a -> Parser m a a
pure = a -> Parser m a a
forall b (m :: * -> *) a. b -> Parser m a b
fromPure

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

    {-# INLINE (*>) #-}
    Parser m a a
m1 *> :: Parser m a a -> Parser m a b -> Parser m a b
*> Parser m a b
m2 = (forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
forall (m :: * -> *) a b.
(forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
MkParser ((forall r.
  Int
  -> (Int, Int)
  -> ((Int, Int) -> Parse b -> m (Driver m a r))
  -> m (Driver m a r))
 -> Parser m a b)
-> (forall r.
    Int
    -> (Int, Int)
    -> ((Int, Int) -> Parse b -> m (Driver m a r))
    -> m (Driver m a r))
-> Parser m a b
forall a b. (a -> b) -> a -> b
$ \Int
lo (Int, Int)
st (Int, Int) -> Parse b -> m (Driver m a r)
yieldk ->
        let yield1 :: (Int, Int) -> Parse b -> m (Driver m a r)
yield1 (Int, Int)
s (Done Int
n b
_) = Parser m a b
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse b -> m (Driver m a r))
-> m (Driver m a r)
forall (m :: * -> *) a b.
Parser m a b
-> forall r.
   Int
   -> (Int, Int)
   -> ((Int, Int) -> Parse b -> m (Driver m a r))
   -> m (Driver m a r)
runParser Parser m a b
m2 Int
n (Int, Int)
s (Int, Int) -> Parse b -> m (Driver m a r)
yieldk
            yield1 (Int, Int)
s (Error String
e) = (Int, Int) -> Parse b -> m (Driver m a r)
yieldk (Int, Int)
s (String -> Parse b
forall b. String -> Parse b
Error String
e)
        in Parser m a a
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse a -> m (Driver m a r))
-> m (Driver m a r)
forall (m :: * -> *) a b.
Parser m a b
-> forall r.
   Int
   -> (Int, Int)
   -> ((Int, Int) -> Parse b -> m (Driver m a r))
   -> m (Driver m a r)
runParser Parser m a a
m1 Int
lo (Int, Int)
st (Int, Int) -> Parse a -> m (Driver m a r)
forall b. (Int, Int) -> Parse b -> m (Driver m a r)
yield1

    {-# INLINE (<*) #-}
    Parser m a a
m1 <* :: Parser m a a -> Parser m a b -> Parser m a a
<* Parser m a b
m2 = (forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse a -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a a
forall (m :: * -> *) a b.
(forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
MkParser ((forall r.
  Int
  -> (Int, Int)
  -> ((Int, Int) -> Parse a -> m (Driver m a r))
  -> m (Driver m a r))
 -> Parser m a a)
-> (forall r.
    Int
    -> (Int, Int)
    -> ((Int, Int) -> Parse a -> m (Driver m a r))
    -> m (Driver m a r))
-> Parser m a a
forall a b. (a -> b) -> a -> b
$ \Int
lo (Int, Int)
st (Int, Int) -> Parse a -> m (Driver m a r)
yieldk ->
        let yield1 :: (Int, Int) -> Parse a -> m (Driver m a r)
yield1 (Int, Int)
s (Done Int
n a
b) =
                let yield2 :: (Int, Int) -> Parse b -> m (Driver m a r)
yield2 (Int, Int)
s1 (Done Int
n1 b
_) = (Int, Int) -> Parse a -> m (Driver m a r)
yieldk (Int, Int)
s1 (Int -> a -> Parse a
forall b. Int -> b -> Parse b
Done Int
n1 a
b)
                    yield2 (Int, Int)
s1 (Error String
e) = (Int, Int) -> Parse a -> m (Driver m a r)
yieldk (Int, Int)
s1 (String -> Parse a
forall b. String -> Parse b
Error String
e)
                in Parser m a b
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse b -> m (Driver m a r))
-> m (Driver m a r)
forall (m :: * -> *) a b.
Parser m a b
-> forall r.
   Int
   -> (Int, Int)
   -> ((Int, Int) -> Parse b -> m (Driver m a r))
   -> m (Driver m a r)
runParser Parser m a b
m2 Int
n (Int, Int)
s (Int, Int) -> Parse b -> m (Driver m a r)
forall b. (Int, Int) -> Parse b -> m (Driver m a r)
yield2
            yield1 (Int, Int)
s (Error String
e) = (Int, Int) -> Parse a -> m (Driver m a r)
yieldk (Int, Int)
s (String -> Parse a
forall b. String -> Parse b
Error String
e)
        in Parser m a a
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse a -> m (Driver m a r))
-> m (Driver m a r)
forall (m :: * -> *) a b.
Parser m a b
-> forall r.
   Int
   -> (Int, Int)
   -> ((Int, Int) -> Parse b -> m (Driver m a r))
   -> m (Driver m a r)
runParser Parser m a a
m1 Int
lo (Int, Int)
st (Int, Int) -> Parse a -> m (Driver m a r)
yield1

#if MIN_VERSION_base(4,10,0)
    {-# INLINE liftA2 #-}
    liftA2 :: (a -> b -> c) -> Parser m a a -> Parser m a b -> Parser m a c
liftA2 a -> b -> c
f Parser m a a
x = Parser m a (b -> c) -> Parser m a b -> Parser m a c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ((a -> b -> c) -> Parser m a a -> Parser m a (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b -> c
f Parser m a a
x)
#endif

-------------------------------------------------------------------------------
-- 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 -> Parser m a b
die :: String -> Parser m a b
die String
err = (forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
forall (m :: * -> *) a b.
(forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
MkParser (\Int
_ (Int, Int)
st (Int, Int) -> Parse b -> m (Driver m a r)
yieldk -> (Int, Int) -> Parse b -> m (Driver m a r)
yieldk (Int, Int)
st (String -> Parse b
forall b. String -> Parse b
Error String
err))

-- | 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 m Char 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 m Char 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 (Parser m a) where
    {-# INLINE return #-}
    return :: a -> Parser m a a
return = a -> Parser m a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    {-# INLINE (>>=) #-}
    Parser m a a
m >>= :: Parser m a a -> (a -> Parser m a b) -> Parser m a b
>>= a -> Parser m a b
k = (forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
forall (m :: * -> *) a b.
(forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
MkParser ((forall r.
  Int
  -> (Int, Int)
  -> ((Int, Int) -> Parse b -> m (Driver m a r))
  -> m (Driver m a r))
 -> Parser m a b)
-> (forall r.
    Int
    -> (Int, Int)
    -> ((Int, Int) -> Parse b -> m (Driver m a r))
    -> m (Driver m a r))
-> Parser m a b
forall a b. (a -> b) -> a -> b
$ \Int
lo (Int, Int)
st (Int, Int) -> Parse b -> m (Driver m a r)
yieldk ->
        let yield1 :: (Int, Int) -> Parse a -> m (Driver m a r)
yield1 (Int, Int)
s (Done Int
n a
b) = Parser m a b
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse b -> m (Driver m a r))
-> m (Driver m a r)
forall (m :: * -> *) a b.
Parser m a b
-> forall r.
   Int
   -> (Int, Int)
   -> ((Int, Int) -> Parse b -> m (Driver m a r))
   -> m (Driver m a r)
runParser (a -> Parser m a b
k a
b) Int
n (Int, Int)
s (Int, Int) -> Parse b -> m (Driver m a r)
yieldk
            yield1 (Int, Int)
s (Error String
e) = (Int, Int) -> Parse b -> m (Driver m a r)
yieldk (Int, Int)
s (String -> Parse b
forall b. String -> Parse b
Error String
e)
         in Parser m a a
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse a -> m (Driver m a r))
-> m (Driver m a r)
forall (m :: * -> *) a b.
Parser m a b
-> forall r.
   Int
   -> (Int, Int)
   -> ((Int, Int) -> Parse b -> m (Driver m a r))
   -> m (Driver m a r)
runParser Parser m a a
m Int
lo (Int, Int)
st (Int, Int) -> Parse a -> m (Driver m a r)
yield1

    {-# INLINE (>>) #-}
    >> :: Parser m a a -> Parser m a b -> Parser m a b
(>>) = Parser m a a -> Parser m a b -> Parser m a 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

#if MIN_VERSION_base(4,9,0)
instance Monad m => Fail.MonadFail (Parser m a) where
    {-# INLINE fail #-}
    fail :: String -> Parser m a a
fail = String -> Parser m a a
forall (m :: * -> *) a b. String -> Parser m a b
die
#endif

-------------------------------------------------------------------------------
-- 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 (Parser m a) where
    {-# INLINE empty #-}
    empty :: Parser m a a
empty = String -> Parser m a a
forall (m :: * -> *) a b. String -> Parser m a b
die String
"empty"

    {-# INLINE (<|>) #-}
    Parser m a a
m1 <|> :: Parser m a a -> Parser m a a -> Parser m a a
<|> Parser m a a
m2 = (forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse a -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a a
forall (m :: * -> *) a b.
(forall r.
 Int
 -> (Int, Int)
 -> ((Int, Int) -> Parse b -> m (Driver m a r))
 -> m (Driver m a r))
-> Parser m a b
MkParser ((forall r.
  Int
  -> (Int, Int)
  -> ((Int, Int) -> Parse a -> m (Driver m a r))
  -> m (Driver m a r))
 -> Parser m a a)
-> (forall r.
    Int
    -> (Int, Int)
    -> ((Int, Int) -> Parse a -> m (Driver m a r))
    -> m (Driver m a r))
-> Parser m a a
forall a b. (a -> b) -> a -> b
$ \Int
lo (Int
level, Int
_) (Int, Int) -> Parse a -> m (Driver m a r)
yieldk ->
        let yield1 :: (Int, Int) -> Parse a -> m (Driver m a r)
yield1 (Int
0, Int
_) Parse a
_ = String -> m (Driver m a r)
forall a. (?callStack::CallStack) => String -> a
error String
"0 nest level in Alternative"
            yield1 (Int
lvl, Int
_) (Done Int
n a
b) = (Int, Int) -> Parse a -> m (Driver m a r)
yieldk (Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
0) (Int -> a -> Parse a
forall b. Int -> b -> Parse b
Done Int
n a
b)
            yield1 (Int
lvl, Int
cnt) (Error String
_) = Parser m a a
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse a -> m (Driver m a r))
-> m (Driver m a r)
forall (m :: * -> *) a b.
Parser m a b
-> forall r.
   Int
   -> (Int, Int)
   -> ((Int, Int) -> Parse b -> m (Driver m a r))
   -> m (Driver m a r)
runParser Parser m a a
m2 Int
cnt (Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
0) (Int, Int) -> Parse a -> m (Driver m a r)
yieldk
        in Parser m a a
-> Int
-> (Int, Int)
-> ((Int, Int) -> Parse a -> m (Driver m a r))
-> m (Driver m a r)
forall (m :: * -> *) a b.
Parser m a b
-> forall r.
   Int
   -> (Int, Int)
   -> ((Int, Int) -> Parse b -> m (Driver m a r))
   -> m (Driver m a r)
runParser Parser m a a
m1 Int
lo (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
0) (Int, Int) -> Parse a -> m (Driver m a r)
yield1

    -- 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 :: Parser m a a -> Parser m a [a]
many Parser m a a
v = Parser m a [a]
many_v

        where

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

    {-# INLINE some #-}
    some :: Parser m a a -> Parser m a [a]
some Parser m a a
v = Parser m a [a]
some_v

        where

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

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

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