binary-conduit (empty) → 1.0

raw patch · 5 files changed

+192/−0 lines, 5 filesdep +QuickCheckdep +basedep +binarysetup-changed

Dependencies added: QuickCheck, base, binary, bytestring, conduit, conduit-binary, hspec, quickcheck-assertions

Files

Data/Conduit/Serialization/Binary.hs +77/−0
LICENSE +25/−0
Setup.hs +2/−0
binary-conduit.cabal +36/−0
test/Main.hs +52/−0

+ Data/Conduit/Serialization/Binary.hs view

@@ -0,0 +1,77 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Rank2Types #-}+module Data.Conduit.Serialization.Binary+  ( conduitDecode+  , conduitEncode+  , conduitGet+  , conduitPut+  , sourcePut+  , sinkGet+  , ParseError(..)+  )+  where++import           Control.Exception+import           Data.Binary+import           Data.Binary.Get+import           Data.Binary.Put+import           Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LBS++import           Data.Conduit+import qualified Data.Conduit.List    as CL+import           Data.Typeable+++data ParseError = ParseError+      { uncomsumed :: ByteString  -- ^ uncomsumed data+      , offset     :: ByteOffset  -- ^ current offset+      , content    :: String      -- ^ error content+      } deriving (Show, Typeable)++instance Exception ParseError++-- | Runs default 'Decoder' repeadetly on a input stream+conduitDecode :: (Binary b, MonadThrow m) => Conduit ByteString m b+conduitDecode = conduitGet get++-- | Runs default encoder on a input stream+conduitEncode :: (Binary b, MonadThrow m) => Conduit b m ByteString+conduitEncode = CL.map put =$= conduitPut++-- | Runs getter repeadetelly on a input stream+conduitGet :: (Binary b, MonadThrow m) => Get b -> Conduit ByteString m b+conduitGet g = start+  where +    start = do mx <- await+               case mx of+                  Nothing -> return ()+                  Just x -> conduit (runGetIncremental g `pushChunk` x)+    conduit p = await >>= go . flip (maybe pushEndOfInput (flip pushChunk)) p+        where+          go (Done bs _ v) = do yield v+                                go (runGetIncremental get `pushChunk` bs)+          go (Fail u o e)  = monadThrow (ParseError u o e)+          go (Partial _)   = start++-- | Runs putter repeadelty on a input stream+conduitPut :: MonadThrow m => Conduit Put m ByteString+conduitPut = conduit +  where +    conduit = do mx <- await+                 case mx of+                     Nothing -> return ()+                     Just x  -> do sourcePut x $$ CL.mapM_ yield+                                   conduit++-- | Create stream of strict bytestring from 'Put' value+sourcePut :: (MonadThrow m) => Put -> Producer m ByteString+sourcePut = CL.sourceList . LBS.toChunks . runPut++-- | Decode message from input stream+sinkGet :: (Binary b, MonadThrow m) => Get b -> Consumer ByteString m b+sinkGet f = sink (runGetIncremental f)+  where+      sink (Done bs _ v)  = leftover bs >> return v+      sink (Fail u o e)   = monadThrow (ParseError u o e)+      sink (Partial next) = await >>= sink . next

+ LICENSE view

@@ -0,0 +1,25 @@+Copyright (c) <year> <copyright holders>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++[Except as contained in this notice, the name of <copyright holders>+shall not be used in advertising or otherwise to promote the sale, use+or other dealings in this Software without prior written authorization+from <copyright holders>.]

+ Setup.hs view

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

+ binary-conduit.cabal view

@@ -0,0 +1,36 @@+name:                binary-conduit+version:             1.0+synopsis:            data serialization/deserialization conduit library+description:         The binary-conduit package.+      Allow binary serialization using iterative conduit interface.+license:             MIT+license-file:        LICENSE+author:              Alexander Vershilov+maintainer:          alexander.vershilov@gmail.com+copyright:           2013 Alexander Vershilov+category:            Conduit+stability:           Experimental+homepage:            http://github.com/qnikst/binary-conduit+bug-reports:         http://github.com/qnikst/binary-conduit/issues+build-type:          Simple+cabal-version:       >=1.8++library+  exposed-modules:     +    Data.Conduit.Serialization.Binary+  build-depends:       base >=4 && <5,+                       conduit >= 1.0 && < 1.1,+                       bytestring >= 0.9 && < 10.3,+                       binary >= 0.6 && < 0.8+  ghc-options: -Wall++test-suite test-binary-conduit+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test/+  build-depends: base, QuickCheck, quickcheck-assertions, conduit-binary, +    hspec, conduit, binary, bytestring++source-repository head+  type: git+  location: git://github.com/qnikst/binary-conduit/

+ test/Main.hs view

@@ -0,0 +1,52 @@+import Data.Binary+import Data.Binary.Put+import Data.ByteString+import qualified Data.ByteString.Lazy as LBS+import Data.Conduit+import qualified Data.Conduit.List as CL+import Data.Conduit.Serialization.Binary+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck.Assertions+import Test.QuickCheck.Property+import Test.QuickCheck.Monadic+import Test.QuickCheck++-- | check conduitEncode =$= conduitDecode == id+prop_eq :: (Binary a,Eq a) => [a] -> Property+prop_eq xs = monadicIO $ do +    xs' <- runExceptionT  $ CL.sourceList xs +              $= enc xs+              =$= dec xs+              $$ CL.consume+    case xs' of+        Left e -> fail "exception"+        Right x -> assert $ x == xs+  where enc :: (Binary a, MonadThrow m) => [a] -> Conduit a m ByteString+        enc _ = conduitEncode +        dec :: (Binary a, MonadThrow m) => [a] -> Conduit ByteString m a+        dec _ = conduitDecode++prop_sink :: (Binary a,Eq a) => (a,a) -> Property+prop_sink (a,b) = monadicIO $ do+    Right (a',b') <- runExceptionT $ CL.sourceList [a,b]+                         $= enc a+                         $$ do a' <- sinkGet get+                               b' <- CL.consume+                               return (a',b')++    assert $ a == a'+    assert $ runPut (put b) == LBS.fromChunks b'+  where enc :: (Binary a, MonadThrow m) => a -> Conduit a m ByteString+        enc _ = conduitEncode +        dec :: (Binary a, MonadThrow m) => a -> Conduit ByteString m a+        dec _ = conduitDecode++main = hspec $ describe "conduitEncode =$= conduitDecode == id" $ do+    prop "int" $ (prop_eq :: [Int] -> Property)+    prop "string" $ (prop_eq :: [String] -> Property)+    prop "maybe int" $ (prop_eq :: [Maybe Int] -> Property)+    prop "either int string" $ (prop_eq :: [Either Int String] -> Property)+    prop "ab" $ (prop_sink :: (Int,Int) -> Property)+    prop "ab" $ (prop_sink :: (String,String) -> Property)+