{-# 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 (ConduitT, 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 -> ConduitT ByteString ByteString m ()
encodeI :: EncFuncPart
-> EncFuncFinal
-> ByteString
-> ConduitT ByteString ByteString m ()
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 -> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> ConduitT ByteString ByteString m ())
-> ByteString -> ConduitT ByteString ByteString m ()
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
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
a) (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
a
EncFuncPart
-> EncFuncFinal
-> ByteString
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
EncFuncPart
-> EncFuncFinal
-> ByteString
-> ConduitT ByteString ByteString m ()
encodeI EncFuncPart
enc_part EncFuncFinal
enc_final ByteString
b
decodeI :: (Monad m, MonadThrow m) => DecFunc -> DecFuncFinal -> ByteString -> ConduitT ByteString ByteString m ()
decodeI :: DecFunc
-> EncFuncFinal
-> ByteString
-> ConduitT ByteString ByteString m ()
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 -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ByteString -> CodecDecodeException
CodecDecodeException ByteString
i)
Just ByteString
s -> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> ConduitT ByteString ByteString m ()
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
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
a) (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
a
CodecDecodeException -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ByteString -> CodecDecodeException
CodecDecodeException ByteString
b)
Right (ByteString
a, ByteString
b) -> do
Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
a) (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
a
DecFunc
-> EncFuncFinal
-> ByteString
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecFunc
-> EncFuncFinal
-> ByteString
-> ConduitT ByteString ByteString m ()
decodeI DecFunc
dec_part EncFuncFinal
dec_final ByteString
b
encodeII :: (Monad m) => EncFunc -> ConduitT ByteString ByteString m ()
encodeII :: (ByteString -> ByteString) -> ConduitT ByteString ByteString m ()
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 -> () -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ByteString
s -> do
ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> ConduitT ByteString ByteString m ())
-> ByteString -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
enc ByteString
s
(ByteString -> ByteString) -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
(ByteString -> ByteString) -> ConduitT ByteString ByteString m ()
encodeII ByteString -> ByteString
enc
decodeII :: (Monad m, MonadThrow m) => DecFunc -> ByteString -> ConduitT ByteString ByteString m ()
decodeII :: DecFunc -> ByteString -> ConduitT ByteString ByteString m ()
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
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
i) (CodecDecodeException -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CodecDecodeException -> ConduitT ByteString ByteString m ())
-> CodecDecodeException -> ConduitT ByteString ByteString m ()
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
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
c) (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
c
CodecDecodeException -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CodecDecodeException -> ConduitT ByteString ByteString m ())
-> CodecDecodeException -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> CodecDecodeException
CodecDecodeException ByteString
b
Right (ByteString
c, ByteString
r) -> do
Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
c) (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
c
DecFunc -> ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(Monad m, MonadThrow m) =>
DecFunc -> ByteString -> ConduitT ByteString ByteString m ()
decodeII DecFunc
dec ByteString
r