io-streams-1.0.2.0: Simple, composable, and easy-to-use stream I/O

Safe HaskellNone

System.IO.Streams.Internal

Contents

Description

Internal implementation of the io-streams library, intended for library writers

Library users should use the interface provided by System.IO.Streams

Synopsis

Types

data SP a b Source

A strict pair type.

Constructors

SP !a !b 

data Source c Source

A Source generates values of type c in the IO monad.

Sources wrap ordinary values in a Just and signal end-of-stream by yielding Nothing.

All Sources define an optional push-back mechanism. You can assume that:

 Streams.pushback source c >>= Streams.produce = return (source, Just c)

... unless a Source documents otherwise.

Source is to be considered an implementation detail of the library, and should only be used in code that needs explicit control over the pushback semantics.

Most library users should instead directly use InputStreams, which prevent reuse of previous Sources.

Constructors

Source 

Fields

produce :: IO (SP (Source c) (Maybe c))
 
pushback :: c -> IO (Source c)
 

Instances

data Sink c Source

A Sink consumes values of type c in the IO monad.

Sinks are supplied ordinary values by wrapping them in Just, and you indicate the end of the stream to a Sink by supplying Nothing.

If you supply a value after a Nothing, the behavior is defined by the implementer of the given Sink. (All Sink definitions in this library will simply discard the extra input.)

Library users should use OutputStreams, which prevent reuse of previous Sinks.

Constructors

Sink 

Fields

consume :: Maybe c -> IO (Sink c)
 

Instances

type StreamPair a = SP (InputStream a) (OutputStream a)Source

Internal convenience synonym for a pair of input/output streams.

About pushback

Users can push a value back into an input stream using the unRead function. Usually this will use the default pushback mechanism which provides a buffer for the stream. Some stream transformers, like takeBytes, produce streams that send pushed-back values back to the streams that they wrap. A function like map cannot do this because the types don't match up:

 map :: (a -> b) -> InputStream a -> IO (InputStream b)

A function will usually document if its pushback behaviour differs from the default. No matter what the case, input streams should obey the following law:

 Streams.unRead c stream >> Streams.read stream === return (Just c)

Pushback functions

defaultPushback :: Source c -> c -> IO (Source c)Source

The default pushback implementation. Given a Source and a value to push back, produces a new Source that will produce the value given and yield the original Source, and where pushback recursively calls defaultPushback.

withDefaultPushback :: IO (SP (Source c) (Maybe c)) -> Source cSource

Given an action to use as produce, creates a Source that uses defaultPushback as its pushback.

Basic sources and sinks

nullSource :: Source cSource

An empty source that immediately yields Nothing.

nullSink :: Sink cSource

nullSink discards all values it consumes.

singletonSource :: c -> Source cSource

Transforms any value into a 1-element Source.

simpleSource :: IO (Maybe c) -> IO (Source c)Source

If you have just an IO (Maybe c) action and are happy with the default pushback behaviour, this function is slightly more efficient than using withDefaultPushback. (It allocates less.)

Input and output streams

newtype InputStream c Source

An InputStream generates values of type c in the IO monad.

Two primitive operations are defined on InputStream:

It is intended that InputStreams obey the following law:

unRead c stream >> read stream === return (Just c)

Constructors

IS (IORef (Source c)) 

newtype OutputStream c Source

An OutputStream consumes values of type c in the IO monad. The only primitive operation defined on OutputStream is:

Values of type c are written in an OutputStream by wrapping them in Just, and the end of the stream is indicated by by supplying Nothing.

If you supply a value after a Nothing, the behavior is defined by the implementer of the given OutputStream. (All OutputStream definitions in this library will simply discard the extra input.)

Constructors

OS (IORef (Sink c)) 

Primitive stream operations

read :: InputStream c -> IO (Maybe c)Source

Reads one value from an InputStream.

Returns either a value wrapped in a Just, or Nothing if the end of the stream is reached.

unRead :: c -> InputStream c -> IO ()Source

Pushes a value back onto an input stream. read and unRead should satisfy the following law, with the possible exception of side effects:

 Streams.unRead c stream >> Streams.read stream === return (Just c)

Note that this could be used to add values back to the stream that were not originally drawn from the stream.

peek :: InputStream c -> IO (Maybe c)Source

Observes the first value from an InputStream without consuming it.

Returns Nothing if the InputStream is empty. peek satisfies the following law:

 Streams.peek stream >> Streams.read stream === Streams.read stream

write :: Maybe c -> OutputStream c -> IO ()Source

Feeds a value to an OutputStream. Values of type c are written in an OutputStream by wrapping them in Just, and the end of the stream is indicated by by supplying Nothing.

atEOF :: InputStream a -> IO BoolSource

Checks if an InputStream is at end-of-stream.

Building streams

sinkToStream :: Sink a -> IO (OutputStream a)Source

Converts a Sink to an OutputStream.

makeInputStream :: IO (Maybe a) -> IO (InputStream a)Source

Creates an InputStream from a value-producing action.

(makeInputStream m) calls the action m each time you request a value from the InputStream. The given action is extended with the default pushback mechanism (see System.IO.Streams.Internal).

makeOutputStream :: (Maybe a -> IO ()) -> IO (OutputStream a)Source

Creates an OutputStream from a value-consuming action.

(makeOutputStream f) runs the computation f on each value fed to it.

appendInputStream :: InputStream a -> InputStream a -> IO (InputStream a)Source

appendInputStream concatenates two InputStreams, analogous to (++) for lists.

The second InputStream continues where the first InputStream ends.

Note: values pushed back to appendInputStream are not propagated to either wrapped InputStream.

concatInputStreams :: [InputStream a] -> IO (InputStream a)Source

concatInputStreams concatenates a list of InputStreams, analogous to (++) for lists.

Subsequent InputStreams continue where the previous one InputStream ends.

Note: values pushed back to the InputStream returned by concatInputStreams are not propagated to any of the source InputStreams.

Connecting streams

connect :: InputStream a -> OutputStream a -> IO ()Source

Connects an InputStream and OutputStream, supplying values from the InputStream to the OutputStream, and propagating the end-of-stream message from the InputStream through to the OutputStream.

The connection ends when the InputStream yields a Nothing.

connectTo :: OutputStream a -> InputStream a -> IO ()Source

The connectTo function is just flip connect.

Useful for writing expressions like fromList [1,2,3] >>= connectTo foo.

supply :: InputStream a -> OutputStream a -> IO ()Source

Connects an InputStream to an OutputStream without passing the end-of-stream notification through to the OutputStream.

Use this to supply an OutputStream with multiple InputStreams and use connect for the final InputStream to finalize the OutputStream, like so:

 do Streams.supply  input1 output
    Streams.supply  input2 output
    Streams.connect input3 output

supplyTo :: OutputStream a -> InputStream a -> IO ()Source

supply with the arguments flipped.

Thread safety

lockingInputStream :: InputStream a -> IO (InputStream a)Source

Converts an InputStream into a thread-safe InputStream, at a slight performance penalty.

For performance reasons, this library provides non-thread-safe streams by default. Use the locking functions to convert these streams into slightly slower, but thread-safe, equivalents.

lockingOutputStream :: OutputStream a -> IO (OutputStream a)Source

Converts an OutputStream into a thread-safe OutputStream, at a slight performance penalty.

For performance reasons, this library provides non-thread-safe streams by default. Use the locking functions to convert these streams into slightly slower, but thread-safe, equivalents.

Utility streams

nullInput :: IO (InputStream a)Source

An empty InputStream that yields Nothing immediately.

nullOutput :: IO (OutputStream a)Source

An empty OutputStream that discards any input fed to it.

Generator monad

data Generator r a Source

A Generator is a coroutine monad that can be used to define complex InputStreams. You can cause a value of type Just r to appear when the InputStream is read by calling yield:

 g :: Generator Int ()
 g = do
     Streams.yield 1
     Streams.yield 2
     Streams.yield 3

A Generator can be turned into an InputStream by calling fromGenerator:

 m :: IO [Int]
 m = Streams.fromGenerator g >>= Streams.toList     -- value returned is [1,2,3]

You can perform IO by calling liftIO, and turn a Generator into an InputStream with fromGenerator.

As a general rule, you should not acquire resources that need to be freed from a Generator, because there is no guarantee the coroutine continuation will ever be called, nor can you catch an exception from within a Generator.

generatorToSource :: Generator r a -> Source rSource

Turns a Generator into a Source using the default pushback mechanism.

yield :: r -> Generator r ()Source

Calling yield x causes the value Just x to appear on the input when this generator is converted to an InputStream. The rest of the computation after the call to yield is resumed later when the InputStream is read again.

Consumer monad