Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Pipes.Binary
Description
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 Lens' a b = forall f . Functor
f => (b -> f b) -> (a -> f a)
Synopsis
- encode :: forall (m :: Type -> Type) a x' x. (Monad m, Binary a) => a -> Proxy x' x () ByteString m ()
- encodePut :: forall (m :: Type -> Type) x' x. Monad m => Put -> Proxy x' x () ByteString m ()
- decode :: forall (m :: Type -> Type) a. (Monad m, Binary a) => Parser ByteString m (Either DecodingError a)
- decoded :: forall (m :: Type -> Type) a r. (Monad m, Binary a) => Lens' (Producer ByteString m r) (Producer a m (Either (DecodingError, Producer ByteString m r) r))
- decodeL :: forall (m :: Type -> Type) a. (Monad m, Binary a) => Parser ByteString m (Either DecodingError (ByteOffset, a))
- decodedL :: forall (m :: Type -> Type) a r. (Monad m, Binary a) => Lens' (Producer ByteString m r) (Producer (ByteOffset, a) m (Either (DecodingError, Producer ByteString m r) r))
- decodeGet :: forall (m :: Type -> Type) a. Monad m => Get a -> Parser ByteString m (Either DecodingError a)
- decodeGetL :: forall (m :: Type -> Type) a. Monad m => Get a -> Parser ByteString m (Either DecodingError (ByteOffset, a))
- data DecodingError = DecodingError {
- deConsumed :: !ByteOffset
- deMessage :: !String
- class Binary t where
- data Word
- data Get a
- type Put = PutM ()
- data Get a
- type ByteOffset = Int64
- type Put = PutM ()
- data ByteString
- type Parser a (m :: Type -> Type) r = forall x. StateT (Producer a m x) m r
Encoding
encode :: forall (m :: Type -> Type) a x' x. (Monad m, Binary a) => a -> Proxy x' x () ByteString m () Source #
Convert a value to a byte stream.
encode
:: (Monad
m,Binary
a) => a ->Producer'
ByteString
m ()
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.
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
aByteString
m r
Explicit Put
encodePut :: forall (m :: Type -> Type) x' x. Monad m => Put -> Proxy x' x () ByteString m () Source #
Decoding
decode :: forall (m :: Type -> Type) a. (Monad m, Binary a) => Parser ByteString m (Either DecodingError a) Source #
Parse a value from a byte stream.
decoded :: forall (m :: Type -> Type) a r. (Monad m, Binary a) => Lens' (Producer ByteString m r) (Producer a m (Either (DecodingError, Producer ByteString m r) r)) Source #
Including lengths
decodeL :: forall (m :: Type -> Type) a. (Monad m, Binary a) => Parser ByteString m (Either DecodingError (ByteOffset, a)) Source #
Like decode
, but also returns the length of input consumed in order to
to decode the value.
decodedL :: forall (m :: Type -> Type) a r. (Monad m, Binary a) => Lens' (Producer ByteString m r) (Producer (ByteOffset, a) m (Either (DecodingError, Producer ByteString m r) r)) Source #
Like decoded
, except this tags each decoded value with the length of
input consumed in order to decode it.
Explicit Get
decodeGet :: forall (m :: Type -> Type) a. Monad m => Get a -> Parser ByteString m (Either DecodingError a) Source #
decodeGetL :: forall (m :: Type -> Type) a. Monad m => Get a -> Parser ByteString m (Either DecodingError (ByteOffset, a)) Source #
Types
data DecodingError Source #
Constructors
DecodingError | |
Fields
|
Instances
Exports
The following types are re-exported from this module for your convenience:
- From Data.Binary
Binary
- From Data.Binary.Put
Put
- From Data.Binary.Get
Get
,ByteOffset
- From Data.ByteString
ByteString
- From Pipes.Parse
Parser
The Binary
class provides put
and get
, methods to encode and
decode a Haskell value to a lazy ByteString
. It mirrors the Read
and
Show
classes for textual representation of Haskell types, and is
suitable for serialising Haskell values to disk, over the network.
For decoding and generating simple external binary formats (e.g. C
structures), Binary may be used, but in general is not suitable
for complex protocols. Instead use the Put
and Get
primitives
directly.
Instances of Binary should satisfy the following property:
decode . encode == id
That is, the get
and put
methods should be the inverse of each
other. A range of instances are provided for basic Haskell types.
Minimal complete definition
Nothing
Methods
Encode a value in the Put monad.
Decode a value in the Get monad
Encode a list of values in the Put monad. The default implementation may be overridden to be more efficient but must still have the same encoding format.
Instances
Binary ByteString | |
Defined in Data.Binary.Class | |
Binary ByteString | |
Defined in Data.Binary.Class | |
Binary ShortByteString | |
Defined in Data.Binary.Class Methods put :: ShortByteString -> Put # get :: Get ShortByteString # putList :: [ShortByteString] -> Put # | |
Binary IntSet | |
Binary Void | Since: binary-0.8.0.0 |
Binary All | Since: binary-0.8.4.0 |
Binary Any | Since: binary-0.8.4.0 |
Binary SomeTypeRep | |
Defined in Data.Binary.Class | |
Binary Version | Since: binary-0.8.0.0 |
Binary Fingerprint | Since: binary-0.7.6.0 |
Defined in Data.Binary.Class | |
Binary Int16 | |
Binary Int32 | |
Binary Int64 | |
Binary Int8 | |
Binary Word16 | |
Binary Word32 | |
Binary Word64 | |
Binary Word8 | |
Binary KindRep | Since: binary-0.8.5.0 |
Binary Ordering | |
Binary TyCon | Since: binary-0.8.5.0 |
Binary TypeLitSort | Since: binary-0.8.5.0 |
Defined in Data.Binary.Class | |
Binary Integer | |
Binary Natural | Since: binary-0.7.3.0 |
Binary () | |
Binary Bool | |
Binary Char | |
Binary Double | Uses non-IEEE754 encoding. Does not round-trip NaN. |
Binary Float | Uses non-IEEE754 encoding. Does not round-trip NaN. |
Binary Int | |
Binary RuntimeRep | Since: binary-0.8.5.0 |
Defined in Data.Binary.Class | |
Binary VecCount | Since: binary-0.8.5.0 |
Binary VecElem | Since: binary-0.8.5.0 |
Binary Word | |
Binary a => Binary (Complex a) | |
Binary a => Binary (First a) | Since: binary-0.8.4.0 |
Binary a => Binary (Last a) | Since: binary-0.8.4.0 |
Binary a => Binary (Max a) | Since: binary-0.8.4.0 |
Binary a => Binary (Min a) | Since: binary-0.8.4.0 |
Binary m => Binary (WrappedMonoid m) | Since: binary-0.8.4.0 |
Defined in Data.Binary.Class Methods put :: WrappedMonoid m -> Put # get :: Get (WrappedMonoid m) # putList :: [WrappedMonoid m] -> Put # | |
Binary e => Binary (IntMap e) | |
Binary e => Binary (Seq e) | |
Binary a => Binary (Set a) | |
Binary e => Binary (Tree e) | |
Binary a => Binary (NonEmpty a) | Since: binary-0.8.4.0 |
Binary a => Binary (Identity a) | |
Binary a => Binary (First a) | Since: binary-0.8.4.0 |
Binary a => Binary (Last a) | Since: binary-0.8.4.0 |
Binary a => Binary (Dual a) | Since: binary-0.8.4.0 |
Binary a => Binary (Product a) | Since: binary-0.8.4.0 |
Binary a => Binary (Sum a) | Since: binary-0.8.4.0 |
(Binary a, Integral a) => Binary (Ratio a) | |
Binary a => Binary (Maybe a) | |
Binary a => Binary [a] | |
(Binary i, Ix i, Binary e, IArray UArray e) => Binary (UArray i e) | |
Binary (Fixed a) | Since: binary-0.8.0.0 |
(Binary a, Binary b) => Binary (Arg a b) | Since: binary-0.8.4.0 |
(Binary k, Binary e) => Binary (Map k e) | |
(Binary i, Ix i, Binary e) => Binary (Array i e) | |
(Binary a, Binary b) => Binary (Either a b) | |
Typeable a => Binary (TypeRep a) | |
(Binary a, Binary b) => Binary (a, b) | |
Binary (f a) => Binary (Alt f a) | Since: binary-0.8.4.0 |
(Binary a, Binary b, Binary c) => Binary (a, b, c) | |
(Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) | |
(Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a, b, c, d, e) | |
(Binary a, Binary b, Binary c, Binary d, Binary e, Binary f) => Binary (a, b, c, d, e, f) | |
(Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g) => Binary (a, b, c, d, e, f, g) | |
(Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g, Binary h) => Binary (a, b, c, d, e, f, g, h) | |
(Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g, Binary h, Binary i) => Binary (a, b, c, d, e, f, g, h, i) | |
(Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g, Binary h, Binary i, Binary j) => Binary (a, b, c, d, e, f, g, h, i, j) | |
Instances
PrintfArg Word | Since: base-2.1 | ||||
Defined in Text.Printf | |||||
Binary Word | |||||
NFData Word | |||||
Defined in Control.DeepSeq | |||||
Data Word | @since base-4.0.0.0 | ||||
Defined in GHC.Internal.Data.Data Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Word -> c Word # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Word # dataTypeOf :: Word -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Word) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Word) # gmapT :: (forall b. Data b => b -> b) -> Word -> Word # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Word -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Word -> r # gmapQ :: (forall d. Data d => d -> u) -> Word -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Word -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Word -> m Word # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Word -> m Word # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Word -> m Word # | |||||
Read Word | @since base-4.5.0.0 | ||||
Show Word | @since base-2.01 | ||||
Eq Word | |||||
Ord Word | |||||
Hashable Word | |||||
Defined in Data.Hashable.Class | |||||
Lift Word | |||||
Generic1 (URec Word :: k -> Type) | |||||
Defined in GHC.Internal.Generics Associated Types
| |||||
Functor (URec Word :: Type -> Type) | @since base-4.9.0.0 | ||||
Generic (URec Word p) | |||||
Defined in GHC.Internal.Generics Associated Types
| |||||
Show (URec Word p) | @since base-4.9.0.0 | ||||
Eq (URec Word p) | @since base-4.9.0.0 | ||||
Ord (URec Word p) | @since base-4.9.0.0 | ||||
Defined in GHC.Internal.Generics | |||||
data URec Word (p :: k) | Used for marking occurrences of @since base-4.9.0.0 | ||||
type Rep1 (URec Word :: k -> Type) | @since base-4.9.0.0 | ||||
Defined in GHC.Internal.Generics | |||||
type Rep (URec Word p) | @since base-4.9.0.0 | ||||
Defined in GHC.Internal.Generics |
Instances
Alternative Get | Since: binary-0.7.0.0 |
Applicative Get | |
Functor Get | |
Monad Get | |
MonadPlus Get | Since: binary-0.7.1.0 |
MonadFail Get | |
Defined in Data.Binary.Get.Internal |
Instances
Alternative Get | Since: binary-0.7.0.0 |
Applicative Get | |
Functor Get | |
Monad Get | |
MonadPlus Get | Since: binary-0.7.1.0 |
MonadFail Get | |
Defined in Data.Binary.Get.Internal |
type ByteOffset = Int64 #
An offset, counted in bytes.
data ByteString #
A space-efficient representation of a Word8
vector, supporting many
efficient operations.
A ByteString
contains 8-bit bytes, or by using the operations from
Data.ByteString.Char8 it can be interpreted as containing 8-bit
characters.
Instances
Binary ByteString | |||||
Defined in Data.Binary.Class | |||||
NFData ByteString | |||||
Defined in Data.ByteString.Internal.Type Methods rnf :: ByteString -> () # | |||||
Monoid ByteString | |||||
Defined in Data.ByteString.Internal.Type Methods mempty :: ByteString # mappend :: ByteString -> ByteString -> ByteString # mconcat :: [ByteString] -> ByteString # | |||||
Semigroup ByteString | |||||
Defined in Data.ByteString.Internal.Type Methods (<>) :: ByteString -> ByteString -> ByteString # sconcat :: NonEmpty ByteString -> ByteString # stimes :: Integral b => b -> ByteString -> ByteString # | |||||
Data ByteString | |||||
Defined in Data.ByteString.Internal.Type Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ByteString -> c ByteString # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ByteString # toConstr :: ByteString -> Constr # dataTypeOf :: ByteString -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ByteString) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ByteString) # gmapT :: (forall b. Data b => b -> b) -> ByteString -> ByteString # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ByteString -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ByteString -> r # gmapQ :: (forall d. Data d => d -> u) -> ByteString -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> ByteString -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> ByteString -> m ByteString # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ByteString -> m ByteString # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ByteString -> m ByteString # | |||||
IsString ByteString | Beware: | ||||
Defined in Data.ByteString.Internal.Type Methods fromString :: String -> ByteString # | |||||
IsList ByteString | Since: bytestring-0.10.12.0 | ||||
Defined in Data.ByteString.Internal.Type Associated Types
Methods fromList :: [Item ByteString] -> ByteString # fromListN :: Int -> [Item ByteString] -> ByteString # toList :: ByteString -> [Item ByteString] # | |||||
Read ByteString | |||||
Defined in Data.ByteString.Internal.Type Methods readsPrec :: Int -> ReadS ByteString # readList :: ReadS [ByteString] # readPrec :: ReadPrec ByteString # readListPrec :: ReadPrec [ByteString] # | |||||
Show ByteString | |||||
Defined in Data.ByteString.Internal.Type Methods showsPrec :: Int -> ByteString -> ShowS # show :: ByteString -> String # showList :: [ByteString] -> ShowS # | |||||
Eq ByteString | |||||
Defined in Data.ByteString.Internal.Type | |||||
Ord ByteString | |||||
Defined in Data.ByteString.Internal.Type Methods compare :: ByteString -> ByteString -> Ordering # (<) :: ByteString -> ByteString -> Bool # (<=) :: ByteString -> ByteString -> Bool # (>) :: ByteString -> ByteString -> Bool # (>=) :: ByteString -> ByteString -> Bool # max :: ByteString -> ByteString -> ByteString # min :: ByteString -> ByteString -> ByteString # | |||||
Hashable ByteString | |||||
Defined in Data.Hashable.Class | |||||
Lift ByteString | Since: bytestring-0.11.2.0 | ||||
Defined in Data.ByteString.Internal.Type Methods lift :: Quote m => ByteString -> m Exp # liftTyped :: forall (m :: Type -> Type). Quote m => ByteString -> Code m ByteString # | |||||
type Item ByteString | |||||
Defined in Data.ByteString.Internal.Type |
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