pipes-binary 0.3.0.1 → 0.4.0
raw patch · 3 files changed
+53/−42 lines, 3 filesdep −profunctors
Dependencies removed: profunctors
Files
- changelog +7/−0
- pipes-binary.cabal +1/−2
- src/Pipes/Binary.hs +45/−40
changelog view
@@ -1,3 +1,10 @@+# Version 0.4.0++* Generalized `encode` and `encodePut` to `Producer'`s.++* `decoded` and `decodedL` are now `Lens'`, not `Iso'` anymore.++ # Version 0.3.0.1 * Add dependency on `ghc-prim`, needed for GHC 7.4.2.
pipes-binary.cabal view
@@ -1,5 +1,5 @@ name: pipes-binary-version: 0.3.0.1+version: 0.4.0 license: BSD3 license-file: LICENSE copyright: Copyright (c) Renzo Carbonara 2013-2014@@ -35,7 +35,6 @@ , 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
src/Pipes/Binary.hs view
@@ -7,7 +7,7 @@ -- @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)+-- type Lens' a b = forall f . 'Functor' f => (b -> f b) -> (a -> f a) -- @ {-# LANGUAGE DeriveDataTypeable #-}@@ -55,9 +55,7 @@ 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 qualified Pipes.ByteString@@ -65,7 +63,7 @@ -------------------------------------------------------------------------------- -type Iso' a b = forall f p. (Functor f, Profunctor p) => p b (f b) -> p a (f a)+type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a) -------------------------------------------------------------------------------- @@ -74,14 +72,27 @@ -- 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 ()+--+-- /Hint:/ You can easily turn this 'Producer'' into a 'Pipe' that encodes+-- 'Binary' instances as they flow downstream using:+--+-- @+-- 'for' 'cat' 'encode' :: ('Monad' m, 'Binary' a) => 'Pipe' a 'B.ByteString' m r+-- @+encode :: (Monad m, Binary a) => a -> Producer' ByteString m () encode = encodePut . put {-# INLINABLE encode #-}+{-# RULES "p >-> for cat encode" forall p .+ p >-> for cat encode = for p (\a -> encodePut (put a))+ #-} -- | Like 'encode', except this uses an explicit 'Put'.-encodePut :: (Monad m) => Put -> Producer ByteString m ()+encodePut :: (Monad m) => Put -> Producer' ByteString m () encodePut = Pipes.ByteString.fromLazy . Put.runPut {-# INLINABLE encodePut #-}+{-# RULES "p >-> for cat encodePut" forall p.+ p >-> for cat encodePut = for p encodePut+ #-} -------------------------------------------------------------------------------- @@ -94,19 +105,29 @@ Right (_, a) -> Right a) {-# INLINABLE decode #-} --- | An isomorphism between a stream of bytes and a stream of decoded values.+-- | /Improper lens/ that turns a stream of bytes into a stream of decoded+-- values.+--+-- By /improper lens/ we mean that in practice you can't expect the+-- /Monad Morphism Laws/ to be true when using 'decoded' with+-- 'Control.Lens.zoom'.+--+-- @+-- 'Control.Lens.zoom' 'decoded' ('return' r) /= 'return' r+-- 'Control.Lens.zoom' 'decoded' (m >>= k) /= 'Control.Lens.zoom' m >>= 'Control.Lens.zoom' . f+-- @ 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)+ => Lens' (Producer ByteString m r)+ (Producer a m (Either (DecodingError, Producer ByteString m r) r))+decoded k p = fmap _encode (k (_decode p)) 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)+ x <- lift (next p0)+ case x of+ Left r -> return (Right r)+ Right (bs, p1) -> do+ (ea, p2) <- lift $ S.runStateT decode (yield bs >> p1) case ea of Left e -> return (Left (e, p2)) Right a -> yield a >> _decode p2@@ -131,17 +152,17 @@ -- 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)+ => Lens' (Producer ByteString m r)+ (Producer (ByteOffset, a) m+ (Either (DecodingError, Producer ByteString m r) r))+decodedL k p = fmap _encode (k (_decode p)) 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)+ x <- lift (next p0)+ case x of+ Left r -> return (Right r)+ Right (bs, p1) -> do+ (ea, p2) <- lift $ S.runStateT decodeL (yield bs >> p1) case ea of Left e -> return (Left (e, p2)) Right a -> yield a >> _decode p2@@ -194,22 +215,6 @@ 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- 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' #-} --------------------------------------------------------------------------------