wire-streams (empty) → 0.0.2.0
raw patch · 12 files changed
+711/−0 lines, 12 filesdep +Cabaldep +QuickCheckdep +basesetup-changed
Dependencies added: Cabal, QuickCheck, base, binary, bytestring, cabal-test-quickcheck, cereal, cereal-conduit, conduit, conduit-extra, criterion, io-streams, transformers, wire-streams
Files
- CHANGElOG +7/−0
- LICENSE +32/−0
- README.md +63/−0
- Setup.hs +2/−0
- bench/Main.hs +88/−0
- dist/build/encode-decode-binaryStub/encode-decode-binaryStub-tmp/encode-decode-binaryStub.hs +5/−0
- dist/build/encode-decode-cerealStub/encode-decode-cerealStub-tmp/encode-decode-cerealStub.hs +5/−0
- src/System/IO/Streams/Binary.hs +131/−0
- src/System/IO/Streams/Cereal.hs +126/−0
- test/EncodeDecodeBinary.hs +87/−0
- test/EncodeDecodeCereal.hs +87/−0
- wire-streams.cabal +78/−0
+ CHANGElOG view
@@ -0,0 +1,7 @@+# v0.0.2.0++Add binary support, unify API, optimize cereal's putToStream/putOutputStream, add benchmark.++# v0.0.1.0++Clean up code, rewrite main parsing function, fix broken benchmark, and add more functions.
+ LICENSE view
@@ -0,0 +1,32 @@+Copyright (c) 2014, Michael Xavier+Copyright (c) 2014, Petter Bergman+Copyright (c) 2016, Winterland++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.++ * Neither the name of Michael Xavier nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.
+ README.md view
@@ -0,0 +1,63 @@+wire-streams +==============++[](http://hackage.haskell.org/package/wire-streams)+[](https://travis-ci.org/winterland1989/wire-streams)++One stop solution to serialize/deserialize [io-streams](http://hackage.haskell.org/package/io-streams):+++ `System.IO.Streams.Cereal` use [cereal](http://hackage.haskell.org/package/cereal) to serialize/deserialize, cereal provides sanner default to `Double`(IEEE-754), and `ShortByteString` support.+++ `System.IO.Streams.Binary` use [binary](http://hackage.haskell.org/package/binary) to serialize/deserialize, binary provide some useful helpers currently not available in cereal(`getLazyByteStringNul`).++This package is rewritten from [cereal-io-streams](https://github.com/Soostone/cereal-io-streams) and [binary-streams](https://github.com/jonpetterbergman/binary-streams) with following changes:+++ Completely rewrite cereal/io-streams adapter.++ Clean and unify APIs. ++ Add more test and benchmark.++Both cereal and binary are top notch serialize/deserialize libaries, you wouldn't go wrong with either choice. This package mainly serve my purpose to develop native mysql adapter, but also provide a benchmark/comparsion across cereal and binary. here's benchmark result against [cereal-conduit](http://hackage.haskell.org/package/cereal-conduit):++```+benchmarking decode one element wire-streams/cereal/1000 items+time 126.7 ns (125.1 ns .. 128.2 ns)+ 0.999 R² (0.998 R² .. 0.999 R²)+mean 127.4 ns (126.1 ns .. 128.9 ns)+std dev 4.887 ns (4.122 ns .. 6.214 ns)+variance introduced by outliers: 58% (severely inflated)++benchmarking decode one element wire-streams/binary/1000 items+time 218.4 ns (216.8 ns .. 220.0 ns)+ 0.999 R² (0.999 R² .. 1.000 R²)+mean 217.5 ns (215.8 ns .. 219.2 ns)+std dev 5.588 ns (4.589 ns .. 7.044 ns)+variance introduced by outliers: 37% (moderately inflated)++benchmarking decode one element cereal-conduit/1000 items+time 318.5 ns (314.7 ns .. 322.1 ns)+ 0.999 R² (0.999 R² .. 0.999 R²)+mean 319.2 ns (316.1 ns .. 322.7 ns)+std dev 11.37 ns (8.824 ns .. 15.09 ns)+variance introduced by outliers: 53% (severely inflated)++benchmarking decode 1000 elements from wire-streams/cereal/1000 items+time 99.61 μs (98.56 μs .. 100.9 μs)+ 0.997 R² (0.994 R² .. 0.999 R²)+mean 100.4 μs (98.83 μs .. 102.5 μs)+std dev 6.321 μs (4.136 μs .. 9.830 μs)+variance introduced by outliers: 64% (severely inflated)++benchmarking decode 1000 elements from wire-streams/binary/1000 items+time 189.3 μs (187.0 μs .. 191.5 μs)+ 0.999 R² (0.998 R² .. 0.999 R²)+mean 189.3 μs (187.5 μs .. 190.9 μs)+std dev 5.868 μs (4.966 μs .. 7.174 μs)+variance introduced by outliers: 27% (moderately inflated)++benchmarking decode 1000 elements cereal-conduit/1000 items+time 203.3 μs (201.1 μs .. 205.7 μs)+ 0.998 R² (0.996 R² .. 0.999 R²)+mean 204.0 μs (201.3 μs .. 207.9 μs)+std dev 10.38 μs (7.759 μs .. 14.73 μs)+variance introduced by outliers: 49% (moderately inflated)+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Main.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++-------------------------------------------------------------------------------++import Control.Exception (evaluate)+import Control.Monad (replicateM_)+import Control.Monad.IO.Class+import Criterion.Main+import Data.Binary (Binary)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as BL+import Data.Conduit+import qualified Data.Conduit.Binary as Conduit+import qualified Data.Conduit.Cereal as Conduit+import Data.Serialize (Serialize)+import Data.Serialize (Get, get, put, runPutLazy)+import GHC.Generics++-------------------------------------------------------------------------------++import qualified System.IO.Streams as Streams+import qualified System.IO.Streams.Binary as Binary+import qualified System.IO.Streams.Cereal as Cereal++-------------------------------------------------------------------------------++main :: IO ()+main = do+ let lstring = BL.concat $ map (runPutLazy . put) foos+ foos = map exFoo [0..1000]+ exFoo x = Foo x "oh look, a Foo!"+ defaultMain+ [ bgroup "decode one element wire-streams/cereal" [+ bench "1000 items" $ whnfIO $ benchCS lstring ]+ , bgroup "decode one element wire-streams/binary" [+ bench "1000 items" $ whnfIO $ benchBS lstring ]+ , bgroup "decode one element cereal-conduit" [+ bench "1000 items" $ whnfIO $ benchCC lstring ]+ , bgroup "decode 1000 elements from wire-streams/cereal" [+ bench "1000 items" $ whnfIO $ benchCSA lstring ]+ , bgroup "decode 1000 elements from wire-streams/binary" [+ bench "1000 items" $ whnfIO $ benchBSA lstring ]+ , bgroup "decode 1000 elements cereal-conduit" [+ bench "1000 items" $ whnfIO $ benchCCA lstring ]+ ]++benchCS lstring = do+ s <- Cereal.decodeInputStream =<< Streams.fromLazyByteString lstring+ a <- Streams.read s :: IO (Maybe Foo)+ evaluate a++benchBS lstring = do+ s <- Binary.decodeInputStream =<< Streams.fromLazyByteString lstring+ a <- Streams.read s :: IO (Maybe Foo)+ evaluate a++benchCC lstring = do+ Conduit.sourceLbs lstring =$= Conduit.conduitGet2 (get :: Get Foo) $$ do+ a <- await+ liftIO (evaluate a)++benchCSA lstring = do+ s <- Cereal.decodeInputStream =<< Streams.fromLazyByteString lstring+ replicateM_ 1000 $ do+ a <- Streams.read s :: IO (Maybe Foo)+ evaluate a++benchBSA lstring = do+ s <- Binary.decodeInputStream =<< Streams.fromLazyByteString lstring+ replicateM_ 1000 $ do+ a <- Streams.read s :: IO (Maybe Foo)+ evaluate a++benchCCA lstring = do+ Conduit.sourceLbs lstring =$= Conduit.conduitGet2 (get :: Get Foo) $$+ replicateM_ 1000 $ do+ a <- await+ liftIO (evaluate a)++-------------------------------------------------------------------------------++data Foo = Foo Int ByteString deriving (Generic, Show, Eq)++instance Serialize Foo+instance Binary Foo
+ dist/build/encode-decode-binaryStub/encode-decode-binaryStub-tmp/encode-decode-binaryStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import EncodeDecodeBinary ( tests )+main :: IO ()+main = stubMain tests
+ dist/build/encode-decode-cerealStub/encode-decode-cerealStub-tmp/encode-decode-cerealStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import EncodeDecodeCereal ( tests )+main :: IO ()+main = stubMain tests
+ src/System/IO/Streams/Binary.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}++--------------------------------------------------------------------------------+-- |+-- Module : Sytem.IO.Streams.Binary+-- Copyright : Petter Bergman, Winterland+-- License : BSD3+--+-- Maintainer : Winterland+-- Stability : experimental+--+-- Use binary to encode/decode io-streams.+--------------------------------------------------------------------------------++module System.IO.Streams.Binary (+ -- * single element encode/decode+ getFromStream+ , decodeFromStream+ , putToStream+ -- * 'InputStream' encode/decode+ , getInputStream+ , decodeInputStream+ -- * 'OutputStream' encode+ , putOutputStream+ , encodeOutputStream+ -- * exception type+ , DecodeException(..)+ ) where++--------------------------------------------------------------------------------++import Control.Exception (Exception, throwIO)+import Control.Monad (unless)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (ByteOffset, Decoder (..), Get,+ pushChunk, pushEndOfInput,+ runGetIncremental)+import Data.Binary.Put (runPut, Put)+import Data.ByteString (ByteString)+import qualified Data.ByteString as S+import Data.Typeable (Typeable)+import System.IO.Streams (InputStream, OutputStream)+import qualified System.IO.Streams as Streams+import System.IO.Streams.ByteString (writeLazyByteString)++--------------------------------------------------------------------------------++-- | An Exception raised when binary decoding fails.+--+-- it contains offset information where cereal don't.+data DecodeException = DecodeException ByteOffset String+ deriving (Typeable)++instance Show DecodeException where+ show (DecodeException offset message) =+ "System.IO.Streams.Binary: binary decode exception: offset " ++ show offset ++ ", " ++ show message++instance Exception DecodeException++--------------------------------------------------------------------------------++-- | Write an instance of 'Binary' to an 'OutputStream'.+putToStream :: Binary a => Maybe a -> OutputStream ByteString -> IO ()+putToStream Nothing os = Streams.write Nothing os+putToStream (Just x) os = writeLazyByteString ((runPut . put) x) os+{-# INLINE putToStream #-}++--------------------------------------------------------------------------------++-- | Take a 'Get' and an 'InputStream' and decode a+-- value. Consumes only as much input as necessary to decode the+-- value. Unconsumed input will be unread. If there is+-- an error while deserializing, a 'DecodeException' is thrown, and+-- unconsumed part will be unread. binary decoder use 'Nothing'+-- to indicate input end, so EOFs/Nothing will close a binary decoder.+-- Examples:+--+-- >>> import qualified System.IO.Streams as Streams+-- >>> getFromStream (get :: Get String) =<< Streams.fromLazyByteString (Data.ByteString.Lazy.drop 1 $ runPut $ put "encode me")+-- *** Exception: System.IO.Streams.Binary: binary decode exception: offset 16, "not enough bytes"+--+getFromStream :: Get a -> InputStream ByteString -> IO (Maybe a)+getFromStream g is = do+ let decoder = runGetIncremental g+ Streams.read is >>= maybe (return Nothing)+ (\s -> if S.null s then go decoder else go $ pushChunk decoder s)+ where go (Fail s offset message) = do+ unless (S.null s) (Streams.unRead s is)+ throwIO $ DecodeException offset message+ go (Done s _ x) = do+ unless (S.null s) (Streams.unRead s is)+ return (Just x)+ go decoder' =+ Streams.read is >>=+ maybe (go $ pushEndOfInput decoder')+ (\s -> if S.null s then go decoder' else go $ pushChunk decoder' s)+{-# INLINE getFromStream #-}++-- | typeclass version of 'getFromStream'+decodeFromStream :: Binary a => InputStream ByteString -> IO (Maybe a)+decodeFromStream = getFromStream get+{-# INLINE decodeFromStream #-}++--------------------------------------------------------------------------------++-- | Convert a stream of individual encoded 'ByteString's to a stream+-- of Results. Throws a 'DecodeException' on error.+getInputStream :: Get a -> InputStream ByteString -> IO (InputStream a)+getInputStream g = Streams.makeInputStream . getFromStream g+{-# INLINE getInputStream #-}++-- | typeclass version of 'getInputStream'+decodeInputStream :: Binary a => InputStream ByteString -> IO (InputStream a)+decodeInputStream = Streams.makeInputStream . decodeFromStream+{-# INLINE decodeInputStream #-}++--------------------------------------------------------------------------------++-- | create an 'OutputStream' of serializable values from an 'OutputStream'+-- of bytestrings with a 'Putter'.+putOutputStream :: (a -> Put) -> OutputStream ByteString -> IO (OutputStream a)+putOutputStream p os = Streams.makeOutputStream $ \ ma ->+ case ma of Nothing -> Streams.write Nothing os+ Just a -> writeLazyByteString (runPut (p a)) os+{-# INLINE putOutputStream #-}++-- | typeclass version of 'putOutputStream'+encodeOutputStream :: Binary a => OutputStream ByteString -> IO (OutputStream a)+encodeOutputStream = putOutputStream put+{-# INLINE encodeOutputStream #-}
+ src/System/IO/Streams/Cereal.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}++-----------------------------------------------------------------------------+-- |+-- Module : Sytem.IO.Streams.Cereal+-- Copyright : Soostone Inc, Winterland+-- License : BSD3+--+-- Maintainer : Winterland+-- Stability : experimental+--+-- Use cereal to encode/decode io-streams.+----------------------------------------------------------------------------++module System.IO.Streams.Cereal (+ -- * single element encode/decode+ getFromStream+ , decodeFromStream+ , putToStream+ -- * 'InputStream' encode/decode+ , getInputStream+ , decodeInputStream+ -- * 'OutputStream' encode+ , putOutputStream+ , encodeOutputStream+ -- * exception type+ , DecodeException(..)+ ) where++-------------------------------------------------------------------------------++import Control.Exception (Exception, throwIO)+import Control.Monad (unless)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as S+import Data.Serialize+import Data.Typeable+import qualified System.IO.Streams as Streams+import System.IO.Streams.Core++-------------------------------------------------------------------------------++-- | An Exception raised when cereal decoding fails.+data DecodeException = DecodeException String+ deriving (Typeable)++instance Show DecodeException where+ show (DecodeException s) = "System.IO.Streams.Cereal: cereal decode exception: " ++ s++instance Exception DecodeException++-------------------------------------------------------------------------------++-- | write a instance of 'Serialize' to an 'OutputStream'+--+putToStream :: Serialize a => Maybe a -> OutputStream ByteString -> IO ()+putToStream Nothing = Streams.write Nothing+putToStream (Just a) = (Streams.writeLazyByteString . runPutLazy . put) a+{-# INLINE putToStream #-}++-------------------------------------------------------------------------------++-- | Take a 'Get' and an 'InputStream' and decode a+-- value. Consumes only as much input as necessary to decode the+-- value. Unconsumed input will be unread. If there is+-- an error while deserializing, a 'DecodeException' is thrown, and+-- unconsumed part will be unread. To simplify upstream generation,+-- all empty 'ByteString' will be filtered out and not passed to cereal,+-- only EOFs/Nothing will close a cereal decoder.+--+-- Examples:+--+-- >>> import qualified System.IO.Streams as Streams+-- >>> getFromStream (get :: Get String) =<< Streams.fromByteString (Data.ByteString.drop 1 $ runPut $ put "encode me")+-- *** Exception: System.IO.Streams.Cereal: cereal decode exception: too few bytes+-- From: demandInput+-- <BLANKLINE>+--+getFromStream :: Get a -> InputStream ByteString -> IO (Maybe a)+getFromStream g is =+ Streams.read is >>= maybe (return Nothing) (go . runGetPartial g)+ where+ go (Fail msg s) = do+ unless (S.null s) (Streams.unRead s is)+ throwIO (DecodeException msg)+ go (Done r s) = do+ unless (S.null s) (Streams.unRead s is)+ return (Just r)+ go c@(Partial cont) =+ Streams.read is >>= maybe (go (cont S.empty)) -- use 'empty' to notify cereal ending.+ (\ s -> if S.null s then go c else go (cont s))+{-# INLINE getFromStream #-}++-- | typeclass version of 'getFromStream'+decodeFromStream :: Serialize a => InputStream ByteString -> IO (Maybe a)+decodeFromStream = getFromStream get+{-# INLINE decodeFromStream #-}++-------------------------------------------------------------------------------++-- | Convert a stream of individual encoded 'ByteString's to a stream+-- of Results. Throws a 'DecodeException' on error.+getInputStream :: Get a -> InputStream ByteString -> IO (InputStream a)+getInputStream g is = makeInputStream (getFromStream g is)+{-# INLINE getInputStream #-}++-- | typeclass version of 'getInputStream'+decodeInputStream :: Serialize a => InputStream ByteString -> IO (InputStream a)+decodeInputStream = getInputStream get+{-# INLINE decodeInputStream #-}++-------------------------------------------------------------------------------++-- | create an 'OutputStream' of serializable values from an 'OutputStream'+-- of bytestrings with a 'Putter'.+putOutputStream :: Putter a -> OutputStream ByteString -> IO (OutputStream a)+putOutputStream p os = Streams.makeOutputStream $ \ ma ->+ case ma of Nothing -> Streams.write Nothing os+ Just a -> Streams.writeLazyByteString (runPutLazy (p a)) os+{-# INLINE putOutputStream #-}++-- | typeclass version of 'putOutputStream'+encodeOutputStream :: Serialize a => OutputStream ByteString -> IO (OutputStream a)+encodeOutputStream = putOutputStream put+{-# INLINE encodeOutputStream #-}
+ test/EncodeDecodeBinary.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE ScopedTypeVariables #-}+module EncodeDecodeBinary ( tests ) where++import Control.Exception (catch,evaluate)+import Data.Binary (Binary)+import Data.ByteString (ByteString)+import qualified Data.ByteString as S+import Distribution.TestSuite (Test)+import Distribution.TestSuite.QuickCheck (testProperty)+import System.IO.Streams (write)+import System.IO.Streams.Binary (decodeInputStream,+ encodeOutputStream,+ DecodeException)+import System.IO.Streams.List (outputToList,+ fromList,+ toList,+ writeList)+import Test.QuickCheck.Property (Property)+import Test.QuickCheck.Monadic (monadicIO,+ assert,+ run)+++-- Using binary-streams, decode from a list of bytestrings+decode :: Binary a => [ByteString] -> IO [a]+decode ss = fromList ss >>= decodeInputStream >>= toList++-- Using binary-streams, encode to a list of bytestrings+encode :: Binary a => [a] -> IO [ByteString]+encode xs = outputToList $ \os ->+ do+ bos <- encodeOutputStream os+ writeList xs bos+ write Nothing bos++-- Encode something, then decode it and make sure we get the same thing back.+encodeDecodeEq :: (Binary a,Eq a) => [a] -> Property+encodeDecodeEq xs = monadicIO $ do+ xs' <- run go+ assert $ xs == xs'+ where go = encode xs >>= decode++-- corrupt something, remove the last byte of the last bytestring+corrupt :: [ByteString] -> [ByteString]+corrupt = reverse . go . reverse+ where go (h:t) = ((S.reverse $ S.drop 1 $ S.reverse h):t)+ go [] = []++-- Encode something, corrupt the encoded data, and make sure we get a+-- decode error when we try do decode it.+encodeDecodeError :: forall a. (Binary a,Eq a) => [a] -> Property+encodeDecodeError [] = monadicIO $ return ()+encodeDecodeError xs = monadicIO $ do+ run $ catch go $ \(_ :: DecodeException) -> return ()+ where go =+ do+ bList <- encode xs+ (xs' :: [a]) <- decode $ corrupt bList+ evaluate xs'+ fail "decoding succeeded when it should fail"++tests :: IO [Test]+tests =+ return [testProperty "encode-decode-equality Int"+ (encodeDecodeEq :: [Int] -> Property),+ testProperty "encode-decode-equality String"+ (encodeDecodeEq :: [String] -> Property),+ testProperty "encode-decode-equality Maybe Int"+ (encodeDecodeEq :: [Maybe Int] -> Property),+ testProperty "encode-decode-equality Either Int String"+ (encodeDecodeEq :: [Either Int String] -> Property),+ testProperty "encode-decode-equality (Int,Int)"+ (encodeDecodeEq :: [(Int,Int)] -> Property),+ testProperty "encode-decode-equality (String,String)"+ (encodeDecodeEq :: [(Int,Int)] -> Property),+ testProperty "encode-decode-error Int"+ (encodeDecodeError :: [Int] -> Property),+ testProperty "encode-decode-error String"+ (encodeDecodeError :: [String] -> Property),+ testProperty "encode-decode-error Maybe Int"+ (encodeDecodeError :: [Maybe Int] -> Property),+ testProperty "encode-decode-error Either Int String"+ (encodeDecodeError :: [Either Int String] -> Property),+ testProperty "encode-decode-error (Int,Int)"+ (encodeDecodeError :: [(Int,Int)] -> Property),+ testProperty "encode-decode-error (String,String)"+ (encodeDecodeError :: [(String,String)] -> Property)]
+ test/EncodeDecodeCereal.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE ScopedTypeVariables #-}+module EncodeDecodeCereal ( tests ) where++import Control.Exception (catch,evaluate)+import Data.Serialize (Serialize)+import Data.ByteString (ByteString)+import qualified Data.ByteString as S+import Distribution.TestSuite (Test)+import Distribution.TestSuite.QuickCheck (testProperty)+import System.IO.Streams (write)+import System.IO.Streams.Cereal (decodeInputStream,+ encodeOutputStream,+ DecodeException)+import System.IO.Streams.List (outputToList,+ fromList,+ toList,+ writeList)+import Test.QuickCheck.Property (Property)+import Test.QuickCheck.Monadic (monadicIO,+ assert,+ run)+++-- Using binary-streams, decode from a list of bytestrings+decode :: Serialize a => [ByteString] -> IO [a]+decode ss = fromList ss >>= decodeInputStream >>= toList++-- Using binary-streams, encode to a list of bytestrings+encode :: Serialize a => [a] -> IO [ByteString]+encode xs = outputToList $ \os ->+ do+ bos <- encodeOutputStream os+ writeList xs bos+ write Nothing bos++-- Encode something, then decode it and make sure we get the same thing back.+encodeDecodeEq :: (Serialize a,Eq a) => [a] -> Property+encodeDecodeEq xs = monadicIO $ do+ xs' <- run go+ assert $ xs == xs'+ where go = encode xs >>= decode++-- corrupt something, remove the last byte of the last bytestring+corrupt :: [ByteString] -> [ByteString]+corrupt = reverse . go . reverse+ where go (h:t) = ((S.reverse $ S.drop 1 $ S.reverse h):t)+ go [] = []++-- Encode something, corrupt the encoded data, and make sure we get a+-- decode error when we try do decode it.+encodeDecodeError :: forall a. (Serialize a,Eq a) => [a] -> Property+encodeDecodeError [] = monadicIO $ return ()+encodeDecodeError xs = monadicIO $ do+ run $ catch go $ \(_ :: DecodeException) -> return ()+ where go =+ do+ bList <- encode xs+ (xs' :: [a]) <- decode $ corrupt bList+ evaluate xs'+ fail "decoding succeeded when it should fail"++tests :: IO [Test]+tests =+ return [testProperty "encode-decode-equality Int"+ (encodeDecodeEq :: [Int] -> Property),+ testProperty "encode-decode-equality String"+ (encodeDecodeEq :: [String] -> Property),+ testProperty "encode-decode-equality Maybe Int"+ (encodeDecodeEq :: [Maybe Int] -> Property),+ testProperty "encode-decode-equality Either Int String"+ (encodeDecodeEq :: [Either Int String] -> Property),+ testProperty "encode-decode-equality (Int,Int)"+ (encodeDecodeEq :: [(Int,Int)] -> Property),+ testProperty "encode-decode-equality (String,String)"+ (encodeDecodeEq :: [(Int,Int)] -> Property),+ testProperty "encode-decode-error Int"+ (encodeDecodeError :: [Int] -> Property),+ testProperty "encode-decode-error String"+ (encodeDecodeError :: [String] -> Property),+ testProperty "encode-decode-error Maybe Int"+ (encodeDecodeError :: [Maybe Int] -> Property),+ testProperty "encode-decode-error Either Int String"+ (encodeDecodeError :: [Either Int String] -> Property),+ testProperty "encode-decode-error (Int,Int)"+ (encodeDecodeError :: [(Int,Int)] -> Property),+ testProperty "encode-decode-error (String,String)"+ (encodeDecodeError :: [(String,String)] -> Property)]
+ wire-streams.cabal view
@@ -0,0 +1,78 @@+name: wire-streams+version: 0.0.2.0+synopsis: Use cereal or binary with io-streams.+description: Use cereal or binary with io-streams.++license: BSD3+license-file: LICENSE+author: Michael Xavier, Petter Bergman, Winterland+maintainer: winterland1989@gmail.com+copyright: Soostone Inc, Petter Bergman, Winterland+category: Data, Parsing, IO-Streams+build-type: Simple+extra-source-files: README.md, CHANGElOG+cabal-version: >=1.10++library+ exposed-modules: System.IO.Streams.Cereal+ System.IO.Streams.Binary++ build-depends: base >= 4 && < 5+ , bytestring >= 0.10.2.0+ , cereal >= 0.5 && < 0.6+ , binary >= 0.6 && < 0.9+ , io-streams >= 1.2+ hs-source-dirs: src+ ghc-options: -Wall+ default-language: Haskell2010++test-suite encode-decode-cereal+ type: detailed-0.9+ test-module: EncodeDecodeCereal+ build-depends: base+ , bytestring+ , cereal+ , io-streams+ , wire-streams+ , QuickCheck+ , Cabal >= 1.10+ , cabal-test-quickcheck+ hs-source-dirs: test+ default-language: Haskell2010++test-suite encode-decode-binary+ type: detailed-0.9+ test-module: EncodeDecodeBinary+ build-depends: base+ , bytestring+ , binary+ , io-streams+ , wire-streams+ , QuickCheck+ , Cabal >= 1.10+ , cabal-test-quickcheck+ hs-source-dirs: test+ default-language: Haskell2010++benchmark bench+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: bench+ default-language: Haskell2010+ build-depends: base+ , wire-streams+ , criterion >= 1.0.2.0+ , io-streams+ , bytestring+ , cereal+ , binary+ , cereal-conduit+ , conduit+ , conduit-extra+ , transformers++ ghc-options: -rtsopts -Wall++source-repository head+ type: git+ location: git://github.com/winterland1989/wire-streams.git