cereal-streams (empty) → 0.0.1.0

raw patch · 7 files changed

+468/−0 lines, 7 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, bytestring, cereal, cereal-conduit, cereal-streams, conduit, conduit-extra, criterion, derive, io-streams, mtl, tasty, tasty-hunit, tasty-quickcheck, transformers

Files

LICENSE +31/−0
README.md +41/−0
Setup.hs +2/−0
bench/Main.hs +69/−0
cereal-streams.cabal +64/−0
src/System/IO/Streams/Cereal.hs +140/−0
test/Main.hs +121/−0

+ LICENSE view

@@ -0,0 +1,31 @@+Copyright (c) 2014, Michael Xavier+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,41 @@+cereal-streams +==============++[![Hackage](https://img.shields.io/hackage/v/cereal-streams.svg?style=flat)](http://hackage.haskell.org/package/cereal-streams)+[![Build Status](https://travis-ci.org/winterland1989/cereal-streams.svg)](https://travis-ci.org/winterland1989/cereal-streams)++Use [cereal](http://hackage.haskell.org/package/cereal) to encode/decode [io-streams](http://hackage.haskell.org/package/io-streams), io-streams provided strict bytestring chunk streams, which makes cereal the perfect chocie to do encoding/decoding works. It's an alternative to encode/decode with binary/lazy bytestring.++This package is rewritten from [cereal-io-streams](https://github.com/Soostone/cereal-io-streams), here's benchmark result against [cereal-conduit](http://hackage.haskell.org/package/cereal-conduit):++```+benchmarking decode one element from cereal-streams/1000 items+time                 135.8 ns   (134.6 ns .. 137.2 ns)+                     0.999 R²   (0.999 R² .. 0.999 R²)+mean                 136.6 ns   (135.2 ns .. 138.2 ns)+std dev              5.147 ns   (4.239 ns .. 6.413 ns)+variance introduced by outliers: 57% (severely inflated)++benchmarking decode one element cereal-conduit/1000 items+time                 340.1 ns   (337.0 ns .. 343.6 ns)+                     0.999 R²   (0.998 R² .. 0.999 R²)+mean                 339.9 ns   (335.6 ns .. 344.6 ns)+std dev              13.68 ns   (10.59 ns .. 18.03 ns)+variance introduced by outliers: 58% (severely inflated)++benchmarking decode 1000 elements from cereal-streams/1000 items+time                 112.5 μs   (111.6 μs .. 113.4 μs)+                     0.999 R²   (0.998 R² .. 0.999 R²)+mean                 112.8 μs   (111.4 μs .. 114.4 μs)+std dev              4.735 μs   (3.522 μs .. 6.811 μs)+variance introduced by outliers: 43% (moderately inflated)++benchmarking decode 1000 elements cereal-conduit/1000 items+time                 204.4 μs   (201.9 μs .. 206.9 μs)+                     0.995 R²   (0.990 R² .. 0.997 R²)+mean                 220.7 μs   (209.5 μs .. 271.0 μs)+std dev              66.92 μs   (9.094 μs .. 152.6 μs)+variance introduced by outliers: 98% (severely inflated)+```++

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ bench/Main.hs view

@@ -0,0 +1,69 @@+{-# 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.ByteString          (ByteString)+import           Data.Conduit+import qualified Data.Conduit.Binary      as Conduit+import qualified Data.Conduit.Cereal      as Conduit+import           Data.Monoid+import           Data.Serialize+import           GHC.Generics++-------------------------------------------------------------------------------++import qualified System.IO.Streams        as Streams+import           System.IO.Streams.Cereal++-------------------------------------------------------------------------------++main :: IO ()+main = do+  let lstring = mconcat $ map (runPutLazy . put) foos+      foos = map exFoo [0..1000]+      exFoo x = Foo x "oh look, a Foo!"+  defaultMain+    [ bgroup "decode one element from cereal-streams" [+         bench "1000 items" $ whnfIO $ benchCS lstring ]+    , bgroup "decode one element cereal-conduit" [+         bench "1000 items" $ whnfIO $ benchCC lstring ]+    , bgroup "decode 1000 elements from cereal-streams" [+         bench "1000 items" $ whnfIO $ benchCSA lstring ]+    , bgroup "decode 1000 elements cereal-conduit" [+         bench "1000 items" $ whnfIO $ benchCCA lstring ]+    ]++benchCS lstring = do+    s <- 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 <- 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

+ cereal-streams.cabal view

@@ -0,0 +1,64 @@+name:               cereal-streams+version:            0.0.1.0+synopsis:           Use cereal to encode/decode io-streams.+description:        Use cereal to encode/decode io-streams.++license:            BSD3+license-file:       LICENSE+author:             Michael Xavier, Winterland+maintainer:         michael.xavier@soostone.com, winterland1989@gmail.com+copyright:          Soostone Inc, Winterland+category:           Data, Parsing, IO-Streams+build-type:         Simple+extra-source-files: README.md+cabal-version:      >=1.10++library+  exposed-modules:      System.IO.Streams.Cereal+  build-depends:        base >= 4 && < 5+                    ,   bytestring >= 0.10.2.0+                    ,   cereal >= 0.5 && < 0.6+                    ,   io-streams >= 1.2+  hs-source-dirs:       src+  ghc-options:      -Wall+  default-language:     Haskell2010++test-suite test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  build-depends:        cereal-streams+                    ,   cereal+                    ,   bytestring+                    ,   io-streams+                    ,   QuickCheck+                    ,   HUnit+                    ,   tasty+                    ,   tasty-quickcheck+                    ,   tasty-hunit+                    ,   derive+                    ,   base+                    ,   mtl+  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+                    ,   cereal-streams+                    ,   criterion >= 1.0.2.0+                    ,   io-streams+                    ,   bytestring+                    ,   cereal+                    ,   cereal-conduit+                    ,   conduit+                    ,   conduit-extra+                    ,   transformers++  ghc-options:      -rtsopts -Wall++source-repository head+  type:     git+  location: git://github.com/winterland1989/cereal-streams.git

+ src/System/IO/Streams/Cereal.hs view

@@ -0,0 +1,140 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings  #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Sytem.IO.Streams.Cereal+-- Copyright   :  Soostone Inc, Winterland+-- License     :  BSD3+--+-- Maintainer  :  Michael Xavier, Winterland+-- Stability   :  experimental+--+-- Use cereal to encode/decode io-streams.+----------------------------------------------------------------------------++module System.IO.Streams.Cereal+    (+    -- * single element encode/decode+      getFromStream+    , putToStream+    -- * 'InputStream' encode/decode+    , getInputStream+    , decodeInputStream+    , putInputStream+    , encodeInputStream+    -- * 'OutputStream' encode+    , putOutputStream+    , encodeOutputStream+    -- * exception type+    , DecodeException(..)+    ) where++-------------------------------------------------------------------------------++import           Control.Applicative+import           Control.Exception      (Exception, throwIO)+import           Control.Monad+import           Data.ByteString        (ByteString)+import qualified Data.ByteString.Char8  as S+import           Data.Monoid+import           Data.Serialize+import           Data.Typeable+import qualified System.IO.Streams      as Streams+import           System.IO.Streams.Core++-------------------------------------------------------------------------------++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 'Put' to an 'OutputStream'+--+putToStream :: Put -> OutputStream ByteString -> IO ()+putToStream p = Streams.write (Just (runPut p))+{-# 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 r -> InputStream ByteString -> IO (Maybe r)+getFromStream g is =+    Streams.read is >>= maybe (return Nothing) (go . runGetPartial g)+  where+    go (Fail msg s) = do+        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 #-}++-------------------------------------------------------------------------------++-- | Convert a stream of individual encoded 'ByteString's to a stream+-- of Results. Throws a 'DecodeException' on error.+--+-- Example:+--+-- >>> Streams.toList =<< getInputStream (get :: Get String) =<< Streams.fromList (map (runPut . put) ["foo", "bar"])+-- ["foo","bar"]+getInputStream :: Get r -> InputStream ByteString -> IO (InputStream r)+getInputStream g is = makeInputStream (getFromStream g is)+{-# INLINE getInputStream #-}++-- | typeclass version of 'getInputStream'+decodeInputStream :: Serialize r => InputStream ByteString -> IO (InputStream r)+decodeInputStream = getInputStream get++-------------------------------------------------------------------------------++-- | Convert a stream of serializable objects into a stream of+-- individual 'ByteString's with a 'Putter', while most of the time+-- these function are not needed, they can be used in round-trip test.+-- Example:+--+-- >>> Streams.toList =<< getInputStream (get :: Get String) =<< encodeInputStream =<< Streams.fromList ["foo","bar"]+-- ["foo","bar"]+putInputStream :: Putter r -> InputStream r -> IO (InputStream ByteString)+putInputStream p = Streams.map (runPut . p)+{-# INLINE putInputStream #-}++-- | typeclass version of 'putInputStream'+encodeInputStream :: Serialize r => InputStream r -> IO (InputStream ByteString)+encodeInputStream = putInputStream put++-------------------------------------------------------------------------------++-- | create an 'OutputStream' of serializable values from an 'OutputStream'+-- of bytestrings with a 'Putter'.+putOutputStream :: Putter r -> OutputStream ByteString -> IO (OutputStream r)+putOutputStream p = Streams.contramap (runPut . p)+{-# INLINE putOutputStream #-}++-- | typeclass version of 'putOutputStream'+encodeOutputStream :: Serialize r => OutputStream ByteString -> IO (OutputStream r)+encodeOutputStream = Streams.contramap (runPut . put)

+ test/Main.hs view

@@ -0,0 +1,121 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++module Main where++-------------------------------------------------------------------------------++import           Control.Exception        hiding (assert)+import qualified Data.ByteString          as BS+import           Data.DeriveTH+import           Data.Monoid+import           Data.Serialize+import           GHC.Generics+import           System.IO.Streams        hiding (map)+import qualified System.IO.Streams        as Streams+import           Test.QuickCheck.Monadic+import           Test.Tasty+import           Test.Tasty.HUnit         hiding (assert)+import           Test.Tasty.QuickCheck++import           Control.Monad+import qualified Control.Monad.State      as MS+import qualified Data.ByteString.Char8    as BS8+import qualified Data.ByteString.Lazy     as LBS++-------------------------------------------------------------------------------++import           System.IO.Streams.Cereal++-------------------------------------------------------------------------------++main :: IO ()+main = defaultMain testSuite+++testSuite :: TestTree+testSuite = testGroup "cereal-io-streams"+    [ testProperty "serialization roundtrips Foo" roundTripFoo+    , testProperty "serialization roundtrips Foo" roundTripFoo'+    , testProperty "serialization roundtrips Foo unpredictable chunking" roundTripFoo''+    , testCase "partial input" partialInput+    , testCase "excess preceding input" excessPrefix+    , testCase "excess remaining input left in stream" excessSuffix+    ]++-------------------------------------------------------------------------------++roundTripFoo = monadicIO $ do+    a <- pick arbitrary :: PropertyM IO Foo+    Just res <- run $ do+        is <- fromList [a]+        getFromStream get =<< encodeInputStream is+    assert $ a == res++roundTripFoo' = monadicIO $ do+    a <- pick arbitrary :: PropertyM IO Foo+    res <- run $ do+        is <- fromList [a]+        (os, ioList) <- listOutputStream+        os' <- encodeOutputStream os+        connect is os'+        ioList+    assert $ [encode a] == res++roundTripFoo'' = monadicIO $ do+    as <- pick arbitrary :: PropertyM IO [Foo]+    Positive csize <- pick arbitrary+    res <- run $ do+      lbs <- fmap (LBS.fromChunks . rechunk csize . mconcat) . Streams.toList =<< encodeInputStream =<< Streams.fromList as+      is <- fromLazyByteString lbs+      Streams.toList =<< decodeInputStream is+    assert $ as == res++rechunk :: Int -> BS.ByteString -> [BS.ByteString]+rechunk n bs = fst $ MS.execState go ([], bs)+  where+    go :: MS.State ([BS.ByteString], BS.ByteString) ()+    go = do+        (chunks, rmning) <- MS.get+        unless (BS.null rmning) $ do+            let (chunk, rmning') = BS.splitAt n rmning+            MS.put (chunks ++ [chunk], rmning')+            go++-------------------------------------------------------------------------------++partialInput = do+    let s = mutatePut $ BS.drop 1+    assertDecodeException $ getFromStream (get :: Get Foo) =<< fromByteString s++excessSuffix = do+    let s = mutatePut (<> "extra")+    inS <- fromByteString s+    getFromStream (get :: Get Foo) inS+    remainder <- smappend inS+    remainder @?= "extra"++smappend = Streams.fold mappend mempty++excessPrefix = do+    let s = mutatePut ("extra" <>)+    assertDecodeException $ getFromStream (get :: Get Foo) =<< fromByteString s++mutatePut f = f $ runPut $ put $ Foo 42 "yup"++-------------------------------------------------------------------------------++assertDecodeException a = do+    res <- try a+    case res of+        Left (DecodeException _) -> return ()+        (Right r)             -> assertFailure $ "Expected a DecodeException but got " ++ show r++-------------------------------------------------------------------------------++data Foo = Foo Int String deriving (Generic,Show,Eq)++instance Serialize Foo++$(derive makeArbitrary ''Foo)