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