module Data.Conduit.Cereal ( GetException
, sinkGet
, conduitGet
, sourcePut
, conduitPut
) where
import Control.Exception.Base
import Control.Monad.Trans.Class (MonadTrans, lift)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import Data.Serialize hiding (get, put)
import Data.Typeable
import Data.Conduit.Cereal.Internal
data GetException = GetException String
deriving (Show, Typeable)
instance Exception GetException
conduitGet :: C.MonadThrow m => Get o -> C.Conduit BS.ByteString m o
conduitGet = mkConduitGet errorHandler
where errorHandler msg = pipeError $ GetException msg
sinkGet :: C.MonadThrow m => Get r -> C.Consumer BS.ByteString m r
sinkGet = mkSinkGet errorHandler terminationHandler
where errorHandler msg = pipeError $ GetException msg
terminationHandler f = let Fail msg = f BS.empty in pipeError $ GetException msg
pipeError :: (C.MonadThrow m, MonadTrans t, Exception e) => e -> t m a
pipeError e = lift $ C.monadThrow e
sourcePut :: Monad m => Put -> C.Producer m BS.ByteString
sourcePut put = CL.sourceList $ LBS.toChunks $ runPutLazy put
conduitPut :: Monad m => Putter a -> C.Conduit a m BS.ByteString
conduitPut p = CL.map $ runPut . p