{-# LANGUAGE DeriveDataTypeable #-}
-- |
-- Module: Data.Conduit.Codec.Util
-- Copyright: (c) 2014 Magnus Therning
-- License: BSD3

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