{-# LANGUAGE DeriveDataTypeable #-}
module Data.Conduit.Codec.Util
( CodecDecodeException(..)
, encodeI
, decodeI
, decodeII
, encodeII
) where
import Data.Typeable (Typeable)
import Control.Exception (Exception)
import Data.ByteString as BS (ByteString, append, null)
import Data.Conduit (Conduit, await, yield)
import Data.Maybe (fromJust)
import Control.Monad (unless, void)
import Control.Monad.Catch (MonadThrow, throwM)
type EncFunc = ByteString -> ByteString
type EncFuncPart = ByteString -> (ByteString, ByteString)
type EncFuncFinal = ByteString -> Maybe ByteString
type DecFunc = ByteString -> Either (ByteString, ByteString) (ByteString, ByteString)
type DecFuncFinal = ByteString -> Maybe ByteString
data CodecDecodeException = CodecDecodeException ByteString
deriving (Typeable, Int -> CodecDecodeException -> ShowS
[CodecDecodeException] -> ShowS
CodecDecodeException -> String
(Int -> CodecDecodeException -> ShowS)
-> (CodecDecodeException -> String)
-> ([CodecDecodeException] -> ShowS)
-> Show CodecDecodeException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodecDecodeException] -> ShowS
$cshowList :: [CodecDecodeException] -> ShowS
show :: CodecDecodeException -> String
$cshow :: CodecDecodeException -> String
showsPrec :: Int -> CodecDecodeException -> ShowS
$cshowsPrec :: Int -> CodecDecodeException -> ShowS
Show)
instance Exception CodecDecodeException
encodeI :: (Monad m) => EncFuncPart -> EncFuncFinal -> ByteString -> Conduit ByteString m ByteString
encodeI :: EncFuncPart
-> EncFuncFinal -> ByteString -> Conduit ByteString m ByteString
encodeI EncFuncPart
enc_part EncFuncFinal
enc_final ByteString
i = do
Maybe ByteString
clear <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
case Maybe ByteString
clear of
Maybe ByteString
Nothing -> Conduit ByteString m ByteString -> Conduit ByteString m ByteString
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> Conduit ByteString m ByteString
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> Conduit ByteString m ByteString)
-> ByteString -> Conduit ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ EncFuncFinal
enc_final ByteString
i)
Just ByteString
s -> let
(ByteString
a, ByteString
b) = EncFuncPart
enc_part (ByteString
i ByteString -> ByteString -> ByteString
`append` ByteString
s)
in do
Bool
-> Conduit ByteString m ByteString
-> Conduit ByteString m ByteString
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
a) (Conduit ByteString m ByteString
-> Conduit ByteString m ByteString)
-> Conduit ByteString m ByteString
-> Conduit ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Conduit ByteString m ByteString
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
a
EncFuncPart
-> EncFuncFinal -> ByteString -> Conduit ByteString m ByteString
forall (m :: * -> *).
Monad m =>
EncFuncPart
-> EncFuncFinal -> ByteString -> Conduit ByteString m ByteString
encodeI EncFuncPart
enc_part EncFuncFinal
enc_final ByteString
b
decodeI :: (Monad m, MonadThrow m) => DecFunc -> DecFuncFinal -> ByteString -> Conduit ByteString m ByteString
decodeI :: DecFunc
-> EncFuncFinal -> ByteString -> Conduit ByteString m ByteString
decodeI DecFunc
dec_part EncFuncFinal
dec_final ByteString
i = do
Maybe ByteString
enc <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
case Maybe ByteString
enc of
Maybe ByteString
Nothing ->
case EncFuncFinal
dec_final ByteString
i of
Maybe ByteString
Nothing -> CodecDecodeException -> Conduit ByteString m ByteString
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ByteString -> CodecDecodeException
CodecDecodeException ByteString
i)
Just ByteString
s -> Conduit ByteString m ByteString -> Conduit ByteString m ByteString
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> Conduit ByteString m ByteString
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
s)
Just ByteString
s ->
case DecFunc
dec_part (ByteString
i ByteString -> ByteString -> ByteString
`append` ByteString
s) of
Left (ByteString
a, ByteString
b) -> do
Bool
-> Conduit ByteString m ByteString
-> Conduit ByteString m ByteString
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
a) (Conduit ByteString m ByteString
-> Conduit ByteString m ByteString)
-> Conduit ByteString m ByteString
-> Conduit ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Conduit ByteString m ByteString
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
a
CodecDecodeException -> Conduit ByteString m ByteString
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ByteString -> CodecDecodeException
CodecDecodeException ByteString
b)
Right (ByteString
a, ByteString
b) -> do
Bool
-> Conduit ByteString m ByteString
-> Conduit ByteString m ByteString
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
a) (Conduit ByteString m ByteString
-> Conduit ByteString m ByteString)
-> Conduit ByteString m ByteString
-> Conduit ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Conduit ByteString m ByteString
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
a
DecFunc
-> EncFuncFinal -> ByteString -> Conduit ByteString m ByteString
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecFunc
-> EncFuncFinal -> ByteString -> Conduit ByteString m ByteString
decodeI DecFunc
dec_part EncFuncFinal
dec_final ByteString
b
encodeII :: (Monad m) => EncFunc -> Conduit ByteString m ByteString
encodeII :: (ByteString -> ByteString) -> Conduit ByteString m ByteString
encodeII ByteString -> ByteString
enc = do
Maybe ByteString
clear <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
case Maybe ByteString
clear of
Maybe ByteString
Nothing -> () -> Conduit ByteString m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ByteString
s -> do
ByteString -> Conduit ByteString m ByteString
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> Conduit ByteString m ByteString)
-> ByteString -> Conduit ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
enc ByteString
s
(ByteString -> ByteString) -> Conduit ByteString m ByteString
forall (m :: * -> *).
Monad m =>
(ByteString -> ByteString) -> Conduit ByteString m ByteString
encodeII ByteString -> ByteString
enc
decodeII :: (Monad m, MonadThrow m) => DecFunc -> ByteString -> Conduit ByteString m ByteString
decodeII :: DecFunc -> ByteString -> Conduit ByteString m ByteString
decodeII DecFunc
dec ByteString
i = do
Maybe ByteString
enc <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
case Maybe ByteString
enc of
Maybe ByteString
Nothing -> Bool
-> Conduit ByteString m ByteString
-> Conduit ByteString m ByteString
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
i) (CodecDecodeException -> Conduit ByteString m ByteString
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CodecDecodeException -> Conduit ByteString m ByteString)
-> CodecDecodeException -> Conduit ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> CodecDecodeException
CodecDecodeException ByteString
i)
Just ByteString
s -> case DecFunc
dec DecFunc -> DecFunc
forall a b. (a -> b) -> a -> b
$ ByteString
i ByteString -> ByteString -> ByteString
`append` ByteString
s of
Left (ByteString
c, ByteString
b) -> do
Bool
-> Conduit ByteString m ByteString
-> Conduit ByteString m ByteString
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
c) (Conduit ByteString m ByteString
-> Conduit ByteString m ByteString)
-> Conduit ByteString m ByteString
-> Conduit ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Conduit ByteString m ByteString
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
c
CodecDecodeException -> Conduit ByteString m ByteString
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CodecDecodeException -> Conduit ByteString m ByteString)
-> CodecDecodeException -> Conduit ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> CodecDecodeException
CodecDecodeException ByteString
b
Right (ByteString
c, ByteString
r) -> do
Bool
-> Conduit ByteString m ByteString
-> Conduit ByteString m ByteString
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
c) (Conduit ByteString m ByteString
-> Conduit ByteString m ByteString)
-> Conduit ByteString m ByteString
-> Conduit ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Conduit ByteString m ByteString
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
c
DecFunc -> ByteString -> Conduit ByteString m ByteString
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecFunc -> ByteString -> Conduit ByteString m ByteString
decodeII DecFunc
dec ByteString
r