module Data.Conduit.Cereal.Temp (conduitGet) where import Control.Exception (throw) import Control.Monad.Trans import qualified Data.ByteString as BS import qualified Data.Conduit as DC import Data.Conduit.Cereal import Data.Serialize import Data.Serialize.Get conduitGet :: (DC.ResourceThrow m, Serialize output) => Get output -> DC.Conduit BS.ByteString m output conduitGet f = do let acceptable = case runGetPartial f BS.empty of Data.Serialize.Fail s -> throw $ GetException s Data.Serialize.Partial f -> True Data.Serialize.Done _ _ -> throw GetDoesntConsumeInput if acceptable then DC.conduitState BS.empty (push f) (close f) else undefined where push :: (DC.ResourceThrow m, Serialize a) => Get a -> BS.ByteString -> BS.ByteString -> DC.ResourceT m (DC.ConduitStateResult BS.ByteString BS.ByteString a) push f state input = (\(as, bs) -> return $ DC.StateProducing bs as) (go f ([], state `BS.append` input)) close :: (DC.ResourceThrow m, Serialize a) => Get a -> BS.ByteString -> DC.ResourceT m [a] close f state = return [] go :: Serialize a => Get a -> ([a], BS.ByteString) -> ([a], BS.ByteString) go f (as, bs) | BS.null bs = (as, bs) | otherwise = case runGetState f bs 0 of Left err -> (as, bs) Right (a, b) -> go f (as ++ [a], b)