cereal-conduit 0.0.6.1 → 0.5
raw patch · 4 files changed
+249/−221 lines, 4 filesdep +resourcetdep −exception-transformersdep −test-framework-hunitdep −transformersPVP ok
version bump matches the API change (PVP)
Dependencies added: resourcet
Dependencies removed: exception-transformers, test-framework-hunit, transformers
API changes (from Hackage documentation)
+ Data.Conduit.Cereal: conduitPut :: Monad m => Putter input -> Conduit input m ByteString
- Data.Conduit.Cereal: conduitGet :: MonadException m => Get output -> Conduit ByteString m output
+ Data.Conduit.Cereal: conduitGet :: MonadThrow m => Get output -> Conduit ByteString m output
- Data.Conduit.Cereal: sinkGet :: MonadException m => Get r -> Sink ByteString m r
+ Data.Conduit.Cereal: sinkGet :: MonadThrow m => Get r -> Sink ByteString m r
Files
- Data/Conduit/Cereal.hs +19/−9
- Test/CerealConduit.hs +0/−202
- Test/Main.hs +221/−0
- cereal-conduit.cabal +9/−10
Data/Conduit/Cereal.hs view
@@ -7,24 +7,30 @@ -- -- The default 'ErrorHandler' and 'TerminationHandler' both throw a 'GetException'. -module Data.Conduit.Cereal (GetException, sinkGet, conduitGet, sourcePut) where +module Data.Conduit.Cereal ( GetException + , sinkGet + , conduitGet + , sourcePut + , conduitPut + ) where -import Control.Monad.Exception +import Control.Exception.Base import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Conduit as C -import Data.Conduit.Cereal.Internal -import Data.Conduit.List (sourceList) +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 -- | Run a 'Get' repeatedly on the input stream, producing an output stream of whatever the 'Get' outputs. -conduitGet :: MonadException m => Get output -> C.Conduit BS.ByteString m output +conduitGet :: C.MonadThrow m => Get output -> C.Conduit BS.ByteString m output conduitGet = mkConduitGet errorHandler where errorHandler msg _ = pipeError $ GetException msg @@ -32,14 +38,18 @@ -- -- If 'Get' succeed it will return the data read and unconsumed part of the input stream. -- If the 'Get' fails due to deserialization error or early termination of the input stream it raise an error. -sinkGet :: MonadException m => Get r -> C.Sink BS.ByteString m r +sinkGet :: C.MonadThrow m => Get r -> C.Sink 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 :: (MonadException m, Exception e) => e -> C.Pipe i o m r -pipeError e = C.PipeM (throw e) undefined +pipeError :: (C.MonadThrow m, Exception e) => e -> C.Pipe i o m r +pipeError e = C.PipeM (C.monadThrow e) undefined -- | Convert a 'Put' into a 'Source'. Runs in constant memory. sourcePut :: Monad m => Put -> C.Source m BS.ByteString -sourcePut put = sourceList $ LBS.toChunks $ runPutLazy put +sourcePut put = CL.sourceList $ LBS.toChunks $ runPutLazy put + +-- | Run a 'Putter' repeatedly on the input stream, producing a concatenated 'ByteString' stream. +conduitPut :: Monad m => Putter input -> C.Conduit input m BS.ByteString +conduitPut p = CL.map $ runPut . p
− Test/CerealConduit.hs
@@ -1,202 +0,0 @@-{-# LANGUAGE FlexibleContexts, RankNTypes #-}--module Test.CerealConduit where--import Control.Monad.Identity-import Control.Monad.Exception-import Control.Monad.Error-import Control.Monad.Trans.Maybe-import Test.HUnit-import qualified Data.Conduit as C-import Data.Conduit.Cereal-import Data.Conduit.Cereal.Internal -import Data.Conduit.List as CL-import Data.Serialize-import qualified Data.ByteString as BS---import Test.Framework.Providers.HUnit-import System.Exit-import Data.Word-import qualified Data.List as L-import Prelude hiding (take)---- For the sake of these tests, all SomeExceptions are equal-instance Eq SomeException where- a == b = True--twoItemGet :: Get Word8-twoItemGet = do- x <- getWord8- y <- getWord8- return $ x + y--sinktest1 :: Test-sinktest1 = TestCase (assertEqual "Handles starting with empty bytestring"- (Right 1)- (runIdentity $ runExceptionT $ (sourceList [BS.pack [], BS.pack [1]]) C.$$ (sinkGet getWord8)))--sinktest2 :: Test-sinktest2 = TestCase (assertEqual "Handles empty bytestring in middle"- (Right [1, 3])- (runIdentity $ runExceptionT $ (sourceList [BS.pack [1], BS.pack [], BS.pack [3]]) C.$$ (sinkGet (do- x <- getWord8- y <- getWord8- return [x, y]))))--sinktest3 :: Test-sinktest3 = TestCase (assertBool "Handles no data"- (case runIdentity $ runExceptionT $ (sourceList []) C.$$ (sinkGet getWord8) of- Right _ -> False- Left _ -> True))--sinktest4 :: Test-sinktest4 = TestCase (assertEqual "Consumes no data"- (Right ())- (runIdentity $ runExceptionT $ (sourceList [BS.pack [1]]) C.$$ (sinkGet $ return ())))--sinktest5 :: Test-sinktest5 = TestCase (assertEqual "Empty list"- (Right ())- (runIdentity $ runExceptionT $ (sourceList []) C.$$ (sinkGet $ return ())))--sinktest6 :: Test-sinktest6 = TestCase (assertEqual "Leftover input works"- (Right (1, BS.pack [2, 3, 4, 5]))- (runIdentity $ runExceptionT $ (sourceList [BS.pack [1, 2, 3], BS.pack [4, 5]]) C.$$ (do- output <- sinkGet getWord8- output' <- CL.consume- return (output, BS.concat output'))))---- Current sink implementation will terminate the pipe in case of error. --- One may need non-terminating version like one defined below to get access to Leftovers--sinkGetMaybe :: Monad m => Get output -> C.Sink BS.ByteString m (Maybe output)-sinkGetMaybe = mkSinkGet errorHandler terminationHandler . fmap Just- where errorHandler msg s = C.Done s Nothing- terminationHandler f s = C.Done s Nothing--sinktest7 :: Test-sinktest7 = TestCase (assertBool "Leftover input with failure works"- (case runIdentity $ do- (sourceList [BS.pack [1, 2]]) C.$$ (do- output <- sinkGetMaybe (getWord8 >> fail "" :: Get Word8)- output' <- CL.consume- return (output, BS.concat output')) of- (Nothing, bs) -> bs == BS.pack [1, 2]- otherwise -> False))--conduittest1 :: Test-conduittest1 = TestCase (assertEqual "Handles starting with empty bytestring"- (Right [])- (runIdentity $ runExceptionT $ (sourceList [BS.pack [], BS.pack [1]]) C.$= conduitGet twoItemGet C.$$ CL.consume))--conduittest2 :: Test-conduittest2 = TestCase (assertEqual "Works when the get is split across items"- (Right [3])- (runIdentity $ runExceptionT $ (sourceList [BS.pack [1], BS.pack [2]]) C.$= conduitGet twoItemGet C.$$ CL.consume))--conduittest3 :: Test-conduittest3 = TestCase (assertEqual "Works when empty bytestring in middle of get"- (Right [3])- (runIdentity $ runExceptionT $ (sourceList [BS.pack [1], BS.pack [], BS.pack [2]]) C.$= conduitGet twoItemGet C.$$ CL.consume))--conduittest4 :: Test-conduittest4 = TestCase (assertEqual "Works when empty bytestring at end of get"- (Right [3])- (runIdentity $ runExceptionT $ (sourceList [BS.pack [1, 2], BS.pack []]) C.$= conduitGet twoItemGet C.$$ CL.consume))--conduittest5 :: Test-conduittest5 = TestCase (assertEqual "Works when multiple gets are in an item"- (Right [3, 7])- (runIdentity $ runExceptionT $ (sourceList [BS.pack [1, 2, 3, 4]]) C.$= conduitGet twoItemGet C.$$ CL.consume))--conduittest6 :: Test-conduittest6 = TestCase (assertEqual "Works with leftovers"- (Right [3])- (runIdentity $ runExceptionT $ (sourceList [BS.pack [1, 2, 3]]) C.$= conduitGet twoItemGet C.$$ CL.consume))--conduittest7 :: Test-conduittest7 = let c = 10 in TestCase (assertEqual "Works with infinite lists"- (Right $ L.replicate c ())- (runIdentity $ runExceptionT $ (sourceList [BS.pack [1, 2, 3]]) C.$= conduitGet (return ()) C.$$ take c))--conduittest8 :: Test-conduittest8 = let c = 10 in TestCase (assertEqual "Works with empty source and infinite lists"- (Right $ L.replicate c ())- (runIdentity $ runExceptionT $ (sourceList []) C.$= conduitGet (return ()) C.$$ take c))--conduittest9 :: Test-conduittest9 = let c = 10 in TestCase (assertEqual "Works with two well-placed items"- (Right [3, 7])- (runIdentity $ runExceptionT $ (sourceList [BS.pack [1, 2], BS.pack [3, 4]]) C.$= conduitGet twoItemGet C.$$ CL.consume))--conduittest10 :: Test-conduittest10 = TestCase (assertBool "Failure works"- (case runIdentity $ runExceptionT $ (sourceList [BS.pack [1, 2], BS.pack [3, 4]]) C.$= conduitGet (getWord8 >> fail "omfg") C.$$ CL.consume of- Left _ -> True- Right _ -> False))--conduittest11 :: Test-conduittest11 = TestCase (assertBool "Immediate failure works"- (case runIdentity $ runExceptionT $ (sourceList [BS.pack [1, 2], BS.pack [3, 4]]) C.$= conduitGet (fail "omfg") C.$$ CL.consume of- Left _ -> True- Right _ -> False))--conduittest12 :: Test-conduittest12 = TestCase (assertBool "Immediate failure with empty input works"- (case runIdentity $ runExceptionT $ (sourceList []) C.$= conduitGet (fail "omfg") C.$$ CL.consume of- Left _ -> True- Right _ -> False))--{---- This test CAN'T work because of the type of HaveOutput.-conduittest13 :: Test-conduittest13 = TestCase (assertEqual "Leftover success conduit input works"- ([12], BS.pack [3, 4, 5])- (runIdentity $ (sourceList [BS.pack [10, 2, 3], BS.pack [4, 5]]) C.$$ (do- output <- (conduitGet twoItemGet) C.=$ (CL.take 1)- output' <- CL.consume- return (output, BS.concat output'))))--}--conduittest14 :: Test-conduittest14 = TestCase (assertEqual "Leftover failure conduit input works"- (Right ([], BS.singleton 1))- (runIdentity $ runExceptionT $ (sourceList [BS.singleton 1]) C.$$ (do- output <- (conduitGet twoItemGet) C.=$ (CL.take 1)- output' <- CL.consume- return (output, BS.concat output'))))--sinktests = TestList [ sinktest1- , sinktest2- , sinktest3- , sinktest4- , sinktest5- , sinktest6- , sinktest7- ]--conduittests = TestList [ conduittest1- , conduittest2- , conduittest3- , conduittest4- , conduittest5- , conduittest6- , conduittest7- , conduittest8- , conduittest9- , conduittest10- , conduittest11- , conduittest12- --, conduittest13- , conduittest14- ]--hunittests = TestList [sinktests, conduittests]----tests = hUnitTestToTests hunittests--main = do- counts <- runTestTT hunittests- if errors counts == 0 && failures counts == 0- then exitSuccess- else exitFailure
+ Test/Main.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE FlexibleContexts #-}++import Control.Exception.Base+import Control.Monad.Identity+import Control.Monad.Trans.Resource+import Test.HUnit+import qualified Data.Conduit as C+import qualified Data.Conduit.List as CL+import Data.Serialize+import qualified Data.ByteString as BS+import qualified Data.List as L+import Data.Word+import System.Exit+--import Test.Framework.Providers.HUnit++import Data.Conduit.Cereal+import Data.Conduit.Cereal.Internal ++-- For the sake of these tests, all SomeExceptions are equal+instance Eq SomeException where+ a == b = True++twoItemGet :: Get Word8+twoItemGet = do+ x <- getWord8+ y <- getWord8+ return $ x + y++putter :: Putter Char+putter c = put x >> put (x + 1)+ where x = (fromIntegral $ (fromEnum c) - (fromEnum 'a') :: Word8)++sinktest1 :: Test+sinktest1 = TestCase (assertEqual "Handles starting with empty bytestring"+ (Right 1)+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [], BS.pack [1]]) C.$$ (sinkGet getWord8)))++sinktest2 :: Test+sinktest2 = TestCase (assertEqual "Handles empty bytestring in middle"+ (Right [1, 3])+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1], BS.pack [], BS.pack [3]]) C.$$ (sinkGet (do+ x <- getWord8+ y <- getWord8+ return [x, y]))))++sinktest3 :: Test+sinktest3 = TestCase (assertBool "Handles no data"+ (case runIdentity $ runExceptionT $ (CL.sourceList []) C.$$ (sinkGet getWord8) of+ Right _ -> False+ Left _ -> True))++sinktest4 :: Test+sinktest4 = TestCase (assertEqual "Consumes no data"+ (Right ())+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1]]) C.$$ (sinkGet $ return ())))++sinktest5 :: Test+sinktest5 = TestCase (assertEqual "Empty list"+ (Right ())+ (runIdentity $ runExceptionT $ (CL.sourceList []) C.$$ (sinkGet $ return ())))++sinktest6 :: Test+sinktest6 = TestCase (assertEqual "Leftover input works"+ (Right (1, BS.pack [2, 3, 4, 5]))+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1, 2, 3], BS.pack [4, 5]]) C.$$ (do+ output <- sinkGet getWord8+ output' <- CL.consume+ return (output, BS.concat output'))))++-- Current sink implementation will terminate the pipe in case of error. +-- One may need non-terminating version like one defined below to get access to Leftovers++sinkGetMaybe :: Monad m => Get output -> C.Sink BS.ByteString m (Maybe output)+sinkGetMaybe = mkSinkGet errorHandler terminationHandler . fmap Just+ where errorHandler msg s = C.Done s Nothing+ terminationHandler f s = C.Done s Nothing++sinktest7 :: Test+sinktest7 = TestCase (assertBool "Leftover input with failure works"+ (case runIdentity $ do+ (CL.sourceList [BS.pack [1, 2]]) C.$$ (do+ output <- sinkGetMaybe (getWord8 >> fail "" :: Get Word8)+ output' <- CL.consume+ return (output, BS.concat output')) of+ (Nothing, bs) -> bs == BS.pack [1, 2]+ otherwise -> False))++conduittest1 :: Test+conduittest1 = TestCase (assertEqual "Handles starting with empty bytestring"+ (Right [])+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [], BS.pack [1]]) C.$= conduitGet twoItemGet C.$$ CL.consume))++conduittest2 :: Test+conduittest2 = TestCase (assertEqual "Works when the get is split across items"+ (Right [3])+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1], BS.pack [2]]) C.$= conduitGet twoItemGet C.$$ CL.consume))++conduittest3 :: Test+conduittest3 = TestCase (assertEqual "Works when empty bytestring in middle of get"+ (Right [3])+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1], BS.pack [], BS.pack [2]]) C.$= conduitGet twoItemGet C.$$ CL.consume))++conduittest4 :: Test+conduittest4 = TestCase (assertEqual "Works when empty bytestring at end of get"+ (Right [3])+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1, 2], BS.pack []]) C.$= conduitGet twoItemGet C.$$ CL.consume))++conduittest5 :: Test+conduittest5 = TestCase (assertEqual "Works when multiple gets are in an item"+ (Right [3, 7])+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1, 2, 3, 4]]) C.$= conduitGet twoItemGet C.$$ CL.consume))++conduittest6 :: Test+conduittest6 = TestCase (assertEqual "Works with leftovers"+ (Right [3])+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1, 2, 3]]) C.$= conduitGet twoItemGet C.$$ CL.consume))++conduittest7 :: Test+conduittest7 = let c = 10 in TestCase (assertEqual "Works with infinite lists"+ (Right $ L.replicate c ())+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1, 2, 3]]) C.$= conduitGet (return ()) C.$$ CL.take c))++conduittest8 :: Test+conduittest8 = let c = 10 in TestCase (assertEqual "Works with empty source and infinite lists"+ (Right $ L.replicate c ())+ (runIdentity $ runExceptionT $ (CL.sourceList []) C.$= conduitGet (return ()) C.$$ CL.take c))++conduittest9 :: Test+conduittest9 = let c = 10 in TestCase (assertEqual "Works with two well-placed items"+ (Right [3, 7])+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1, 2], BS.pack [3, 4]]) C.$= conduitGet twoItemGet C.$$ CL.consume))++conduittest10 :: Test+conduittest10 = TestCase (assertBool "Failure works"+ (case runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1, 2], BS.pack [3, 4]]) C.$= conduitGet (getWord8 >> fail "omfg") C.$$ CL.consume of+ Left _ -> True+ Right _ -> False))++conduittest11 :: Test+conduittest11 = TestCase (assertBool "Immediate failure works"+ (case runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1, 2], BS.pack [3, 4]]) C.$= conduitGet (fail "omfg") C.$$ CL.consume of+ Left _ -> True+ Right _ -> False))++conduittest12 :: Test+conduittest12 = TestCase (assertBool "Immediate failure with empty input works"+ (case runIdentity $ runExceptionT $ (CL.sourceList []) C.$= conduitGet (fail "omfg") C.$$ CL.consume of+ Left _ -> True+ Right _ -> False))++-- This test CAN'T work because of the type of HaveOutput.+conduittest13 :: Test+conduittest13 = TestCase (assertEqual "Leftover success conduit input works"+ (Right ([12], BS.pack [3, 4, 5]))+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [10, 2, 3], BS.pack [4, 5]]) C.$$ (do+ output <- (conduitGet twoItemGet) C.=$ (CL.take 1)+ output' <- CL.consume+ return (output, BS.concat output'))))++conduittest14 :: Test+conduittest14 = TestCase (assertEqual "Leftover failure conduit input works"+ (Right ([], BS.singleton 1))+ (runIdentity $ runExceptionT $ (CL.sourceList [BS.singleton 1]) C.$$ (do+ output <- (conduitGet twoItemGet) C.=$ (CL.take 1)+ output' <- CL.consume+ return (output, BS.concat output'))))++puttest1 :: Test+puttest1 = TestCase (assertEqual "conduitPut works"+ [BS.pack [0, 1]]+ (runIdentity $ (CL.sourceList ['a']) C.$= (conduitPut putter) C.$$ CL.consume))++puttest2 :: Test+puttest2 = TestCase (assertEqual "multiple input conduitPut works"+ [BS.pack [0, 1], BS.pack [1, 2], BS.pack [2, 3]]+ (runIdentity $ (CL.sourceList ['a', 'b', 'c']) C.$= (conduitPut putter) C.$$ CL.consume))++puttest3 :: Test+puttest3 = TestCase (assertEqual "empty input conduitPut works"+ []+ (runIdentity $ (CL.sourceList []) C.$= (conduitPut putter) C.$$ CL.consume))++sinktests = TestList [ sinktest1+ , sinktest2+ , sinktest3+ , sinktest4+ , sinktest5+ , sinktest6+ , sinktest7+ ]++conduittests = TestList [ conduittest1+ , conduittest2+ , conduittest3+ , conduittest4+ , conduittest5+ , conduittest6+ , conduittest7+ , conduittest8+ , conduittest9+ , conduittest10+ , conduittest11+ , conduittest12+ --, conduittest13+ , conduittest14+ ]++puttests = TestList [ puttest1+ , puttest2+ , puttest3+ ]++hunittests = TestList [sinktests, conduittests, puttests]++--tests = hUnitTestToTests hunittests++main = do+ counts <- runTestTT hunittests+ if errors counts == 0 && failures counts == 0+ then exitSuccess+ else exitFailure
cereal-conduit.cabal view
@@ -1,5 +1,5 @@ name: cereal-conduit-version: 0.0.6.1+version: 0.5 license: BSD3 license-file: LICENSE author: Myles C. Maxfield <myles.maxfield@gmail.com>@@ -13,28 +13,27 @@ homepage: https://github.com/litherum/cereal-conduit library- build-depends: base >= 4 && < 5- , conduit >= 0.4.0 && < 0.5.0- , cereal >= 0.3.1.0- , mtl+ build-depends: base >= 4 && < 5+ , conduit >= 0.4.0 && < 0.5.0+ , cereal >= 0.3.1.0 , bytestring , void- , exception-transformers exposed-modules: Data.Conduit.Cereal , Data.Conduit.Cereal.Internal ghc-options: -Wall Test-Suite test-cereal-conduit type: exitcode-stdio-1.0- main-is: Test/CerealConduit.hs+ main-is: Test/Main.hs build-depends: base >= 4 && < 5 , conduit >= 0.4.0 && < 0.5.0 , cereal >= 0.3.1.0- , mtl , bytestring- , test-framework-hunit+ --, test-framework-hunit , HUnit- , transformers+ , void+ , resourcet+ , mtl source-repository head type: git