cereal-conduit-0.7.2.3/0000755000000000000000000000000012377371663012764 5ustar0000000000000000cereal-conduit-0.7.2.3/LICENSE0000644000000000000000000000253212377371663013773 0ustar0000000000000000The following license covers this documentation, and the source code, except where otherwise indicated. Copyright 2012, Myles C. Maxfield. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cereal-conduit-0.7.2.3/Setup.lhs0000644000000000000000000000011612377371663014572 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain cereal-conduit-0.7.2.3/cereal-conduit.cabal0000644000000000000000000000270412377371663016651 0ustar0000000000000000name: cereal-conduit version: 0.7.2.3 license: BSD3 license-file: LICENSE author: Myles C. Maxfield maintainer: Michael Snoyman synopsis: Turn Data.Serialize Gets and Puts into Sources, Sinks, and Conduits description: Turn Data.Serialize Gets and Puts into Sources, Sinks, and Conduits. . [0.7] Upgrade to conduit 1.0.0 category: Conduit stability: Experimental cabal-version: >= 1.8 build-type: Simple homepage: https://github.com/snoyberg/conduit bug-reports: https://github.com/snoyberg/conduit/issues library build-depends: base >= 4 && < 5 , conduit >= 1.0.0 && < 1.3 , resourcet >= 0.4 && < 1.2 , cereal >= 0.4.0.0 && < 0.5 , bytestring , transformers >= 0.2.0.0 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/Main.hs build-depends: base , conduit , cereal , bytestring --, test-framework-hunit , HUnit , resourcet , mtl , transformers source-repository head type: git location: git://github.com/snoyberg/conduit.git cereal-conduit-0.7.2.3/Test/0000755000000000000000000000000012377371663013703 5ustar0000000000000000cereal-conduit-0.7.2.3/Test/Main.hs0000644000000000000000000002511012377371663015122 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Rank2Types #-} import Control.Applicative (many) 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 threeItemGet :: Get Word8 threeItemGet = do x <- getWord8 y <- getWord8 z <- getWord8 return $ x + y + z 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 :: Get Word8 -> C.Consumer BS.ByteString (ExceptionT Identity) Word8 sinkGetMaybe = mkSinkGet errorHandler terminationHandler where errorHandler _ = return 34 terminationHandler _ = return 114 sinktest7 :: Test sinktest7 = TestCase (assertEqual "Leftover input with failure works" (Right (34, BS.pack [1, 2])) (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [1, 2]]) C.$$ (do output <- sinkGetMaybe (getWord8 >> fail "" :: Get Word8) output' <- CL.consume return (output, BS.concat output')))) sinktest8 :: Test sinktest8 = TestCase (assertEqual "Leftover with incomplete input works" (Right (114, BS.singleton 1)) (runIdentity $ runExceptionT $ (CL.sourceList [BS.singleton 1]) C.$$ (do output <- sinkGetMaybe twoItemGet output' <- CL.consume return (output, BS.concat output')))) sinktest9 :: Test sinktest9 = TestCase (assertEqual "Properly terminate Partials" (Right [0..255]) (runIdentity $ runExceptionT $ mapM_ (C.yield . BS.singleton) [0..255] C.$$ sinkGet (many getWord8))) 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)) conduittest13 :: Test conduittest13 = TestCase (assertEqual "Leftover success conduit input works" (Right [Right 12, Right 7, Left (BS.pack [5])]) (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [10, 2, 3], BS.pack [4, 5]]) C.$= fancyConduit C.$$ CL.consume)) where fancyConduit = do conduitGet twoItemGet C.=$= CL.map (\ x -> Right x) recurse where recurse = C.await >>= maybe (return ()) (\ x -> C.yield (Left x) >> recurse) conduittest14 :: Test conduittest14 = TestCase (assertEqual "Leftover coercing works" (Right [Left (BS.pack [10, 2])]) (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [10], BS.pack [2]]) C.$= fancyConduit C.$$ CL.consume)) where fancyConduit = do conduitGet threeItemGet C.=$= CL.map (\ x -> Right x) recurse where recurse = C.await >>= maybe (return ()) (\ x -> C.yield (Left x) >> recurse) conduittest15 :: Test conduittest15 = TestCase (assertEqual "Leftover premature end 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')))) conduittest16 :: Test conduittest16 = TestCase (assertEqual "Leftover failure conduit input works" (Right [Left $ BS.pack [10, 11], Left $ BS.singleton 2]) (runIdentity $ runExceptionT $ (CL.sourceList [BS.pack [10, 11], BS.pack [2]]) C.$= fancyConduit C.$$ CL.consume)) where fancyConduit = do mkConduitGet (const $ return ()) (getWord8 >> fail "asdf" :: Get Word8) C.=$= CL.map (\ x -> Right x) recurse where recurse = C.await >>= maybe (return ()) (\ x -> C.yield (Left x) >> recurse) conduittest17 :: Test conduittest17 = TestCase (assertEqual "Leftover failure conduit with broken input works" (Right [Left $ BS.pack [10, 11], Left $ BS.singleton 12]) (runIdentity $ runExceptionT $ (CL.sourceList [BS.singleton 10, BS.singleton 11, BS.singleton 12]) C.$= fancyConduit C.$$ CL.consume)) where fancyConduit = do mkConduitGet (const $ return ()) (twoItemGet >> fail "asdf" :: Get Word8) C.=$= CL.map (\ x -> Right x) recurse where recurse = C.await >>= maybe (return ()) (\ x -> C.yield (Left x) >> recurse) 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 , sinktest8 , sinktest9 ] conduittests = TestList [ conduittest1 , conduittest2 , conduittest3 , conduittest4 , conduittest5 , conduittest6 , conduittest7 , conduittest8 , conduittest9 , conduittest10 , conduittest11 , conduittest12 , conduittest13 , conduittest14 , conduittest15 , conduittest16 , conduittest17 ] 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-0.7.2.3/Data/0000755000000000000000000000000012377371663013635 5ustar0000000000000000cereal-conduit-0.7.2.3/Data/Conduit/0000755000000000000000000000000012377371663015242 5ustar0000000000000000cereal-conduit-0.7.2.3/Data/Conduit/Cereal.hs0000644000000000000000000000531012377371663016770 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE RankNTypes #-} -- | Turn a 'Get' into a 'Sink' and a 'Put' into a 'Source' -- These functions are built upno the Data.Conduit.Cereal.Internal functions with default -- implementations of 'ErrorHandler' and 'TerminationHandler' -- -- The default 'ErrorHandler' and 'TerminationHandler' both throw a 'GetException'. module Data.Conduit.Cereal ( GetException , sinkGet , conduitGet , sourcePut , conduitPut ) where import Control.Exception.Base import Control.Monad.Trans.Class (MonadTrans, lift) import Control.Monad.Trans.Resource (MonadThrow, monadThrow) 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 -- | Run a 'Get' repeatedly on the input stream, producing an output stream of whatever the 'Get' outputs. conduitGet :: MonadThrow m => Get o -> C.Conduit BS.ByteString m o conduitGet = mkConduitGet errorHandler where errorHandler msg = pipeError $ GetException msg -- | Convert a 'Get' into a 'Sink'. The 'Get' will be streamed bytes until it returns 'Done' or 'Fail'. -- -- 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 :: MonadThrow m => Get r -> C.Consumer BS.ByteString m r sinkGet = mkSinkGet errorHandler terminationHandler where errorHandler msg = pipeError $ GetException msg terminationHandler f = case f BS.empty of Fail msg _ -> pipeError $ GetException msg Done r lo -> C.leftover lo >> return r Partial _ -> pipeError $ GetException "Failed reading: Internal error: unexpected Partial." pipeError :: (MonadThrow m, MonadTrans t, Exception e) => e -> t m a pipeError e = lift $ monadThrow e -- | Convert a 'Put' into a 'Source'. Runs in constant memory. sourcePut :: Monad m => Put -> C.Producer m BS.ByteString 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 a -> C.Conduit a m BS.ByteString conduitPut p = CL.map $ runPut . p cereal-conduit-0.7.2.3/Data/Conduit/Cereal/0000755000000000000000000000000012377371663016435 5ustar0000000000000000cereal-conduit-0.7.2.3/Data/Conduit/Cereal/Internal.hs0000644000000000000000000000527212377371663020553 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# LANGUAGE Rank2Types #-} module Data.Conduit.Cereal.Internal ( ConduitErrorHandler , SinkErrorHandler , SinkTerminationHandler , mkConduitGet , mkSinkGet ) where import Control.Monad (forever, when) import qualified Data.ByteString as BS import qualified Data.Conduit as C import Data.Serialize hiding (get, put) -- | What should we do if the Get fails? type ConduitErrorHandler m o = String -> C.Conduit BS.ByteString m o type SinkErrorHandler m r = String -> C.Consumer BS.ByteString m r -- | What should we do if the stream is done before the Get is done? type SinkTerminationHandler m r = (BS.ByteString -> Result r) -> C.Consumer BS.ByteString m r -- | Construct a conduitGet with the specified 'ErrorHandler' mkConduitGet :: Monad m => ConduitErrorHandler m o -> Get o -> C.Conduit BS.ByteString m o mkConduitGet errorHandler get = consume True (runGetPartial get) [] BS.empty where pull f b s | BS.null s = C.await >>= maybe (when (not $ null b) (C.leftover $ BS.concat $ reverse b)) (pull f b) | otherwise = consume False f b s consume initial f b s = case f s of Fail msg _ -> do when (not $ null b) (C.leftover $ BS.concat $ reverse consumed) errorHandler msg Partial p -> pull p consumed BS.empty Done a s' -> case initial of -- this only works because the Get will either _always_ consume no input, or _never_ consume no input. True -> forever $ C.yield a False -> C.yield a >> pull (runGetPartial get) [] s' -- False -> C.yield a >> C.leftover s' >> mkConduitGet errorHandler get where consumed = s : b -- | Construct a sinkGet with the specified 'ErrorHandler' and 'TerminationHandler' mkSinkGet :: Monad m => SinkErrorHandler m r -> SinkTerminationHandler m r -> Get r -> C.Consumer BS.ByteString m r mkSinkGet errorHandler terminationHandler get = consume (runGetPartial get) [] BS.empty where pull f b s | BS.null s = C.await >>= \ x -> case x of Nothing -> when (not $ null b) (C.leftover $ BS.concat $ reverse b) >> terminationHandler f Just a -> pull f b a | otherwise = consume f b s consume f b s = case f s of Fail msg _ -> do when (not $ null b) (C.leftover $ BS.concat $ reverse consumed) errorHandler msg Partial p -> pull p consumed BS.empty Done r s' -> when (not $ BS.null s') (C.leftover s') >> return r where consumed = s : b