enumerator-0.4.11: Reliable, high-performance processing with left-fold enumerators

Portabilityportable
Maintainerjmillikin@gmail.com

Data.Enumerator

Contents

Description

Core enumerator types, and some useful primitives.

This module is intended to be imported qualified:

 import qualified Data.Enumerator as E

Synopsis

Types

data Stream a Source

A Stream is a sequence of chunks generated by an Enumerator.

(Chunks []) is used to indicate that a stream is still active, but currently has no available data. Iteratees should ignore empty chunks.

Constructors

Chunks [a] 
EOF 

Instances

Monad Stream 
Functor Stream 
Typeable1 Stream

Since: 0.4.8

Applicative Stream

Since: 0.4.5

Eq a => Eq (Stream a) 
Show a => Show (Stream a) 
Monoid (Stream a) 

newtype Iteratee a m b Source

The primary data type for this library, which consumes input from a Stream until it either generates a value or encounters an error. Rather than requiring all input at once, an iteratee will return Continue when it is capable of processing more data.

In general, iteratees begin in the Continue state. As each chunk is passed to the continuation, the iteratee returns the next step: Continue for more data, Yield when it's finished, or Error to abort processing.

Constructors

Iteratee 

Fields

runIteratee :: m (Step a m b)
 

Instances

MonadTrans (Iteratee a) 
Monad m => Monad (Iteratee a m) 
Monad m => Functor (Iteratee a m) 
(Typeable a, Typeable1 m) => Typeable1 (Iteratee a m)

Since: 0.4.6

Monad m => Applicative (Iteratee a m) 
MonadIO m => MonadIO (Iteratee a m) 

data Step a m b Source

Constructors

Continue (Stream a -> Iteratee a m b)

The Iteratee is capable of accepting more input. Note that more input is not necessarily required; the Iteratee might be able to generate a value immediately if it receives EOF.

Yield b (Stream a)

The Iteratee cannot receive any more input, and has generated a result. Included in this value is left-over input, which can be passed to composed Iteratees.

Error SomeException

The Iteratee encountered an error which prevents it from proceeding further.

Instances

(Typeable a, Typeable1 m) => Typeable1 (Step a m)

Since: 0.4.8

type Enumerator a m b = Step a m b -> Iteratee a m bSource

While Iteratees consume data, enumerators generate it. Since Iteratee is an alias for m (Step a m b), Enumerators can be considered step transformers of type Step a m b -> m (Step a m b).

Enumerators typically read from an external source (parser, handle, random generator, etc). They feed chunks into an Iteratee until the source runs out of data (triggering EOF) or the iteratee finishes processing (Yields a value).

type Enumeratee ao ai m b = Step ai m b -> Iteratee ao m (Step ai m b)Source

In cases where an enumerator acts as both a source and sink, the resulting type is named an Enumeratee. Enumeratees have two input types, “outer a” (aOut) and “inner a” (aIn).

Primitives

returnI :: Monad m => Step a m b -> Iteratee a m bSource

returnI step = Iteratee (return step)

continue :: Monad m => (Stream a -> Iteratee a m b) -> Iteratee a m bSource

yield :: Monad m => b -> Stream a -> Iteratee a m bSource

yield x extra = returnI (Yield x extra)

WARNING: due to the current encoding of iteratees in this library, careless use of the yield primitive may violate the monad laws. To prevent this, always make sure that an iteratee never yields extra data unless it has received at least one input element.

More strictly, iteratees may not yield data that they did not receive as input. Don't use yield to “inject” elements into the stream.

Operators

(>>==) :: Monad m => Iteratee a m b -> (Step a m b -> Iteratee a' m b') -> Iteratee a' m b'Source

Equivalent to '(>>=)' for m (Step a m b); allows Iteratees with different input types to be composed.

(==<<) :: Monad m => (Step a m b -> Iteratee a' m b') -> Iteratee a m b -> Iteratee a' m b'Source

'(==<<)' = flip '(>>==)'

($$) :: Monad m => (Step a m b -> Iteratee a' m b') -> Iteratee a m b -> Iteratee a' m b'Source

'($$)' = '(==<<)'

This might be easier to read when passing a chain of iteratees to an enumerator.

Since: 0.1.1

(>==>) :: Monad m => Enumerator a m b -> (Step a m b -> Iteratee a' m b') -> Step a m b -> Iteratee a' m b'Source

'(>==>)' e1 e2 s = e1 s >>== e2

Since: 0.1.1

(<==<) :: Monad m => (Step a m b -> Iteratee a' m b') -> Enumerator a m b -> Step a m b -> Iteratee a' m b'Source

'(<==<)' = flip '(>==>)'

Since: 0.1.1

(=$) :: Monad m => Enumeratee ao ai m b -> Iteratee ai m b -> Iteratee ao m bSource

enum =$ iter = joinI (enum $$ iter)

“Wraps” an iteratee inner in an enumeratee wrapper. The resulting iteratee will consume wrapper’s input type and yield inner’s output type.

Note: if the inner iteratee yields leftover input when it finishes, that extra will be discarded.

As an example, consider an iteratee that converts a stream of UTF8-encoded bytes into a single TL.Text:

 consumeUTF8 :: Monad m => Iteratee ByteString m Text

It could be written with either joinI or '(=$)':

 import Data.Enumerator.Text as ET

 consumeUTF8 = joinI (decode utf8 $$ ET.consume)
 consumeUTF8 = decode utf8 =$ ET.consume

Since: 0.4.9

($=) :: Monad m => Enumerator ao m (Step ai m b) -> Enumeratee ao ai m b -> Enumerator ai m bSource

enum $= enee = joinE enum enee

“Wraps” an enumerator inner in an enumeratee wrapper. The resulting enumerator will generate wrapper’s output type.

As an example, consider an enumerator that yields line character counts for a text file (e.g. for source code readability checking):

 enumFileCounts :: FilePath -> Enumerator Int IO b

It could be written with either joinE or '($=)':

 import Data.Text as T
 import Data.Enumerator.List as EL
 import Data.Enumerator.Text as ET

 enumFileCounts path = joinE (enumFile path) (EL.map T.length)
 enumFileCounts path = enumFile path $= EL.map T.length

Since: 0.4.9

Running iteratees

run :: Monad m => Iteratee a m b -> m (Either SomeException b)Source

Run an iteratee until it finishes, and return either the final value (if it succeeded) or the error (if it failed).

run_ :: Monad m => Iteratee a m b -> m bSource

Like run, except errors are converted to exceptions and thrown. Primarily useful for small scripts or other simple cases.

Since: 0.4.1

Error handling

catchError :: Monad m => Iteratee a m b -> (SomeException -> Iteratee a m b) -> Iteratee a m bSource

Runs the iteratee, and calls an exception handler if an Error is returned. By handling errors within the enumerator library, and requiring all errors to be represented by SomeException, libraries with varying error types can be easily composed.

Since: 0.1.1

Miscellaneous

concatEnums :: Monad m => [Enumerator a m b] -> Enumerator a m bSource

Compose a list of Enumerators using '(>>==)'

joinI :: Monad m => Iteratee a m (Step a' m b) -> Iteratee a m bSource

joinI is used to “flatten” Enumeratees into an Iteratee.

joinE :: Monad m => Enumerator ao m (Step ai m b) -> Enumeratee ao ai m b -> Enumerator ai m bSource

Flatten an enumerator/enumeratee pair into a single enumerator.

sequence :: Monad m => Iteratee ao m ai -> Enumeratee ao ai m bSource

Feeds outer input elements into the provided iteratee until it yields an inner input, passes that to the inner iteratee, and then loops.

enumEOF :: Monad m => Enumerator a m bSource

Sends EOF to its iteratee. Most clients should use run or run_ instead.

checkContinue0 :: Monad m => (Enumerator a m b -> (Stream a -> Iteratee a m b) -> Iteratee a m b) -> Enumerator a m bSource

A common pattern in Enumerator implementations is to check whether the inner Iteratee has finished, and if so, to return its output. checkContinue0 passes its parameter a continuation if the Iteratee can still consume input; if not, it returns the iteratee's step.

The type signature here is a bit crazy, but it's actually very easy to use. Take this code:

 repeat :: Monad m => a -> Enumerator a m b
 repeat x = loop where
 	loop (Continue k) = k (Chunks [x]) >>== loop
 	loop step = returnI step

And rewrite it without the boilerplate:

 repeat :: Monad m => a -> Enumerator a m b
 repeat x = checkContinue0 $ \loop k -> k (Chunks [x] >>== loop

Since: 0.4.9

checkContinue1 :: Monad m => ((s1 -> Enumerator a m b) -> s1 -> (Stream a -> Iteratee a m b) -> Iteratee a m b) -> s1 -> Enumerator a m bSource

Like checkContinue0, but allows each loop step to use a state value:

 iterate :: Monad m => (a -> a) -> a -> Enumerator a m b
 iterate f = checkContinue1 $ \loop a k -> k (Chunks [a]) >>== loop (f a)

Since: 0.4.9

checkDoneEx :: Monad m => Stream a' -> ((Stream a -> Iteratee a m b) -> Iteratee a' m (Step a m b)) -> Enumeratee a' a m bSource

A common pattern in Enumeratee implementations is to check whether the inner Iteratee has finished, and if so, to return its output. checkDone passes its parameter a continuation if the Iteratee can still consume input, or yields otherwise.

Since: 0.4.3

checkDone :: Monad m => ((Stream a -> Iteratee a m b) -> Iteratee a' m (Step a m b)) -> Enumeratee a' a m bSource

checkDone = checkDoneEx (Chunks [])

Use this for enumeratees which do not have an input buffer.

isEOF :: Monad m => Iteratee a m BoolSource

Check whether a stream has reached EOF. Most clients should use Data.Enumerator.List.head instead.

tryIO :: MonadIO m => IO b -> Iteratee a m bSource

Try to run an IO computation. If it throws an exception, the exception is caught and converted into an {tt Error}.

Since: 0.4.9

Testing and debugging

printChunksSource

Arguments

:: (MonadIO m, Show a) 
=> Bool

Print empty chunks

-> Iteratee a m () 

Print chunks as they're received from the enumerator, optionally printing empty chunks.

enumList :: Monad m => Integer -> [a] -> Enumerator a m bSource

enumList n xs enumerates xs as a stream, passing n inputs per chunk.

Primarily useful for testing and debugging.

Legacy compatibility

Obsolete

liftTrans :: (Monad m, MonadTrans t, Monad (t m)) => Iteratee a m b -> Iteratee a (t m) bSource

Lift an Iteratee onto a monad transformer, re-wrapping the Iteratee’s inner monadic values.

Since: 0.1.1

liftI :: Monad m => (Stream a -> Step a m b) -> Iteratee a m bSource

Deprecated in 0.4.5: use continue instead

peek :: Monad m => Iteratee a m (Maybe a)Source

Peek at the next element in the stream, or Nothing if the stream has ended.

last :: Monad m => Iteratee a m (Maybe a)Source

Get the last element in the stream, or Nothing if the stream has ended.

Consumes the entire stream.

length :: Monad m => Iteratee a m IntegerSource

Get how many elements remained in the stream.

Consumes the entire stream.

Aliases

head :: Monad m => Iteratee a m (Maybe a)Source

Deprecated in 0.4.5: use Data.Enumerator.List.head instead

drop :: Monad m => Integer -> Iteratee a m ()Source

Deprecated in 0.4.5: use Data.Enumerator.List.drop instead

dropWhile :: Monad m => (a -> Bool) -> Iteratee a m ()Source

Deprecated in 0.4.5: use Data.Enumerator.List.dropWhile instead

span :: Monad m => (a -> Bool) -> Iteratee a m [a]Source

Deprecated in 0.4.5: use Data.Enumerator.List.takeWhile instead

break :: Monad m => (a -> Bool) -> Iteratee a m [a]Source

Deprecated in 0.4.5: use Data.Enumerator.List.takeWhile instead

consume :: Monad m => Iteratee a m [a]Source

Deprecated in 0.4.5: use Data.Enumerator.List.consume instead

foldl :: Monad m => (b -> a -> b) -> b -> Iteratee a m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.fold instead

Since: 0.4.5

foldl' :: Monad m => (b -> a -> b) -> b -> Iteratee a m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.fold instead

Since: 0.4.5

foldM :: Monad m => (b -> a -> m b) -> b -> Iteratee a m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.foldM instead

Since: 0.4.5

iterate :: Monad m => (a -> a) -> a -> Enumerator a m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.iterate instead

Since: 0.4.5

iterateM :: Monad m => (a -> m a) -> a -> Enumerator a m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.iterateM instead

Since: 0.4.5

repeat :: Monad m => a -> Enumerator a m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.repeat instead

Since: 0.4.5

repeatM :: Monad m => m a -> Enumerator a m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.repeatM instead

Since: 0.4.5

replicate :: Monad m => Integer -> a -> Enumerator a m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.replicate instead

Since: 0.4.5

replicateM :: Monad m => Integer -> m a -> Enumerator a m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.replicateM instead

Since: 0.4.5

generateM :: Monad m => m (Maybe a) -> Enumerator a m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.generateM instead

Since: 0.4.5

map :: Monad m => (ao -> ai) -> Enumeratee ao ai m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.map instead

mapM :: Monad m => (ao -> m ai) -> Enumeratee ao ai m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.mapM instead

Since: 0.4.3

concatMap :: Monad m => (ao -> [ai]) -> Enumeratee ao ai m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.concatMap instead

Since: 0.4.3

concatMapM :: Monad m => (ao -> m [ai]) -> Enumeratee ao ai m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.concatMapM instead

Since: 0.4.5

filter :: Monad m => (a -> Bool) -> Enumeratee a a m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.filter instead

Since: 0.4.5

filterM :: Monad m => (a -> m Bool) -> Enumeratee a a m bSource

Deprecated in 0.4.8: use Data.Enumerator.List.filterM instead

Since: 0.4.5

liftFoldL :: Monad m => (b -> a -> b) -> b -> Iteratee a m bSource

Deprecated in 0.4.5: use Data.Enumerator.List.fold instead

Since: 0.1.1

liftFoldL' :: Monad m => (b -> a -> b) -> b -> Iteratee a m bSource

Deprecated in 0.4.5: use Data.Enumerator.List.fold instead

Since: 0.1.1

liftFoldM :: Monad m => (b -> a -> m b) -> b -> Iteratee a m bSource

Deprecated in 0.4.5: use Data.Enumerator.List.foldM instead

Since: 0.1.1