diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -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. diff --git a/pipes-binary.cabal b/pipes-binary.cabal --- a/pipes-binary.cabal +++ b/pipes-binary.cabal @@ -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 diff --git a/src/Pipes/Binary.hs b/src/Pipes/Binary.hs --- a/src/Pipes/Binary.hs +++ b/src/Pipes/Binary.hs @@ -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' #-} --------------------------------------------------------------------------------