diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2013, Renzo Carbonara +Copyright (c) 2013-2014, Renzo Carbonara All rights reserved. diff --git a/NEWS b/NEWS deleted file mode 100644 --- a/NEWS +++ /dev/null @@ -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. diff --git a/changelog b/changelog new file mode 100644 --- /dev/null +++ b/changelog @@ -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. diff --git a/pipes-binary.cabal b/pipes-binary.cabal --- a/pipes-binary.cabal +++ b/pipes-binary.cabal @@ -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 diff --git a/src/Pipes/Binary.hs b/src/Pipes/Binary.hs --- a/src/Pipes/Binary.hs +++ b/src/Pipes/Binary.hs @@ -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 +> 2 +> 3 +> [1,2,3] +> Right 'C' +> Just True +> $ ./example +> +> [] +> Right 'C' +> Just True + +-} diff --git a/src/Pipes/Binary/Internal.hs b/src/Pipes/Binary/Internal.hs deleted file mode 100644 --- a/src/Pipes/Binary/Internal.hs +++ /dev/null @@ -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 #-} diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -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 + ]