{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Rank2Types #-}
module Data.Conduit.Cereal.Internal
( ConduitErrorHandler
, SinkErrorHandler
, SinkTerminationHandler
, mkConduitGet
, mkSinkGet
) where
import Control.Monad (forever, when)
import qualified Data.ByteString as BS
import Data.Conduit (ConduitT, await, leftover, yield)
import Data.Serialize hiding (get, put)
type ConduitErrorHandler m o = String -> ConduitT BS.ByteString o m ()
type SinkErrorHandler m r = forall o. String -> ConduitT BS.ByteString o m r
type SinkTerminationHandler m r = forall o. (BS.ByteString -> Result r) -> ConduitT BS.ByteString o m r
mkConduitGet :: Monad m
=> ConduitErrorHandler m o
-> Get o
-> ConduitT BS.ByteString o m ()
mkConduitGet :: forall (m :: * -> *) o.
Monad m =>
ConduitErrorHandler m o -> Get o -> ConduitT ByteString o m ()
mkConduitGet ConduitErrorHandler m o
errorHandler Get o
get = Bool
-> (ByteString -> Result o)
-> [ByteString]
-> ByteString
-> ConduitT ByteString o m ()
consume Bool
True (Get o -> ByteString -> Result o
forall a. Get a -> ByteString -> Result a
runGetPartial Get o
get) [] ByteString
BS.empty
where pull :: (ByteString -> Result o)
-> [ByteString] -> ByteString -> ConduitT ByteString o m ()
pull ByteString -> Result o
f [ByteString]
b ByteString
s
| ByteString -> Bool
BS.null ByteString
s = ConduitT ByteString o m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString o m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString o m ())
-> ConduitT ByteString o m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT ByteString o m ()
-> (ByteString -> ConduitT ByteString o m ())
-> Maybe ByteString
-> ConduitT ByteString o m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> ConduitT ByteString o m () -> ConduitT ByteString o m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
b) (ByteString -> ConduitT ByteString o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover (ByteString -> ConduitT ByteString o m ())
-> ByteString -> ConduitT ByteString o m ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
b)) ((ByteString -> Result o)
-> [ByteString] -> ByteString -> ConduitT ByteString o m ()
pull ByteString -> Result o
f [ByteString]
b)
| Bool
otherwise = Bool
-> (ByteString -> Result o)
-> [ByteString]
-> ByteString
-> ConduitT ByteString o m ()
consume Bool
False ByteString -> Result o
f [ByteString]
b ByteString
s
consume :: Bool
-> (ByteString -> Result o)
-> [ByteString]
-> ByteString
-> ConduitT ByteString o m ()
consume Bool
initial ByteString -> Result o
f [ByteString]
b ByteString
s = case ByteString -> Result o
f ByteString
s of
Fail String
msg ByteString
_ -> do
Bool -> ConduitT ByteString o m () -> ConduitT ByteString o m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
b) (ByteString -> ConduitT ByteString o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover (ByteString -> ConduitT ByteString o m ())
-> ByteString -> ConduitT ByteString o m ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
consumed)
ConduitErrorHandler m o
errorHandler String
msg
Partial ByteString -> Result o
p -> (ByteString -> Result o)
-> [ByteString] -> ByteString -> ConduitT ByteString o m ()
pull ByteString -> Result o
p [ByteString]
consumed ByteString
BS.empty
Done o
a ByteString
s' -> case Bool
initial of
Bool
True -> ConduitT ByteString o m () -> ConduitT ByteString o m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (ConduitT ByteString o m () -> ConduitT ByteString o m ())
-> ConduitT ByteString o m () -> ConduitT ByteString o m ()
forall a b. (a -> b) -> a -> b
$ o -> ConduitT ByteString o m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield o
a
Bool
False -> o -> ConduitT ByteString o m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield o
a ConduitT ByteString o m ()
-> ConduitT ByteString o m () -> ConduitT ByteString o m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString -> Result o)
-> [ByteString] -> ByteString -> ConduitT ByteString o m ()
pull (Get o -> ByteString -> Result o
forall a. Get a -> ByteString -> Result a
runGetPartial Get o
get) [] ByteString
s'
where consumed :: [ByteString]
consumed = ByteString
s ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
b
mkSinkGet :: Monad m
=> SinkErrorHandler m r
-> SinkTerminationHandler m r
-> Get r
-> ConduitT BS.ByteString o m r
mkSinkGet :: forall (m :: * -> *) r o.
Monad m =>
SinkErrorHandler m r
-> SinkTerminationHandler m r -> Get r -> ConduitT ByteString o m r
mkSinkGet SinkErrorHandler m r
errorHandler SinkTerminationHandler m r
terminationHandler Get r
get = (ByteString -> Result r)
-> [ByteString] -> ByteString -> ConduitT ByteString o m r
forall {o}.
(ByteString -> Result r)
-> [ByteString] -> ByteString -> ConduitT ByteString o m r
consume (Get r -> ByteString -> Result r
forall a. Get a -> ByteString -> Result a
runGetPartial Get r
get) [] ByteString
BS.empty
where pull :: (ByteString -> Result r)
-> [ByteString] -> ByteString -> ConduitT ByteString o m r
pull ByteString -> Result r
f [ByteString]
b ByteString
s
| ByteString -> Bool
BS.null ByteString
s = ConduitT ByteString o m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString o m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString o m r)
-> ConduitT ByteString o m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe ByteString
x -> case Maybe ByteString
x of
Maybe ByteString
Nothing -> Bool -> ConduitT ByteString o m () -> ConduitT ByteString o m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
b) (ByteString -> ConduitT ByteString o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover (ByteString -> ConduitT ByteString o m ())
-> ByteString -> ConduitT ByteString o m ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
b) ConduitT ByteString o m ()
-> ConduitT ByteString o m r -> ConduitT ByteString o m r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString -> Result r) -> ConduitT ByteString o m r
SinkTerminationHandler m r
terminationHandler ByteString -> Result r
f
Just ByteString
a -> (ByteString -> Result r)
-> [ByteString] -> ByteString -> ConduitT ByteString o m r
pull ByteString -> Result r
f [ByteString]
b ByteString
a
| Bool
otherwise = (ByteString -> Result r)
-> [ByteString] -> ByteString -> ConduitT ByteString o m r
consume ByteString -> Result r
f [ByteString]
b ByteString
s
consume :: (ByteString -> Result r)
-> [ByteString] -> ByteString -> ConduitT ByteString o m r
consume ByteString -> Result r
f [ByteString]
b ByteString
s = case ByteString -> Result r
f ByteString
s of
Fail String
msg ByteString
_ -> do
Bool -> ConduitT ByteString o m () -> ConduitT ByteString o m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
b) (ByteString -> ConduitT ByteString o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover (ByteString -> ConduitT ByteString o m ())
-> ByteString -> ConduitT ByteString o m ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
consumed)
String -> ConduitT ByteString o m r
SinkErrorHandler m r
errorHandler String
msg
Partial ByteString -> Result r
p -> (ByteString -> Result r)
-> [ByteString] -> ByteString -> ConduitT ByteString o m r
pull ByteString -> Result r
p [ByteString]
consumed ByteString
BS.empty
Done r
r ByteString
s' -> Bool -> ConduitT ByteString o m () -> ConduitT ByteString o m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
BS.null ByteString
s') (ByteString -> ConduitT ByteString o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
s') ConduitT ByteString o m ()
-> ConduitT ByteString o m r -> ConduitT ByteString o m r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> r -> ConduitT ByteString o m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
where consumed :: [ByteString]
consumed = ByteString
s ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
b