pipes-binary-0.4.1: Encode and decode binary streams using the pipes and binary libraries.

Safe HaskellNone
LanguageHaskell98

Pipes.Binary

Contents

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

Encoding

encode :: (Monad m, Binary a) => a -> Producer' ByteString m () #

Convert a value to a byte stream.

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 a ByteString m r

Explicit Put

encodePut :: Monad m => Put -> Producer' ByteString m () #

Like encode, except this uses an explicit Put.

Decoding

decode :: (Monad m, Binary a) => Parser ByteString m (Either DecodingError a) #

Parse a value from a byte stream.

decoded :: (Monad m, Binary a) => Lens' (Producer ByteString m r) (Producer a m (Either (DecodingError, Producer ByteString m r) r)) #

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 zoom.

zoom decoded (return r) /= return r
zoom decoded (m >>= f)  /= zoom decoded m >>= zoom decoded . f

Including lengths

decodeL :: (Monad m, Binary a) => Parser ByteString m (Either DecodingError (ByteOffset, a)) #

Like decode, but also returns the length of input consumed in order to to decode the value.

decodedL :: (Monad m, Binary a) => Lens' (Producer ByteString m r) (Producer (ByteOffset, a) m (Either (DecodingError, Producer ByteString m r) r)) #

Like decoded, except this tags each decoded value with the length of input consumed in order to decode it.

Explicit Get

decodeGet :: Monad m => Get a -> Parser ByteString m (Either DecodingError a) #

Like decode, except this requires an explicit Get instead of any Binary instance.

decodeGetL :: Monad m => Get a -> Parser ByteString m (Either DecodingError (ByteOffset, a)) #

Like decodeL, except this requires an explicit Get instead of any Binary instance.

Types

data DecodingError #

A Get decoding error, as provided by Fail.

Constructors

DecodingError 

Fields

Instances

Eq DecodingError # 
Data DecodingError # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> DecodingError -> c DecodingError #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c DecodingError #

toConstr :: DecodingError -> Constr #

dataTypeOf :: DecodingError -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c DecodingError) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DecodingError) #

gmapT :: (forall b. Data b => b -> b) -> DecodingError -> DecodingError #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DecodingError -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DecodingError -> r #

gmapQ :: (forall d. Data d => d -> u) -> DecodingError -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> DecodingError -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> DecodingError -> m DecodingError #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> DecodingError -> m DecodingError #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> DecodingError -> m DecodingError #

Read DecodingError # 
Show DecodingError # 
Generic DecodingError # 

Associated Types

type Rep DecodingError :: * -> * #

Exception DecodingError # 
Error DecodingError # 
type Rep DecodingError # 
type Rep DecodingError = D1 (MetaData "DecodingError" "Pipes.Binary" "pipes-binary-0.4.1-6Iqd9m8Jmx113V4aTyTkxU" False) (C1 (MetaCons "DecodingError" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "deConsumed") SourceUnpack SourceStrict DecidedUnpack) (Rec0 ByteOffset)) (S1 (MetaSel (Just Symbol "deMessage") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 String))))

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

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