binary-conduit 1.0 → 1.1.0

raw patch · 3 files changed

+82/−26 lines, 3 filesdep +binary-conduitdep −conduit-binaryPVP ok

version bump matches the API change (PVP)

Dependencies added: binary-conduit

Dependencies removed: conduit-binary

API changes (from Hackage documentation)

Files

• Data/Conduit/Serialization/Binary.hs +22/−15
• binary-conduit.cabal +2/−2
• test/Main.hs +58/−9

@@ -16,6 +16,7 @@ import           Data.Binary.Get import           Data.Binary.Put import           Data.ByteString (ByteString)+import           Data.ByteString      as BS import qualified Data.ByteString.Lazy as LBS  import           Data.Conduit@@ -24,25 +25,29 @@   data ParseError = ParseError-      { uncomsumed :: ByteString  -- ^ uncomsumed data-      , offset     :: ByteOffset  -- ^ current offset-      , content    :: String      -- ^ error content+      { unconsumed :: ByteString+        -- ^ Data left unconsumed in single stream input value.++      , offset     :: ByteOffset+        -- ^ Number of bytes consumed from single stream input value.++      , content    :: String      -- ^ Error content.       } deriving (Show, Typeable)  instance Exception ParseError --- | Runs default 'Decoder' repeadetly on a input stream+-- | Runs default 'Decoder' repeatedly on a input stream. conduitDecode :: (Binary b, MonadThrow m) => Conduit ByteString m b conduitDecode = conduitGet get --- | Runs default encoder on a input stream+-- | 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+-- | Runs getter repeatedly on a input stream.+conduitGet :: MonadThrow m => Get b -> Conduit ByteString m b conduitGet g = start-  where +  where     start = do mx <- await                case mx of                   Nothing -> return ()@@ -50,25 +55,27 @@     conduit p = await >>= go . flip (maybe pushEndOfInput (flip pushChunk)) p         where           go (Done bs _ v) = do yield v-                                go (runGetIncremental get `pushChunk` bs)+                                if BS.null bs+                                    then start+                                    else go (runGetIncremental g `pushChunk` bs)           go (Fail u o e)  = monadThrow (ParseError u o e)-          go (Partial _)   = start+          go (Partial n)   = await >>= (go . n) --- | Runs putter repeadelty on a input stream+-- | Runs putter repeatedly on a input stream. conduitPut :: MonadThrow m => Conduit Put m ByteString-conduitPut = conduit -  where +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+-- | Create stream of strict bytestrings from 'Put' value. sourcePut :: (MonadThrow m) => Put -> Producer m ByteString sourcePut = CL.sourceList . LBS.toChunks . runPut --- | Decode message from input stream+-- | Decode message from input stream. sinkGet :: (Binary b, MonadThrow m) => Get b -> Consumer ByteString m b sinkGet f = sink (runGetIncremental f)   where

@@ -1,5 +1,5 @@ name:                binary-conduit-version:             1.0+version:             1.1.0 synopsis:            data serialization/deserialization conduit library description:         The binary-conduit package.       Allow binary serialization using iterative conduit interface.@@ -28,7 +28,7 @@   type: exitcode-stdio-1.0   main-is: Main.hs   hs-source-dirs: test/-  build-depends: base, QuickCheck, quickcheck-assertions, conduit-binary, +  build-depends: base, QuickCheck, quickcheck-assertions, binary-conduit,      hspec, conduit, binary, bytestring  source-repository head

@@ -1,6 +1,7 @@+import Control.Monad (forM_, when) import Data.Binary import Data.Binary.Put-import Data.ByteString+import Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.Conduit import qualified Data.Conduit.List as CL@@ -42,11 +43,59 @@         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)-    +prop_part2 :: [Int] -> Property+prop_part2 xs = monadicIO $ do+    let m = BS.concat . Prelude.concatMap (LBS.toChunks . runPut . put) $ xs+    when (Prelude.length xs>0) $ do+        forM_ [0..BS.length m] $ \l -> do+            let (l1,l2) = BS.splitAt l m+            ma <- runExceptionT $ CL.sourceList [l1,l2]+                                $= conduitDecode+                                $$ CL.consume+            case ma of+                Left _  -> fail "exception in conduit"+                Right a -> stop (xs ?== a)++prop_part3 :: [Int] -> Property+prop_part3 xs = monadicIO $ do+    let m = BS.concat . Prelude.concatMap (LBS.toChunks . runPut . put) $ xs+    when (Prelude.length xs>0) $ do+      forM_ [1..BS.length m] $ \l -> do+          let (l1,l2) = BS.splitAt l m+          when (BS.length l2 > 0) $ do+            forM_ [1..BS.length l2] $ \l' -> do+                let (l2_1,l2_2) = BS.splitAt l' l2+                ma <- runExceptionT $ CL.sourceList [l1,l2_1,l2_2]+                                    $= conduitDecode+                                    $$ CL.consume+                case ma of+                    Left _ -> fail "exception in conduit"+                    Right a -> stop $ xs ?== a++main = hspec $ do+    describe "QC properties: 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 "(Int,Int)"         $ (prop_sink :: (Int,Int) -> Property)+        prop "(String,String)"   $ (prop_sink :: (String,String) -> Property)+    describe "QC properties partial lists" $ do+        prop "break data in 2 parts" $ (prop_part2)+        prop "break data in 3 parts" $ (prop_part3)+    describe "HUnit properties:" $ do+      it "decodes message splitted to chunks" $ do+          let i = -32+              l = runPut (put (i::Int))+              (l1,l2) = LBS.splitAt (LBS.length l `div` 2) l+              t = BS.concat . LBS.toChunks+          x <- CL.sourceList [t l1,t l2] $= conduitDecode $$ CL.consume+          x `shouldBe` [i]+      it "decodes message with list of values inside" $ do+          let is = [-32,45::Int]+              ls = BS.concat . Prelude.concatMap (LBS.toChunks .runPut . put) $ is +              (ls1,ls2) = BS.splitAt ((BS.length ls `div` 2) +1) ls+          x <- CL.sourceList [ls,ls] $= conduitDecode $$ CL.consume+          x' <- CL.sourceList [ls1,ls2] $= conduitDecode $$ CL.consume+          x `shouldBe` is++is+          x' `shouldBe` is