binary-conduit 1.2.5 → 1.3

raw patch · 3 files changed

+51/−58 lines, 3 filesdep +exceptionsdep ~conduitdep ~resourcetPVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions

Dependency ranges changed: conduit, resourcet

API changes (from Hackage documentation)

Files

• Data/Conduit/Serialization/Binary.hs +18/−19
• binary-conduit.cabal +3/−3
• test/Main.hs +30/−36

@@ -25,11 +25,10 @@  import           Data.Conduit import qualified Data.Conduit.List    as CL+import           Data.Foldable import           Data.Typeable import qualified Data.Vector          as V-import           Control.Monad.Trans.Resource-     (MonadThrow-     , monadThrow)+import           Control.Monad.Catch (MonadThrow(..))   data ParseError = ParseError@@ -45,7 +44,7 @@ instance Exception ParseError  -- | Runs default 'Decoder' repeatedly on a input stream.-conduitDecode :: (Binary b, MonadThrow m) => Conduit ByteString m b+conduitDecode :: (Binary b, MonadThrow m) => ConduitT ByteString b m () conduitDecode = conduitGet get  -- | Runs default encoder on a input stream.@@ -53,8 +52,8 @@ -- This function produces a stream of bytes where for each input -- value you will have a number of 'ByteString's, and no boundary -- between different values.-conduitEncode :: (Binary b, MonadThrow m) => Conduit b m ByteString-conduitEncode = CL.map put =$= conduitPut+conduitEncode :: (Binary b, MonadThrow m) => ConduitT b ByteString m ()+conduitEncode = CL.map put .| conduitPut   -- | Runs default encoder on input stream.@@ -70,11 +69,11 @@ -- you interested in iterative packet serialization -- concider using 'conduitPutList' or 'conduitPutMany' ---conduitMsgEncode :: Monad m => (Binary b) => Conduit b m ByteString-conduitMsgEncode = CL.map put =$= conduitMsg+conduitMsgEncode :: Monad m => (Binary b) => ConduitT b ByteString m ()+conduitMsgEncode = CL.map put .| conduitMsg  -- | Runs getter repeatedly on a input stream.-conduitGet :: MonadThrow m => Get b -> Conduit ByteString m b+conduitGet :: MonadThrow m => Get b -> ConduitT ByteString b m () conduitGet g = start   where     start = do mx <- await@@ -85,7 +84,7 @@                           if BS.null bs                             then start                             else go (runGetIncremental g `pushChunk` bs)-    go (Fail u o e)  = monadThrow (ParseError u o e)+    go (Fail u o e)  = throwM (ParseError u o e)     go (Partial n)   = await >>= (go . n)  -- \o/@@ -98,37 +97,37 @@                     Just x  -> do { yi ; conduit}}  -- | Runs putter repeatedly on a input stream, returns an output stream.-conduitPut :: Monad m => Conduit Put m ByteString-conduitPutGeneric(conduitPut, (sourcePut x $$ CL.mapM_ yield))+conduitPut :: Monad m => ConduitT Put ByteString m ()+conduitPutGeneric(conduitPut, (traverse_ yield (LBS.toChunks $ runPut x)))  -- | Runs a putter repeatedly on a input stream, returns a packets.-conduitMsg :: Monad m => Conduit Put m ByteString+conduitMsg :: Monad m => ConduitT Put ByteString m () conduitPutGeneric(conduitMsg, (yield (LBS.toStrict $ runPut x)))  -- | Runs putter repeatedly on a input stream. -- Returns a lazy butestring so it's possible to use vectorized -- IO on the result either by calling' LBS.toChunks' or by -- calling 'Network.Socket.ByteString.Lazy.send'.-conduitPutLBS :: Monad m => Conduit Put m LBS.ByteString+conduitPutLBS :: Monad m => ConduitT Put LBS.ByteString m () conduitPutGeneric(conduitPutLBS, yield (runPut x))  -- | Vectorized variant of 'conduitPut' returning list contains -- all chunks from one element representation-conduitPutList :: Monad m => Conduit Put m [ByteString]+conduitPutList :: Monad m => ConduitT Put [ByteString] m () conduitPutGeneric(conduitPutList, yield (LBS.toChunks (runPut x)))  -- | Vectorized variant of 'conduitPut'.-conduitPutMany :: Monad m => Conduit Put m (V.Vector ByteString)+conduitPutMany :: Monad m => ConduitT Put (V.Vector ByteString) m () conduitPutGeneric(conduitPutMany, yield (V.fromList (LBS.toChunks (runPut x))))  -- | Create stream of strict bytestrings from 'Put' value.-sourcePut :: Monad m => Put -> Producer m ByteString+sourcePut :: Monad m => Put -> ConduitT z ByteString m () sourcePut = CL.sourceList . LBS.toChunks . runPut  -- | Decode message from input stream.-sinkGet :: MonadThrow m => Get b -> Consumer ByteString m b+sinkGet :: MonadThrow m => Get b -> ConduitT ByteString z 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 (Fail u o e)   = throwM (ParseError u o e)       sink (Partial next) = await >>= sink . next

@@ -1,5 +1,5 @@ name:                binary-conduit-version:             1.2.5+version:             1.3 synopsis:            data serialization/deserialization conduit library description:         The binary-conduit package.       Allow binary serialization using iterative conduit interface.@@ -19,11 +19,11 @@   exposed-modules:          Data.Conduit.Serialization.Binary   build-depends:       base >=4 && <5,-                       conduit >= 1.1 && < 1.3,+                       conduit >= 1.2.8 && < 1.4,                        bytestring >= 0.9.2 && < 10.3,                        binary >= 0.6 && < 0.9,                        vector >= 0.10,-                       resourcet >= 1.1+                       exceptions   ghc-options: -Wall  test-suite test-binary-conduit

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} import Control.Applicative import Control.Monad (forM_, when)+import Control.Monad.IO.Class import Data.Binary import Data.Binary.Put import Data.ByteString as BS@@ -16,36 +17,32 @@ import Test.QuickCheck import Control.Monad.Trans.Resource import GHC.Generics+import Prelude  -- | 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+    xs' <- liftIO $ runConduit $ CL.sourceList xs+                     .| enc xs+                     .| dec xs+                     .| CL.consume+    assert (xs == xs')+  where enc :: (Binary a, MonadThrow m) => [a] -> ConduitT a ByteString m ()         enc _ = conduitEncode-        dec :: (Binary a, MonadThrow m) => [a] -> Conduit ByteString m a+        dec :: (Binary a, MonadThrow m) => [a] -> ConduitT ByteString a m ()         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')-+    (a',b') <- liftIO $ runConduit $ 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+  where enc :: (Binary a, MonadThrow m) => a -> ConduitT a ByteString m ()         enc _ = conduitEncode-        dec :: (Binary a, MonadThrow m) => a -> Conduit ByteString m a-        dec _ = conduitDecode  prop_part2 :: [Int] -> Property prop_part2 xs = monadicIO $ do@@ -53,12 +50,10 @@     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)+            a <- liftIO $ runConduit $ CL.sourceList [l1,l2]+                            .| conduitDecode+                            .| CL.consume+            stop (xs ?== a)  prop_part3 :: [Int] -> Property prop_part3 xs = monadicIO $ do@@ -69,12 +64,10 @@           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+                a <- liftIO $ runConduit $ CL.sourceList [l1,l2_1,l2_2]+                                .| conduitDecode+                                .| CL.consume+                stop $ xs ?== a   data A = A ByteString ByteString deriving (Eq, Show, Generic)@@ -86,10 +79,11 @@  prop_eq_plus :: (Binary a, Eq a) => [a] -> Property prop_eq_plus xs = monadicIO $ do-   x <- CL.sourceList xs $= CL.map encode =$= CL.map LBS.toStrict $$ CL.consume :: PropertyM IO [BS.ByteString]-   y <- CL.sourceList xs $= conduitMsgEncode $$ CL.consume :: PropertyM IO [BS.ByteString]+   x <- runConduit $ CL.sourceList xs .| CL.map encode .| CL.map LBS.toStrict .| CL.consume :: PropertyM IO [BS.ByteString]+   y <- runConduit $ CL.sourceList xs .| conduitMsgEncode .| CL.consume :: PropertyM IO [BS.ByteString]    stop $ x ?== y :: PropertyM IO () +main :: IO () main = hspec $ do     describe "QC properties: conduitEncode =$= conduitDecode == id" $ do         prop "int"               $ (prop_eq :: [Int] -> Property)@@ -107,21 +101,21 @@         prop "string"            $ (prop_eq_plus :: [String] -> Property)         prop "maybe int"         $ (prop_eq_plus :: [Maybe Int] -> Property)         prop "either int string" $ (prop_eq_plus :: [Either Int String] -> Property)-	prop "A"                 $ (prop_eq_plus :: [A] -> Property)+        prop "A"                 $ (prop_eq_plus :: [A] -> Property)     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 <- runConduit $ 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 <- runConduit $ CL.sourceList [ls,ls] .| conduitDecode .| CL.consume+          x' <- runConduit $ CL.sourceList [ls1,ls2] .| conduitDecode .| CL.consume           x `shouldBe` is++is           x' `shouldBe` is