pipes-binary 0.2.1 → 0.3.0
raw patch · 7 files changed
+444/−234 lines, 7 filesdep +lens-family-coredep +pipes-binarydep +profunctorsdep ~basedep ~binarydep ~pipes
Dependencies added: lens-family-core, pipes-binary, profunctors, smallcheck, tasty, tasty-hunit, tasty-smallcheck
Dependency ranges changed: base, binary, pipes, pipes-bytestring, pipes-parse
Files
- LICENSE +1/−1
- NEWS +0/−23
- changelog +28/−0
- pipes-binary.cabal +32/−14
- src/Pipes/Binary.hs +265/−117
- src/Pipes/Binary/Internal.hs +0/−79
- tests/Main.hs +118/−0
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2013, Renzo Carbonara+Copyright (c) 2013-2014, Renzo Carbonara All rights reserved.
− NEWS
@@ -1,23 +0,0 @@-# Version 0.2.1--* Re-export `Put` and `Binary` from the `binary` package.--* Use `isEndOfBytes` from the `pipes-bytestring` package.---# Version 0.2.0--* API revamped in order to support `pipes-4.0.0` and `pipes-parse-2.0.0`.--* Added functions that act directly upon `Put` and `Get` monads: `encodePut`,- `decodeGet`, `decodeGetMany`.--* Decoding functions now report the number of bytes that were consumed in order- to decode a value.--* Re-export `Get` and `ByteOffset` from the `binary` package.---# Version 0.1.0.0--* Initial version.
+ changelog view
@@ -0,0 +1,28 @@+# Version 0.3.0++* API revamped in order to support `pipes-parse-3.0.0`.+++# Version 0.2.1++* Re-export `Put` and `Binary` from the `binary` package.++* Use `isEndOfBytes` from the `pipes-bytestring` package.+++# Version 0.2.0++* API revamped in order to support `pipes-4.0.0` and `pipes-parse-2.0.0`.++* Added functions that act directly upon `Put` and `Get` monads: `encodePut`,+ `decodeGet`, `decodeGetMany`.++* Decoding functions now report the number of bytes that were consumed in order+ to decode a value.++* Re-export `Get` and `ByteOffset` from the `binary` package.+++# Version 0.1.0.0++* Initial version.
pipes-binary.cabal view
@@ -1,23 +1,22 @@ name: pipes-binary-version: 0.2.1+version: 0.3.0 license: BSD3 license-file: LICENSE-copyright: Copyright (c) Renzo Carbonara 2013+copyright: Copyright (c) Renzo Carbonara 2013-2014 author: Renzo Carbonara maintainer: renzocarbonaraλgmail.com stability: Experimental-tested-with: GHC == 7.6.3 homepage: https://github.com/k0001/pipes-binary bug-reports: https://github.com/k0001/pipes-binary/issues category: Pipes build-type: Simple synopsis: Encode and decode binary streams using the pipes and binary libraries. cabal-version: >=1.8-extra-source-files: README.md PEOPLE NEWS+extra-source-files: README.md PEOPLE changelog description: Encode and decode binary Pipes streams using the @binary@ library. .- See the @NEWS@ file in the source distribution to learn about any+ See the @changelog@ file in the source distribution to learn about any important changes between version. source-repository head@@ -26,13 +25,32 @@ library hs-source-dirs: src- build-depends: base (==4.*)- , binary (>=0.7 && <0.8)- , bytestring (>=0.9.2.1)- , pipes (>=4.0 && <4.1)- , pipes-parse (>=2.0 && <2.1)- , pipes-bytestring (>=1.0.2 && <1.2)- , transformers (>=0.2 && <0.4) exposed-modules: Pipes.Binary- other-modules: Pipes.Binary.Internal- ghc-options: -Wall -O2+ ghc-options: -Wall -O2+ build-depends:+ base >= 4.5 && < 5+ , binary >= 0.6 && < 0.8+ , bytestring >= 0.9.2.1+ , pipes >= 4.0 && < 4.2+ , pipes-parse >= 3.0 && < 3.1+ , pipes-bytestring >= 2.0 && < 2.1+ , profunctors >= 3.1.1 && < 4.1+ , transformers >= 0.2 && < 0.4++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Main.hs+ build-depends:+ base >= 4.5 && < 5+ , binary >= 0.6 && < 0.8+ , bytestring >= 0.9.2.1+ , lens-family-core >= 1.0 && < 1.1+ , pipes >= 4.0 && < 4.2+ , pipes-binary+ , pipes-parse >= 3.0 && < 3.1+ , smallcheck >= 1.0 && < 1.1+ , tasty >= 0.7 && < 0.8+ , tasty-hunit >= 0.4 && < 0.5+ , tasty-smallcheck >= 0.2 && < 0.3+ , transformers >= 0.2 && < 0.4
src/Pipes/Binary.hs view
@@ -1,146 +1,294 @@-{-# LANGUAGE RankNTypes #-}+-- | @pipes@ utilities for encoding and decoding values as byte streams+--+-- The tutorial at the bottom of this module illustrates how to use this+-- library.+--+-- In this module, the following type synonym compatible with the @lens@,+-- @lens-family@ and @lens-family-core@ libraries is used but not exported:+--+-- @+-- type Iso' a b = forall f p. ('Functor' f, 'Profunctor' p) => p b (f b) -> p a (f a)+-- @ --- | This module exports facilities that allow you to encode and decode Pipes--- streams of binary values. It builds on top of the @binary@, @pipes@ and--- @pipes-parse@ libraries, and assumes you know how to use those libraries.+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RankNTypes #-} -module Pipes.Binary- ( -- * @Binary@ instances+module Pipes.Binary (+ -- * Encoding encode+ -- ** Explicit 'Put'+ , encodePut++ -- * Decoding , decode- , decodeMany- -- * @Get@ monad+ , decoded+ -- ** Including lengths+ , decodeL+ , decodedL+ -- ** Explicit 'Get' , decodeGet- , decodeGetMany- -- * @Put@ monad- , encodePut- -- * Types- , I.DecodingError(..)- -- * Exports- -- $exports+ , decodeGetL++ -- * Types+ , DecodingError(..)++ -- * Exports+ -- $exports , module Data.Binary , module Data.Binary.Get , module Data.Binary.Put- ) where+ , module Data.ByteString+ , module Pipes.Parse --------------------------------------------------------------------------------+ -- * Tutorial+ -- $tutorial+ ) where -import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy.Internal as BLI+import Control.Exception (Exception)+import Control.Monad.Trans.Error (Error)+import qualified Control.Monad.Trans.State.Strict as S+import Data.Binary (Binary (..))+import qualified Data.Binary+import Data.Binary.Get (ByteOffset, Get)+import qualified Data.Binary.Get as Get+import Data.Binary.Put (Put)+import qualified Data.Binary.Put as Put+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.Data (Data, Typeable)+import Data.Profunctor (Profunctor, dimap)+import GHC.Generics (Generic) import Pipes-import Pipes.Core-import qualified Pipes.Binary.Internal as I-import qualified Pipes.Lift as P-import qualified Pipes.Parse as Pp-import Pipes.ByteString.Parse (isEndOfBytes)-import qualified Data.Binary as Bin (get, put)-import qualified Data.Binary.Put as Put (runPut)+import qualified Pipes.ByteString+import Pipes.Parse (Parser)+ ---------------------------------------------------------------------------------import Data.Binary (Binary)-import Data.Binary.Get (ByteOffset, Get)-import Data.Binary.Put (Put) --- $exports------ The following types are re-exported on this module for your convenience:------ [From "Data.Binary"] 'Binary'.------ [From "Data.Binary.Get"] 'Get', 'ByteOffset'.------ [From "Data.Binary.Put"] 'Put'.+type Iso' a b = forall f p. (Functor f, Profunctor p) => p b (f b) -> p a (f a) -------------------------------------------------------------------------------- --- | Try to decode leading output from the underlying 'Producer' into a--- 'Bin.Binary' instance, returning either a 'I.DecodingError' on failure, or a--- pair with the decoded entity together with the number of bytes consumed in--- order to produce it.+-- | Convert a value to a byte stream. ----- /Do not/ use this function if 'isEndOfBytes' returns 'True', otherwise you--- may get unexpected decoding errors.-decode- :: (Monad m, Binary b)- => Pp.StateT (Producer B.ByteString m r) m- (Either I.DecodingError (ByteOffset, b)) -- ^-decode = decodeGet Bin.get+-- Keep in mind that a single encode value might be split into many 'ByteString'+-- chunks, that is, the lenght of the obtained 'Producer' might be greater than+-- 1.+encode :: (Monad m, Binary a) => a -> Producer ByteString m ()+encode = encodePut . put+{-# INLINABLE encode #-}++-- | Like 'encode', except this uses an explicit 'Put'.+encodePut :: (Monad m) => Put -> Producer ByteString m ()+encodePut = Pipes.ByteString.fromLazy . Put.runPut+{-# INLINABLE encodePut #-}++--------------------------------------------------------------------------------++-- | Parse a value from a byte stream.+decode :: (Monad m, Binary a) => Parser ByteString m (Either DecodingError a)+decode = do+ x <- decodeL+ return (case x of+ Left e -> Left e+ Right (_, a) -> Right a) {-# INLINABLE decode #-} --- | Like 'decode', except it takes an explicit 'Bin.Get' monad.-decodeGet- :: Monad m- => Get b -- ^- -> Pp.StateT (Producer B.ByteString m r) m- (Either I.DecodingError (ByteOffset, b))-decodeGet get = do- (er, mlo) <- I.parseWithDraw get- case mlo of- Just lo -> Pp.unDraw lo- Nothing -> return ()- return er+-- | An isomorphism between a stream of bytes and a stream of decoded values.+decoded+ :: (Monad m, Binary a)+ => Iso' (Producer ByteString m r)+ (Producer a m (Either (DecodingError, Producer ByteString m r) r))+decoded = dimap _decode (fmap _encode)+ where+ _decode p0 = do+ (mr, p1) <- lift (S.runStateT isEndOfBytes' p0)+ case mr of+ Just r -> return (Right r)+ Nothing -> do+ (ea, p2) <- lift (S.runStateT decode p1)+ case ea of+ Left e -> return (Left (e, p2))+ Right a -> yield a >> _decode p2+ _encode p0 = do+ er <- for p0 encode+ case er of+ Left (_, p1) -> p1+ Right r -> return r+{-# INLINABLE decoded #-}++--------------------------------------------------------------------------------++-- | Like 'decode', but also returns the length of input consumed in order to+-- to decode the value.+decodeL+ :: (Monad m, Binary a)+ => Parser ByteString m (Either DecodingError (ByteOffset, a))+decodeL = decodeGetL get+{-# INLINABLE decodeL #-}++-- | Like 'decoded', except this tags each decoded value with the length of+-- input consumed in order to decode it.+decodedL+ :: (Monad m, Binary a)+ => Iso' (Producer ByteString m r)+ (Producer (ByteOffset, a) m+ (Either (DecodingError, Producer ByteString m r) r))+decodedL = dimap _decode (fmap _encode)+ where+ _decode p0 = do+ (mr, p1) <- lift (S.runStateT isEndOfBytes' p0)+ case mr of+ Just r -> return (Right r)+ Nothing -> do+ (ea, p2) <- lift (S.runStateT decodeL p1)+ case ea of+ Left e -> return (Left (e, p2))+ Right a -> yield a >> _decode p2+ _encode p0 = do+ er <- for p0 (\(_, a) -> encode a)+ case er of+ Left (_, p1) -> p1+ Right r -> return r+{-# INLINABLE decodedL #-}++--------------------------------------------------------------------------------++-- | Like 'decode', except this requires an explicit 'Get' instead of any+-- 'Binary' instance.+decodeGet :: (Monad m) => Get a -> Parser ByteString m (Either DecodingError a)+decodeGet m = do+ x <- decodeGetL m+ return (case x of+ Left e -> Left e+ Right (_, a) -> Right a) {-# INLINABLE decodeGet #-} --- | Continuously decode output from the given 'Producer' into a 'Bin.Binary'--- instance, sending downstream pairs of each successfully decoded entity--- together with the number of bytes consumed in order to produce it.------ This 'Producer' runs until it either runs out of input or a decoding--- failure occurs, in which case it returns 'Left' with a 'I.DecodingError' and--- a 'Producer' with any leftovers. You can use 'P.errorP' to turn the 'Either'--- return value into an 'Control.Monad.Trans.Error.ErrorT' monad transformer.-decodeMany- :: (Monad m, Binary b)- => Producer B.ByteString m r -- ^Producer from which to draw input.- -> Producer' (ByteOffset, b) m- (Either (I.DecodingError, Producer B.ByteString m r) r)-decodeMany src = decodeGetMany Bin.get src-{-# INLINABLE decodeMany #-}+-- | Like 'decodeL', except this requires an explicit 'Get' instead of any+-- 'Binary' instance.+decodeGetL+ :: (Monad m)+ => Get a -> Parser ByteString m (Either DecodingError (ByteOffset, a))+decodeGetL m = S.StateT (go id (Get.runGetIncremental m))+ where+ go diffP decoder p0 = case decoder of+ Get.Fail _ off str -> return (Left (DecodingError off str), diffP p0)+ Get.Done bs off a -> return (Right (off, a), yield bs >> p0)+ Get.Partial k -> do+ x <- next p0+ case x of+ Left e -> go diffP (k Nothing) (return e)+ Right (bs, p1) -> go (diffP . (yield bs >>)) (k (Just bs)) p1+{-# INLINABLE decodeGetL #-} --- | Like 'decodeMany', except it takes an explicit 'Bin.Get' monad.-decodeGetMany- :: Monad m- => Get b- -> Producer B.ByteString m r -- ^Producer from which to draw input.- -> Producer' (ByteOffset, b) m- (Either (I.DecodingError, Producer B.ByteString m r) r)-decodeGetMany get src = do- (me, src') <- P.runStateP src go- return $ case me of- Left e -> Left (e, src')- Right r -> Right r+--------------------------------------------------------------------------------++-- | A 'Get' decoding error, as provided by 'Get.Fail'.+data DecodingError = DecodingError+ { deConsumed :: {-# UNPACK #-} !ByteOffset+ -- ^ Number of bytes consumed before the error+ , deMessage :: !String+ -- ^ Error message+ } deriving (Show, Read, Eq, Data, Typeable, Generic)++instance Exception DecodingError+instance Error DecodingError++--------------------------------------------------------------------------------+-- Internal stuff++-- | Like 'Pipes.ByteString.isEndOfBytes', except it returns @'Just' r@ if the+-- there are no more bytes, otherwise 'Nothing'.+isEndOfBytes':: Monad m => S.StateT (Producer ByteString m r) m (Maybe r)+isEndOfBytes' = step =<< S.get where- go = do- eof <- lift isEndOfBytes- if eof- then do- ra <- lift Pp.draw- case ra of- Left r -> return (Right r)- Right _ -> error "Pipes.Binary.decodeGetMany: impossible!"- else do- eb <- lift (decodeGet get)- case eb of- Left e -> return (Left e)- Right b -> yield b >> go-{-# INLINABLE decodeGetMany #-}+ step p0 = do+ x <- lift (next p0)+ case x of+ Left r -> S.put (return r) >> return (Just r)+ Right (a,p1)+ | B.null a -> step p1+ | otherwise -> S.put (yield a >> p1) >> return Nothing+{-# INLINABLE isEndOfBytes' #-} -------------------------------------------------------------------------------- --- | Encodes the given 'Bin.Binary' instance and sends it downstream in--- 'BS.ByteString' chunks.+-- $exports ----- Hint: You can easily turn this 'Producer'' into a 'Pipe' that encodes--- 'Binary' instances as they flow downstream using:+-- The following types are re-exported from this module for your convenience: ----- @--- 'for' 'cat' 'encode' :: ('Monad' m, 'Binary' a) => 'Pipe' a 'B.ByteString' m r--- @-encode :: (Monad m, Binary x) => x -> Producer' B.ByteString m ()-encode = \x -> encodePut (Bin.put x)-{-# INLINABLE encode #-}+-- [From "Data.Binary"] 'Binary'+--+-- [From "Data.Binary.Put"] 'Put'+--+-- [From "Data.Binary.Get"] 'Get', 'ByteOffset'+--+-- [From "Data.ByteString"] 'ByteString'+--+-- [From "Pipes.Parse"] 'Parser' --- | Like 'encode', except it takes an explicit 'Bin.Put' monad.-encodePut :: Monad m => Put -> Producer' B.ByteString m ()-encodePut = \put -> do- BLI.foldrChunks (\e a -> respond e >> a) (return ()) (Put.runPut put)-{-# INLINABLE encodePut #-}+--------------------------------------------------------------------------------++{- $tutorial++ Use 'encode' to convert values to byte streams++> -- example.hs+>+> import Pipes+> import qualified Pipes.Prelude as P+> import Pipes.Binary+>+> readInts :: Int -> Producer Int IO ()+> readInts n = P.readLn >-> P.take n+>+> encodedValues :: Producer ByteString IO ()+> encodedValues = do+> for (readInts 3) encode -- Encode 3 Ints read from user input+> encode 'C' -- Encode a 'Char'+> encode True -- Encode a 'Bool'++ Use 'decode' to parse a single decoded value or 'decoded' to access a stream+ of decoded values:++> -- example.hs+>+> import Data.ByteString (ByteString)+> import Pipes.Parse+> import Prelude hiding (splitAt)+>+> -- We need to import 'zoom', which can be found in many packages and all work+> -- equally fine for our purposes. Read "Pipes.Parse.Tutorial" for details.+> --+> -- * From the package @lens-family-core@: 'Lens.Family.State.Strict.zoom'+> -- * From the package @lens-family@: 'Lens.Family2.State.Strict.zoom'+> -- * From the package @lens@: 'Control.Lens.Zoom.zoom'+> import Lens.Family.State.Strict (zoom)+>+> decoder :: Parser ByteString IO ()+> decoder = do+> xs <- zoom (decoded . splitAt 3) drawAll -- Decode up to three 'Int's+> lift $ print (xs :: [Int])+> y <- decode -- Decode a single 'Char'+> lift $ print (y :: Either DecodingError Char)+> z <- zoom decoded draw -- Same as 'decode', but+> lift $ print (z :: Maybe Bool) -- with a 'Maybe'+>+> main = evalStateT decoder encodedValues++ Here are some example inputs:++> $ ./example+> 1<Enter>+> 2<Enter>+> 3<Enter>+> [1,2,3]+> Right 'C'+> Just True+> $ ./example+> <Ctrl-D>+> []+> Right 'C'+> Just True++-}
− src/Pipes/Binary/Internal.hs
@@ -1,79 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleInstances #-}---- | This module provides low-level integration with the @binary@ package and is--- likely to be modified in backwards-incompatible ways in the future.------ Use the "Pipes.Binary" module instead.--module Pipes.Binary.Internal- ( DecodingError(..)- , parseWithDraw- ) where-----------------------------------------------------------------------------------import Control.Exception (Exception)-import Control.Monad.Trans.Error (Error)-import qualified Data.ByteString as B-import qualified Data.Binary.Get as Get-import Data.Data (Data, Typeable)-import Pipes (Producer)-import qualified Pipes.Parse as Pp------------------------------------------------------------------------------------- | A 'Get.Get' decoding error, as provided by 'Get.Fail'.-data DecodingError = DecodingError- { peConsumed :: Get.ByteOffset -- ^Number of bytes consumed before the error.- , peMessage :: String -- ^Error message.- } deriving (Show, Read, Eq, Data, Typeable)--instance Exception DecodingError-instance Error DecodingError-----------------------------------------------------------------------------------instance Monad m => Error (DecodingError, Producer B.ByteString m r)------------------------------------------------------------------------------------- | Run a 'Get.Get' drawing input from the given monadic action as needed.-parseWith- :: Monad m- => m (Maybe B.ByteString)- -- ^An action that will be executed to provide the parser with more input- -- as needed. If the action returns 'Nothing', then it's assumed no more- -- input is available.- -> Get.Get r- -- ^Parser to run on the given input.- -> m (Either DecodingError (Get.ByteOffset, r), Maybe B.ByteString)- -- ^Either a decoding error or a pair of a result and the number of bytes- -- consumed, as well as an any leftovers.-parseWith refill = \g -> step (Get.runGetIncremental g)- where- step (Get.Partial k) = refill >>= \a -> step (k a)- step (Get.Done lo n r) = return (Right (n, r), mayInput lo)- step (Get.Fail lo n m) = return (Left (DecodingError n m), mayInput lo)-{-# INLINABLE parseWith #-}---- | Run a parser drawing input from the underlying 'Producer'.-parseWithDraw- :: Monad m- => Get.Get b -- ^Parser to run on the given input.- -> Pp.StateT (Producer B.ByteString m r) m- (Either DecodingError (Get.ByteOffset, b), Maybe B.ByteString)-parseWithDraw = parseWith $ do- ea <- Pp.draw- return (case ea of- Left _ -> Nothing- Right a -> Just a)-{-# INLINABLE parseWithDraw #-}-------------------------------------------------------------------------------------- | Wrap @a@ in 'Just' if not-null. Otherwise, 'Nothing'.-mayInput :: B.ByteString -> Maybe B.ByteString-mayInput x | B.null x = Nothing- | otherwise = Just x-{-# INLINE mayInput #-}
+ tests/Main.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import qualified Test.Tasty as Tasty+import Test.Tasty.HUnit (testCase, (@=?))+import qualified Test.Tasty.Runners as Tasty+import Test.Tasty.SmallCheck (forAll, testProperty)+++import Control.Monad+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.State.Strict (StateT, evalStateT,+ runStateT)+import qualified Data.Binary as Bin+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Functor.Identity (runIdentity)+import Data.Maybe+import Lens.Family.State.Strict (zoom)+import Pipes+import qualified Pipes.Binary as PBin+import qualified Pipes.Parse as PP+import qualified Pipes.Prelude as P++--------------------------------------------------------------------------------++main :: IO ()+main = Tasty.defaultMainWithIngredients+ [ Tasty.consoleTestReporter+ , Tasty.listingTests+ ] tests+++tests :: Tasty.TestTree+tests = Tasty.testGroup "root"+ [ testFunctorLaws+ , testPipesBinary+ ]+++testFunctorLaws :: Tasty.TestTree+testFunctorLaws = Tasty.testGroup "Functor laws (sample test)"+ [ testCase "fmap id Nothing = Nothing" $ do+ fmap id Nothing @=? (Nothing :: Maybe ())+ , testProperty "fmap id = id" $ do+ forAll $ \(x :: [Int]) ->+ fmap id x == id x+ , testCase "fmap (f . g) Nothing = (fmap f . fmap g) Nothing" $ do+ fmap (not . not) Nothing @=? (fmap not . fmap not) (Nothing :: Maybe Bool)+ , testProperty "fmap (f . g) = fmap f . fmap g" $ do+ forAll $ \(x :: [Int]) ->+ fmap (odd . succ) x == (fmap odd . fmap succ) x+ ]++-- Just an arbitrary type that can be generated by SmallCheck.+type FunnyType = (String, (Double, (Int, (Maybe Int, Either Bool Int))))++testPipesBinary :: Tasty.TestTree+testPipesBinary = Tasty.testGroup "pipes-binary"+ [ testProperty "Pipes.Binary.encode ~ Data.Binary.encode" $ do+ forAll $ \(x :: FunnyType) ->+ BL.toStrict (Bin.encode x) == B.concat (P.toList (PBin.encode x))++ , testProperty "Pipes.Binary.decodeL ~ Data.Binary.decode" $ do+ forAll $ \(x :: FunnyType) ->+ let bl = Bin.encode x+ bs = BL.toStrict bl+ o1 = Bin.decodeOrFail bl+ (o2,s2) = fmap (B.concat . P.toList)+ (runIdentity $ runStateT PBin.decodeL (yield bs))+ in case (o1, o2) of+ (Left (s1,n1,_), Left (PBin.DecodingError n2 _)) ->+ n1 == n2 && BL.toStrict s1 == s2+ (Right (s1,n1,a1), Right (n2,a2)) ->+ n1 == n2 && BL.toStrict s1 == s2 && a1 == (a2 :: FunnyType)+ _ -> False++ , testProperty "Pipes.Binary.decodeL ~ Pipes.Binary.decode" $ do+ forAll $ \(x :: FunnyType) ->+ let bs = BL.toStrict $ Bin.encode x+ o1 = runIdentity $ evalStateT PBin.decodeL (yield bs)+ o2 = runIdentity $ evalStateT PBin.decode (yield bs)+ in fmap snd o1 == (o2 :: Either PBin.DecodingError FunnyType)++ , testProperty "Pipes.Binary.decoded zoom" $ do+ forAll $ \amx0 amx1 amx2 amx3 amx4 amx5 amx6 ->+ let xs :: [FunnyType] -- I get more tests cases this way.+ xs = [amx0, amx1, amx2, amx3, amx4, amx5, amx6] >>= maybe [] id+ dec0 :: Monad m => MaybeT (StateT (Producer B.ByteString m a) m) ()+ dec0 = do+ case xs of+ [] -> do+ mx0' <- lift $ zoom PBin.decoded PP.draw+ guard $ isNothing (mx0' :: Maybe FunnyType)+ rest <- lift $ zoom PBin.decoded PP.drawAll+ guard $ null (rest :: [FunnyType])+ (x0:x1:x2:xrest) -> do+ x0x1' <- lift $ zoom (PBin.decoded . PP.splitAt 2) PP.drawAll+ guard $ [x0,x1] == x0x1'+ ex2' <- lift $ PBin.decode+ guard $ Right x2 == ex2'+ mx3' <- lift $ zoom PBin.decoded PP.draw+ case (mx3', xrest) of+ (Nothing, []) -> return ()+ (Just x3', (x3:rest))+ | x3' == x3 -> do+ rest' <- lift $ zoom PBin.decoded PP.drawAll+ guard $ rest == rest'+ _ -> mzero+ (x0:xrest) -> do+ mx0' <- lift $ zoom PBin.decoded PP.draw+ guard $ Just x0 == mx0'+ xrest' <- lift $ zoom PBin.decoded PP.drawAll+ guard $ xrest == xrest'+ p0 = for (each xs) PBin.encode+ in isJust $ runIdentity $ evalStateT (runMaybeT dec0) p0+ ]