module Streamly.Internal.Data.Producer.Source
( Source
, source
, unread
, isEmpty
, producer
, parse
, parseMany
, parseManyD
)
where
#include "inline.hs"
import Control.Exception (assert)
import Control.Monad.Catch (MonadThrow, throwM)
import GHC.Exts (SpecConstrAnnotation(..))
import GHC.Types (SPEC(..))
import Streamly.Internal.Data.Parser.ParserD (ParseError(..), Step(..))
import Streamly.Internal.Data.Producer.Type (Producer(..))
import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))
import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
import qualified Streamly.Internal.Data.Parser.ParserK.Type as ParserK
import Prelude hiding (read)
data Source a b = Source [b] (Maybe a)
source :: Maybe a -> Source a b
source :: Maybe a -> Source a b
source = [b] -> Maybe a -> Source a b
forall a b. [b] -> Maybe a -> Source a b
Source []
unread :: [b] -> Source a b -> Source a b
unread :: [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
isEmpty :: Source a b -> Bool
isEmpty :: Source a b -> Bool
isEmpty (Source [] Maybe a
Nothing) = Bool
True
isEmpty Source a b
_ = Bool
False
{-# INLINE_NORMAL producer #-}
producer :: Monad m => Producer m a b -> Producer m (Source a b) b
producer :: 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 (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 (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 (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 (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 (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 (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 (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
{-# ANN type List NoSpecConstr #-}
newtype List a = List {List a -> [a]
getList :: [a]}
{-# INLINE_NORMAL parseD #-}
parseD
:: MonadThrow m
=> ParserD.Parser m a b
-> Producer m (Source s a) a
-> Source s a
-> m (b, Source s a)
parseD :: Parser m a b
-> Producer m (Source s a) a -> Source s a -> m (b, Source s a)
parseD
(ParserD.Parser s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m 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 -> m (b, Source s a)
go SPEC
SPEC s
state ([a] -> List a
forall a. [a] -> List a
List []) s
s
ParserD.IDone b
b -> (b, Source s a) -> m (b, Source s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Source s a
seed)
ParserD.IError [Char]
err -> ParseError -> m (b, Source s a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (b, Source s a))
-> ParseError -> m (b, Source s a)
forall a b. (a -> b) -> a -> b
$ [Char] -> ParseError
ParseError [Char]
err
where
{-# INLINE go #-}
go :: SPEC -> s -> List a -> s -> m (b, Source s a)
go !SPEC
_ s
st List a
buf !s
pst = 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
Partial Int
0 s
pst1 -> SPEC -> s -> List a -> s -> m (b, Source s a)
go SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List []) s
pst1
Partial Int
n s
pst1 -> do
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 (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 (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 -> m (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
Continue Int
0 s
pst1 -> SPEC -> s -> List a -> s -> m (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
Continue Int
n s
pst1 -> do
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 (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 (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 -> m (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
Done Int
n b
b -> do
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 (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 (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
(b, Source s a) -> m (b, Source s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (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)
Error [Char]
err -> ParseError -> m (b, Source s a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (b, Source s a))
-> ParseError -> m (b, Source s a)
forall a b. (a -> b) -> a -> b
$ [Char] -> ParseError
ParseError [Char]
err
Skip s
s -> SPEC -> s -> List a -> s -> m (b, Source s a)
go SPEC
SPEC s
s List a
buf s
pst
Step s a
Stop -> do
b
b <- s -> m b
extract s
pst
(b, Source s a) -> m (b, Source s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, [a] -> Source s a -> Source s a
forall b a. [b] -> Source a b -> Source a b
unread ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ List a -> [a]
forall a. List a -> [a]
getList List a
buf) (Maybe s -> Source s a
forall a b. Maybe a -> Source a b
source Maybe s
forall a. Maybe a
Nothing))
gobuf :: SPEC -> s -> List a -> List a -> s -> m (b, Source s a)
gobuf !SPEC
_ s
s List a
buf (List []) !s
pst = SPEC -> s -> List a -> s -> m (b, Source s a)
go SPEC
SPEC s
s List a
buf s
pst
gobuf !SPEC
_ s
s List a
buf (List (a
x:[a]
xs)) !s
pst = do
Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
case Step s b
pRes of
Partial Int
0 s
pst1 ->
SPEC -> s -> List a -> List a -> s -> m (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
Partial Int
n s
pst1 -> do
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 (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 (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 -> m (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
Continue Int
0 s
pst1 ->
SPEC -> s -> List a -> List a -> s -> m (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
Continue Int
n s
pst1 -> do
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 (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 (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 -> m (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
Done Int
n b
b -> do
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 (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 (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
(b, Source s a) -> m (b, Source s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (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)
Error [Char]
err -> ParseError -> m (b, Source s a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (b, Source s a))
-> ParseError -> m (b, Source s a)
forall a b. (a -> b) -> a -> b
$ [Char] -> ParseError
ParseError [Char]
err
{-# INLINE [3] parse #-}
parse
:: MonadThrow m
=> ParserK.Parser m a b
-> Producer m (Source s a) a
-> Source s a
-> m (b, Source s a)
parse :: Parser m a b
-> Producer m (Source s a) a -> Source s a -> m (b, Source s a)
parse = Parser m a b
-> Producer m (Source s a) a -> Source s a -> m (b, Source s a)
forall (m :: * -> *) a b s.
MonadThrow m =>
Parser m a b
-> Producer m (Source s a) a -> Source s a -> m (b, Source s a)
parseD (Parser m a b
-> Producer m (Source s a) a -> Source s a -> m (b, Source s a))
-> (Parser m a b -> Parser m a b)
-> Parser m a b
-> Producer m (Source s a) a
-> Source s a
-> m (b, Source s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser m a b -> Parser m a b
forall (m :: * -> *) a b.
MonadThrow m =>
Parser m a b -> Parser m a b
ParserK.fromParserK
{-# INLINE parseManyD #-}
parseManyD :: MonadThrow m =>
ParserD.Parser m a b
-> Producer m (Source x a) a
-> Producer m (Source x a) b
parseManyD :: Parser m a b
-> Producer m (Source x a) a -> Producer m (Source x a) b
parseManyD Parser m a b
parser Producer m (Source x a) a
reader = (Source x a -> m (Step (Source x a) b))
-> (Source x a -> m (Source x a))
-> (Source x a -> m (Source x a))
-> Producer m (Source x a) 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) b)
step Source x a -> m (Source x a)
forall (m :: * -> *) a. Monad m => a -> m a
return Source x a -> m (Source x a)
forall (m :: * -> *) a. Monad m => a -> m a
return
where
{-# INLINE_LATE step #-}
step :: Source x a -> m (Step (Source x 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) b -> m (Step (Source x a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Source x a) b
forall s a. Step s a
Stop
else do
(b
b, Source x a
s1) <- Parser m a b
-> Producer m (Source x a) a -> Source x a -> m (b, Source x a)
forall (m :: * -> *) a b s.
MonadThrow m =>
Parser m a b
-> Producer m (Source s a) a -> Source s a -> m (b, Source s a)
parseD Parser m a b
parser Producer m (Source x a) a
reader Source x a
src
Step (Source x a) b -> m (Step (Source x a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Source x a) b -> m (Step (Source x a) b))
-> Step (Source x a) b -> m (Step (Source x a) b)
forall a b. (a -> b) -> a -> b
$ b -> Source x a -> Step (Source x a) b
forall s a. a -> s -> Step s a
Yield b
b Source x a
s1
{-# INLINE parseMany #-}
parseMany :: MonadThrow m =>
ParserK.Parser m a b
-> Producer m (Source x a) a
-> Producer m (Source x a) b
parseMany :: Parser m a b
-> Producer m (Source x a) a -> Producer m (Source x a) b
parseMany Parser m a b
parser = Parser m a b
-> Producer m (Source x a) a -> Producer m (Source x a) b
forall (m :: * -> *) a b x.
MonadThrow m =>
Parser m a b
-> Producer m (Source x a) a -> Producer m (Source x a) b
parseManyD (Parser m a b -> Parser m a b
forall (m :: * -> *) a b.
MonadThrow m =>
Parser m a b -> Parser m a b
ParserK.fromParserK Parser m a b
parser)