-- |
-- Module      : Streamly.Internal.Data.Producer.Source
-- Copyright   : (c) 2021 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- A 'Source' is a seed that can be unfolded to a stream with a buffer.  Allows
-- to 'unread' data i.e.  push unused data back to the source buffer. This is
-- useful in parsing applications with backtracking.
--

module Streamly.Internal.Data.Producer.Source
    ( Source

    -- * Creation
    , source

    -- * Transformation
    , unread

    -- * Consumption
    , isEmpty
    , producer

    -- * Parsing
    , parse
    , parseMany
    , parseManyD
    )
where

#include "inline.hs"

import Control.Exception (assert)
import GHC.Exts (SpecConstrAnnotation(..))
import GHC.Types (SPEC(..))
import Streamly.Internal.Data.Parser
    (ParseError(..), ParseErrorPos(..), Step(..), Final(..))
import Streamly.Internal.Data.Producer.Type (Producer(..))
import Streamly.Internal.Data.Stream.Step (Step(..))

import qualified Streamly.Internal.Data.Parser as ParserD
-- import qualified Streamly.Internal.Data.Parser.ParserK.Type as ParserK

import Prelude hiding (read)

-- | A seed with a buffer. It allows us to 'unread' or return some data
-- after reading it. Useful in backtracked parsing.
--
data Source a b = Source [b] (Maybe a)

-- | Make a source from a seed value. The buffer would start as empty.
--
-- /Pre-release/
source :: Maybe a -> Source a b
source :: forall a b. Maybe a -> Source a b
source = [b] -> Maybe a -> Source a b
forall a b. [b] -> Maybe a -> Source a b
Source []

-- | Return some unused data back to the source. The data is prepended (or
-- consed) to the source.
--
-- /Pre-release/
unread :: [b] -> Source a b -> Source a b
unread :: forall b a. [b] -> Source a b -> Source a b
unread [b]
xs (Source [b]
ys Maybe a
seed) = [b] -> Maybe a -> Source a b
forall a b. [b] -> Maybe a -> Source a b
Source ([b]
xs [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ [b]
ys) Maybe a
seed

-- | Determine if the source is empty.
isEmpty :: Source a b -> Bool
isEmpty :: forall a b. Source a b -> Bool
isEmpty (Source [] Maybe a
Nothing) = Bool
True
isEmpty Source a b
_ = Bool
False

-- | Convert a producer to a producer from a buffered source. Any buffered data
-- is read first and then the seed is unfolded.
--
-- /Pre-release/
{-# INLINE_NORMAL producer #-}
producer :: Monad m => Producer m a b -> Producer m (Source a b) b
producer :: forall (m :: * -> *) a b.
Monad m =>
Producer m a b -> Producer m (Source a b) b
producer (Producer s -> m (Step s b)
step1 a -> m s
inject1 s -> m a
extract1) = (Either s ([b], Maybe a) -> m (Step (Either s ([b], Maybe a)) b))
-> (Source a b -> m (Either s ([b], Maybe a)))
-> (Either s ([b], Maybe a) -> m (Source a b))
-> Producer m (Source a b) b
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> (s -> m a) -> Producer m a b
Producer Either s ([b], Maybe a) -> m (Step (Either s ([b], Maybe a)) b)
step Source a b -> m (Either s ([b], Maybe a))
forall {b}. Source a b -> m (Either s ([b], Maybe a))
inject Either s ([b], Maybe a) -> m (Source a b)
forall {b}. Either s ([b], Maybe a) -> m (Source a b)
extract

    where

    inject :: Source a b -> m (Either s ([b], Maybe a))
inject (Source [] (Just a
a)) = do
        s
s <- a -> m s
inject1 a
a
        Either s ([b], Maybe a) -> m (Either s ([b], Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either s ([b], Maybe a) -> m (Either s ([b], Maybe a)))
-> Either s ([b], Maybe a) -> m (Either s ([b], Maybe a))
forall a b. (a -> b) -> a -> b
$ s -> Either s ([b], Maybe a)
forall a b. a -> Either a b
Left s
s
    inject (Source [b]
xs Maybe a
a) = Either s ([b], Maybe a) -> m (Either s ([b], Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either s ([b], Maybe a) -> m (Either s ([b], Maybe a)))
-> Either s ([b], Maybe a) -> m (Either s ([b], Maybe a))
forall a b. (a -> b) -> a -> b
$ ([b], Maybe a) -> Either s ([b], Maybe a)
forall a b. b -> Either a b
Right ([b]
xs, Maybe a
a)

    {-# INLINE_LATE step #-}
    step :: Either s ([b], Maybe a) -> m (Step (Either s ([b], Maybe a)) b)
step (Left s
s) = do
        Step s b
r <- s -> m (Step s b)
step1 s
s
        Step (Either s ([b], Maybe a)) b
-> m (Step (Either s ([b], Maybe a)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s ([b], Maybe a)) b
 -> m (Step (Either s ([b], Maybe a)) b))
-> Step (Either s ([b], Maybe a)) b
-> m (Step (Either s ([b], Maybe a)) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s1 -> b -> Either s ([b], Maybe a) -> Step (Either s ([b], Maybe a)) b
forall s a. a -> s -> Step s a
Yield b
x (s -> Either s ([b], Maybe a)
forall a b. a -> Either a b
Left s
s1)
            Skip s
s1 -> Either s ([b], Maybe a) -> Step (Either s ([b], Maybe a)) b
forall s a. s -> Step s a
Skip (s -> Either s ([b], Maybe a)
forall a b. a -> Either a b
Left s
s1)
            Step s b
Stop -> Step (Either s ([b], Maybe a)) b
forall s a. Step s a
Stop
    step (Right ([], Maybe a
Nothing)) = Step (Either s ([b], Maybe a)) b
-> m (Step (Either s ([b], Maybe a)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Either s ([b], Maybe a)) b
forall s a. Step s a
Stop
    step (Right ([], Just a
_)) = [Char] -> m (Step (Either s ([b], Maybe a)) b)
forall a. HasCallStack => [Char] -> a
error [Char]
"Bug: unreachable"
    step (Right (b
x:[], Just a
a)) = do
        s
s <- a -> m s
inject1 a
a
        Step (Either s ([b], Maybe a)) b
-> m (Step (Either s ([b], Maybe a)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s ([b], Maybe a)) b
 -> m (Step (Either s ([b], Maybe a)) b))
-> Step (Either s ([b], Maybe a)) b
-> m (Step (Either s ([b], Maybe a)) b)
forall a b. (a -> b) -> a -> b
$ b -> Either s ([b], Maybe a) -> Step (Either s ([b], Maybe a)) b
forall s a. a -> s -> Step s a
Yield b
x (s -> Either s ([b], Maybe a)
forall a b. a -> Either a b
Left s
s)
    step (Right (b
x:[b]
xs, Maybe a
a)) = Step (Either s ([b], Maybe a)) b
-> m (Step (Either s ([b], Maybe a)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Either s ([b], Maybe a)) b
 -> m (Step (Either s ([b], Maybe a)) b))
-> Step (Either s ([b], Maybe a)) b
-> m (Step (Either s ([b], Maybe a)) b)
forall a b. (a -> b) -> a -> b
$ b -> Either s ([b], Maybe a) -> Step (Either s ([b], Maybe a)) b
forall s a. a -> s -> Step s a
Yield b
x (([b], Maybe a) -> Either s ([b], Maybe a)
forall a b. b -> Either a b
Right ([b]
xs, Maybe a
a))

    extract :: Either s ([b], Maybe a) -> m (Source a b)
extract (Left s
s) = [b] -> Maybe a -> Source a b
forall a b. [b] -> Maybe a -> Source a b
Source [] (Maybe a -> Source a b) -> (a -> Maybe a) -> a -> Source a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> Source a b) -> m a -> m (Source a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
extract1 s
s
    extract (Right ([b]
xs, Maybe a
a)) = Source a b -> m (Source a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Source a b -> m (Source a b)) -> Source a b -> m (Source a b)
forall a b. (a -> b) -> a -> b
$ [b] -> Maybe a -> Source a b
forall a b. [b] -> Maybe a -> Source a b
Source [b]
xs Maybe a
a

-------------------------------------------------------------------------------
-- Parsing
-------------------------------------------------------------------------------

-- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need
-- to make a newtype.
{-# ANN type List NoSpecConstr #-}
newtype List a = List {forall a. List a -> [a]
getList :: [a]}

{-# INLINE_NORMAL parse #-}
parse
    :: Monad m =>
    ParserD.Parser a m b
    -> Producer m (Source s a) a
    -> Source s a
    -> m (Either ParseErrorPos b, Source s a)
parse :: forall (m :: * -> *) a b s.
Monad m =>
Parser a m b
-> Producer m (Source s a) a
-> Source s a
-> m (Either ParseErrorPos b, Source s a)
parse
    (ParserD.Parser s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m (Final s b)
extract)
    (Producer s -> m (Step s a)
ustep Source s a -> m s
uinject s -> m (Source s a)
uextract)
    Source s a
seed = do

    Initial s b
res <- m (Initial s b)
initial
    case Initial s b
res of
        ParserD.IPartial s
s -> do
            s
state <- Source s a -> m s
uinject Source s a
seed
            SPEC
-> s
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
go SPEC
SPEC s
state ([a] -> List a
forall a. [a] -> List a
List []) s
s Int
0
        ParserD.IDone b
b -> (Either ParseErrorPos b, Source s a)
-> m (Either ParseErrorPos b, Source s a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either ParseErrorPos b
forall a b. b -> Either a b
Right b
b, Source s a
seed)
        ParserD.IError [Char]
err -> (Either ParseErrorPos b, Source s a)
-> m (Either ParseErrorPos b, Source s a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseErrorPos -> Either ParseErrorPos b
forall a b. a -> Either a b
Left (Int -> [Char] -> ParseErrorPos
ParseErrorPos Int
0 [Char]
err), Source s a
seed)

    where

    -- XXX currently we are using a dumb list based approach for backtracking
    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.
    -- That will allow us more efficient random back and forth movement.
    go :: SPEC
-> s
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
go !SPEC
_ s
st List a
buf !s
pst Int
i = do
        Step s a
r <- s -> m (Step s a)
ustep s
st
        case Step s a
r of
            Yield a
x s
s -> do
                Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
                case Step s b
pRes of
                    SPartial Int
1 s
pst1 -> SPEC
-> s
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
go SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List []) s
pst1 Int
i
                    SPartial Int
m s
pst1 -> do
                        let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
                        Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                            src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                        SPEC
-> s
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List []) ([a] -> List a
forall a. [a] -> List a
List [a]
src) s
pst1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
                    SContinue Int
1 s
pst1 -> SPEC
-> s
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
go SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) s
pst1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                    SContinue Int
m s
pst1 -> do
                        let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
                        Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let ([a]
src0, [a]
buf1) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                            src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                        SPEC
-> s
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List [a]
buf1) ([a] -> List a
forall a. [a] -> List a
List [a]
src) s
pst1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
                    SDone Int
m b
b -> do
                        let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
                        Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                            src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                        Source s a
s1 <- s -> m (Source s a)
uextract s
s
                        (Either ParseErrorPos b, Source s a)
-> m (Either ParseErrorPos b, Source s a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either ParseErrorPos b
forall a b. b -> Either a b
Right b
b, [a] -> Source s a -> Source s a
forall b a. [b] -> Source a b -> Source a b
unread [a]
src Source s a
s1)
                    SError [Char]
err -> do
                        Source s a
s1 <- s -> m (Source s a)
uextract s
s
                        let src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse (List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                        (Either ParseErrorPos b, Source s a)
-> m (Either ParseErrorPos b, Source s a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                            ( ParseErrorPos -> Either ParseErrorPos b
forall a b. a -> Either a b
Left (Int -> [Char] -> ParseErrorPos
ParseErrorPos (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Char]
err)
                            , [a] -> Source s a -> Source s a
forall b a. [b] -> Source a b -> Source a b
unread ([a]
src [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]) Source s a
s1
                            )
            Skip s
s -> SPEC
-> s
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
go SPEC
SPEC s
s List a
buf s
pst Int
i
            Step s a
Stop -> List a -> s -> Int -> m (Either ParseErrorPos b, Source s a)
forall {a}.
List a -> s -> Int -> m (Either ParseErrorPos b, Source a a)
goStop List a
buf s
pst Int
i

    gobuf :: SPEC
-> s
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
gobuf !SPEC
_ s
s List a
buf (List []) !s
pst Int
i = SPEC
-> s
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
go SPEC
SPEC s
s List a
buf s
pst Int
i
    gobuf !SPEC
_ s
s List a
buf (List (a
x:[a]
xs)) !s
pst Int
i = do
        Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
        case Step s b
pRes of
            SPartial Int
1 s
pst1 ->
                SPEC
-> s
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List []) ([a] -> List a
forall a. [a] -> List a
List [a]
xs) s
pst1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            SPartial Int
m s
pst1 -> do
                let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
                SPEC
-> s
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List []) ([a] -> List a
forall a. [a] -> List a
List [a]
src) s
pst1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
            SContinue Int
1 s
pst1 ->
                SPEC
-> s
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) ([a] -> List a
forall a. [a] -> List a
List [a]
xs) s
pst1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            SContinue Int
m s
pst1 -> do
                let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let ([a]
src0, [a]
buf1) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
                SPEC
-> s
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source s a)
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List [a]
buf1) ([a] -> List a
forall a. [a] -> List a
List [a]
src) s
pst1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
            SDone Int
m b
b -> do
                let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                Source s a
s1 <- s -> m (Source s a)
uextract s
s
                (Either ParseErrorPos b, Source s a)
-> m (Either ParseErrorPos b, Source s a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either ParseErrorPos b
forall a b. b -> Either a b
Right b
b, [a] -> Source s a -> Source s a
forall b a. [b] -> Source a b -> Source a b
unread [a]
src Source s a
s1)
            SError [Char]
err -> do
                    Source s a
s1 <- s -> m (Source s a)
uextract s
s
                    let src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse (List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    (Either ParseErrorPos b, Source s a)
-> m (Either ParseErrorPos b, Source s a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                        ( ParseErrorPos -> Either ParseErrorPos b
forall a b. a -> Either a b
Left (Int -> [Char] -> ParseErrorPos
ParseErrorPos (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Char]
err)
                        , [a] -> Source s a -> Source s a
forall b a. [b] -> Source a b -> Source a b
unread ([a]
src [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)) Source s a
s1
                        )

    -- This is a simplified gobuf
    goExtract :: SPEC
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source a a)
goExtract !SPEC
_ List a
buf (List []) !s
pst Int
i = List a -> s -> Int -> m (Either ParseErrorPos b, Source a a)
goStop List a
buf s
pst Int
i
    goExtract !SPEC
_ List a
buf (List (a
x:[a]
xs)) !s
pst Int
i = do
        Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
        case Step s b
pRes of
            SPartial Int
1 s
pst1 ->
                SPEC
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source a a)
goExtract SPEC
SPEC ([a] -> List a
forall a. [a] -> List a
List []) ([a] -> List a
forall a. [a] -> List a
List [a]
xs) s
pst1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            SPartial Int
m s
pst1 -> do
                let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
                SPEC
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source a a)
goExtract SPEC
SPEC ([a] -> List a
forall a. [a] -> List a
List []) ([a] -> List a
forall a. [a] -> List a
List [a]
src) s
pst1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
            SContinue Int
1 s
pst1 ->
                SPEC
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source a a)
goExtract SPEC
SPEC ([a] -> List a
forall a. [a] -> List a
List (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) ([a] -> List a
forall a. [a] -> List a
List [a]
xs) s
pst1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            SContinue Int
m s
pst1 -> do
                let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let ([a]
src0, [a]
buf1) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
                SPEC
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source a a)
goExtract SPEC
SPEC ([a] -> List a
forall a. [a] -> List a
List [a]
buf1) ([a] -> List a
forall a. [a] -> List a
List [a]
src) s
pst1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
            SDone Int
m b
b -> do
                let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                (Either ParseErrorPos b, Source a a)
-> m (Either ParseErrorPos b, Source a a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either ParseErrorPos b
forall a b. b -> Either a b
Right b
b, [a] -> Source a a -> Source a a
forall b a. [b] -> Source a b -> Source a b
unread [a]
src (Maybe a -> Source a a
forall a b. Maybe a -> Source a b
source Maybe a
forall a. Maybe a
Nothing))
            SError [Char]
err -> do
                    let src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse (List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    (Either ParseErrorPos b, Source a a)
-> m (Either ParseErrorPos b, Source a a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                        ( ParseErrorPos -> Either ParseErrorPos b
forall a b. a -> Either a b
Left (Int -> [Char] -> ParseErrorPos
ParseErrorPos (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Char]
err)
                        , [a] -> Source a a -> Source a a
forall b a. [b] -> Source a b -> Source a b
unread ([a]
src [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)) (Maybe a -> Source a a
forall a b. Maybe a -> Source a b
source Maybe a
forall a. Maybe a
Nothing)
                        )

    -- This is a simplified goExtract
    {-# INLINE goStop #-}
    goStop :: List a -> s -> Int -> m (Either ParseErrorPos b, Source a a)
goStop List a
buf s
pst Int
i = do
        Final s b
pRes <- s -> m (Final s b)
extract s
pst
        case Final s b
pRes of
            FContinue Int
0 s
pst1 ->
                List a -> s -> Int -> m (Either ParseErrorPos b, Source a a)
goStop List a
buf s
pst1 Int
i
            FContinue Int
m s
pst1 -> do
                let n :: Int
n = (- Int
m)
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let ([a]
src0, [a]
buf1) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n (List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    src :: [a]
src = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                SPEC
-> List a
-> List a
-> s
-> Int
-> m (Either ParseErrorPos b, Source a a)
goExtract SPEC
SPEC ([a] -> List a
forall a. [a] -> List a
List [a]
buf1) ([a] -> List a
forall a. [a] -> List a
List [a]
src) s
pst1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
            FDone Int
0 b
b -> (Either ParseErrorPos b, Source a a)
-> m (Either ParseErrorPos b, Source a a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either ParseErrorPos b
forall a b. b -> Either a b
Right b
b, Maybe a -> Source a a
forall a b. Maybe a -> Source a b
source Maybe a
forall a. Maybe a
Nothing)
            FDone Int
m b
b -> do
                let n :: Int
n = (- Int
m)
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (List a -> [a]
forall a. List a -> [a]
getList List a
buf)) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                (Either ParseErrorPos b, Source a a)
-> m (Either ParseErrorPos b, Source a a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either ParseErrorPos b
forall a b. b -> Either a b
Right b
b, [a] -> Source a a -> Source a a
forall b a. [b] -> Source a b -> Source a b
unread [a]
src (Maybe a -> Source a a
forall a b. Maybe a -> Source a b
source Maybe a
forall a. Maybe a
Nothing))
            FError [Char]
err -> do
                let src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse (List a -> [a]
forall a. List a -> [a]
getList List a
buf)
                (Either ParseErrorPos b, Source a a)
-> m (Either ParseErrorPos b, Source a a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseErrorPos -> Either ParseErrorPos b
forall a b. a -> Either a b
Left (Int -> [Char] -> ParseErrorPos
ParseErrorPos Int
i [Char]
err), [a] -> Source a a -> Source a a
forall b a. [b] -> Source a b -> Source a b
unread [a]
src (Maybe a -> Source a a
forall a b. Maybe a -> Source a b
source Maybe a
forall a. Maybe a
Nothing))

{-
-- | Parse a buffered source using a parser, returning the parsed value and the
-- remaining source.
--
-- /Pre-release/
{-# INLINE [3] parseK #-}
parseK :: Monad m =>
       ParserK.Parser a m b
    -> Producer m (Source s a) a
    -> Source s a
    -> m (Either ParseError b, Source s a)
parseK = parse . ParserK.toParser
-}

-------------------------------------------------------------------------------
-- Nested parsing
-------------------------------------------------------------------------------

{-# INLINE parseManyD #-}
parseManyD :: Monad m =>
       ParserD.Parser a m b
    -> Producer m (Source x a) a
    -> Producer m (Source x a) (Either ParseError b)
parseManyD :: forall (m :: * -> *) a b x.
Monad m =>
Parser a m b
-> Producer m (Source x a) a
-> Producer m (Source x a) (Either ParseError b)
parseManyD Parser a m b
parser Producer m (Source x a) a
reader = (Source x a -> m (Step (Source x a) (Either ParseError b)))
-> (Source x a -> m (Source x a))
-> (Source x a -> m (Source x a))
-> Producer m (Source x a) (Either ParseError b)
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> (s -> m a) -> Producer m a b
Producer Source x a -> m (Step (Source x a) (Either ParseError b))
forall {a}. Source x a -> m (Step (Source x a) (Either a b))
step Source x a -> m (Source x a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Source x a -> m (Source x a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

    where

    {-# INLINE_LATE step #-}
    step :: Source x a -> m (Step (Source x a) (Either a b))
step Source x a
src = do
        if Source x a -> Bool
forall a b. Source a b -> Bool
isEmpty Source x a
src
        then Step (Source x a) (Either a b)
-> m (Step (Source x a) (Either a b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Source x a) (Either a b)
forall s a. Step s a
Stop
        else do
            (Either ParseErrorPos b
b, Source x a
s1) <- Parser a m b
-> Producer m (Source x a) a
-> Source x a
-> m (Either ParseErrorPos b, Source x a)
forall (m :: * -> *) a b s.
Monad m =>
Parser a m b
-> Producer m (Source s a) a
-> Source s a
-> m (Either ParseErrorPos b, Source s a)
parse Parser a m b
parser Producer m (Source x a) a
reader Source x a
src
            case Either ParseErrorPos b
b of
                Right b
b1 -> Step (Source x a) (Either a b)
-> m (Step (Source x a) (Either a b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Source x a) (Either a b)
 -> m (Step (Source x a) (Either a b)))
-> Step (Source x a) (Either a b)
-> m (Step (Source x a) (Either a b))
forall a b. (a -> b) -> a -> b
$ Either a b -> Source x a -> Step (Source x a) (Either a b)
forall s a. a -> s -> Step s a
Yield (b -> Either a b
forall a b. b -> Either a b
Right b
b1) Source x a
s1
                Left ParseErrorPos
_ -> Step (Source x a) (Either a b)
-> m (Step (Source x a) (Either a b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Source x a) (Either a b)
forall s a. Step s a
Stop

-- | Apply a parser repeatedly on a buffered source producer to generate a
-- producer of parsed values.
--
-- /Pre-release/
{-# INLINE parseMany #-}
parseMany :: Monad m =>
       ParserD.Parser a m b
    -> Producer m (Source x a) a
    -> Producer m (Source x a) (Either ParseError b)
parseMany :: forall (m :: * -> *) a b x.
Monad m =>
Parser a m b
-> Producer m (Source x a) a
-> Producer m (Source x a) (Either ParseError b)
parseMany = Parser a m b
-> Producer m (Source x a) a
-> Producer m (Source x a) (Either ParseError b)
forall (m :: * -> *) a b x.
Monad m =>
Parser a m b
-> Producer m (Source x a) a
-> Producer m (Source x a) (Either ParseError b)
parseManyD