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

Safe HaskellNone

System.IO.Streams.ByteString

Contents

Description

Stream operations on ByteString.

Synopsis

Counting bytes

countInput :: InputStream ByteString -> IO (InputStream ByteString, IO Int64)Source

Wraps an InputStream, counting the number of bytes produced by the stream as a side effect. Produces a new InputStream as well as an IO action to retrieve the count of bytes produced.

Strings pushed back to the returned InputStream will be pushed back to the original stream, and the count of produced bytes will be subtracted accordingly.

Example:

 ghci> is <- Streams.fromList ["abc", "def", "ghi"::ByteString]
 ghci> (is', getCount) <- Streams.countInput is
 ghci> Streams.read is'
 Just "abc"
 ghci> getCount
 3
 ghci> Streams.unRead "bc" is'
 ghci> getCount
 1
 ghci> Streams.peek is
 Just "bc"
 ghci> Streams.toList is'
 ["bc","def","ghi"]
 ghci> getCount
 9

countOutput :: OutputStream ByteString -> IO (OutputStream ByteString, IO Int64)Source

Wraps an OutputStream, counting the number of bytes consumed by the stream as a side effect. Produces a new OutputStream as well as an IO action to retrieve the count of bytes consumed.

Example:

 ghci> (os :: OutputStream ByteString, getList) <- Streams.listOutputStream
 ghci> (os', getCount) <- Streams.countOutput os
 ghci> Streams.fromList ["abc", "def", "ghi"] >>= Streams.connectTo os'
 ghci> getList
 ["abc","def","ghi"]
 ghci> getCount
 9

Treating strings as streams

Input and output

readExactlySource

Arguments

:: Int

number of bytes to read

-> InputStream ByteString

input stream

-> IO ByteString 

Reads an n-byte ByteString from an input stream. Throws a ReadTooShortException if fewer than n bytes were available.

Example:

 ghci> Streams.fromList ["long string"] >>= Streams.readExactly 6
 "long s"
 ghci> Streams.fromList ["short"] >>= Streams.readExactly 6
 *** Exception: Short read, expected 6 bytes

takeBytesWhileSource

Arguments

:: (Char -> Bool)

predicate

-> InputStream ByteString

input stream

-> IO (Maybe ByteString) 

Takes from a stream until the given predicate is no longer satisfied. Returns Nothing on end-of-stream, or Just "" if the predicate is never satisfied. See takeWhile and takeWhile.

Example:

 ghci> Streams.fromList ["Hello, world!"] >>= Streams.takeBytesWhile (/= ',')
 Just "Hello"
 ghci> import Data.Char
 ghci> Streams.fromList ["7 Samurai"] >>= Streams.takeBytesWhile isAlpha
 Just ""
 ghci> Streams.fromList [] >>= Streams.takeBytesWhile isAlpha
 Nothing

writeLazyByteStringSource

Arguments

:: ByteString

string to write to output

-> OutputStream ByteString

output stream

-> IO () 

Writes a lazy ByteString to an OutputStream.

Example:

 ghci> Streams.writeLazyByteString "Test\n" Streams.stdout
 Test

Stream transformers

Splitting/Joining

splitOnSource

Arguments

:: (Char -> Bool)

predicate used to break the input stream into chunks

-> InputStream ByteString

input stream

-> IO (InputStream ByteString) 

Splits an InputStream over ByteStrings using a delimiter predicate.

Note that:

  • data pushed back with unRead is *not* propagated upstream here.
  • the resulting InputStream may hold an unbounded amount of the bytestring in memory waiting for the function to return true, so this function should not be used in unsafe contexts.
  • the delimiter is NOT included in the output.
  • consecutive delimiters are not merged.

Example:

 ghci> Streams.fromList ["the quick br", "own  fox"::ByteString] >>=
       Streams.splitOn (== ' ') >>= Streams.toList
 ["the","quick","brown","","fox"]

lines :: InputStream ByteString -> IO (InputStream ByteString)Source

Splits a bytestring InputStream into lines. See splitOn and lines.

Example:

 ghci> is <- Streams.fromList ["Hello,\n world!"] >>= Streams.lines
 ghci> replicateM 3 (Streams.read is)
 [Just "Hello", Just ", world!", Nothing]

Note that this may increase the chunk size if the input contains extremely long lines.

unlines :: OutputStream ByteString -> IO (OutputStream ByteString)Source

Intersperses string chunks sent to the given OutputStream with newlines. See intersperse and unlines.

 ghci> os <- Streams.unlines Streams.stdout
 ghci> Streams.write (Just "Hello,") os
 Hello
 ghci> Streams.write Nothing os
 ghci> Streams.write (Just "world!") os
 world!

words :: InputStream ByteString -> IO (InputStream ByteString)Source

Splits a bytestring InputStream into words. See splitOn and words.

Example:

 ghci> is <- Streams.fromList ["Hello, world!"] >>= Streams.words
 ghci> replicateM 3 (Streams.read is)
 [Just "Hello,", Just "world!", Nothing]

Note that this may increase the chunk size if the input contains extremely long words.

unwords :: OutputStream ByteString -> IO (OutputStream ByteString)Source

Intersperses string chunks sent to the given OutputStream with spaces. See intersperse and unwords.

 ghci> os <- Streams.unwords Streams.stdout
 ghci> forM_ [Just "Hello,", Nothing, Just "world!\n"] $ w -> Streams.write w os
 Hello, world!

Other

giveBytesSource

Arguments

:: Int64

maximum number of bytes to send to the wrapped stream

-> OutputStream ByteString

output stream to wrap

-> IO (OutputStream ByteString) 

Wraps an OutputStream, producing a new stream that will pass along at most n bytes to the wrapped stream, throwing any subsequent input away.

Example:

 ghci> (os :: OutputStream ByteString, getList) <- Streams.listOutputStream
 ghci> os' <- Streams.giveBytes 6 os
 ghci> Streams.fromList ["long ", "string"] >>= Streams.connectTo os'
 ghci> getList
 ["long ","s"]

giveExactly :: Int64 -> OutputStream ByteString -> IO (OutputStream ByteString)Source

Wraps an OutputStream, producing a new stream that will pass along exactly n bytes to the wrapped stream. If the stream is sent more or fewer than the given number of bytes, the resulting stream will throw an exception (either TooFewBytesWrittenException or TooManyBytesWrittenException) during a call to write.

Example:

 ghci> is <- Streams.fromList ["ok"]
 ghci> Streams.outputToList (Streams.giveExactly 2 >=> Streams.connect is)
 ["ok"]
 ghci> is <- Streams.fromList ["ok"]
 ghci> Streams.outputToList (Streams.giveExactly 1 >=> Streams.connect is)
 *** Exception: Too many bytes written
 ghci> is <- Streams.fromList ["ok"]
 ghci> Streams.outputToList (Streams.giveExactly 3 >=> Streams.connect is)
 *** Exception: Too few bytes written

takeBytesSource

Arguments

:: Int64

maximum number of bytes to read

-> InputStream ByteString

input stream to wrap

-> IO (InputStream ByteString) 

Wraps an InputStream, producing a new InputStream that will produce at most n bytes, subsequently yielding end-of-stream forever.

Strings pushed back to the returned InputStream will be propagated upstream, modifying the count of taken bytes accordingly.

Example:

 ghci> is <- Streams.fromList ["truncated", " string"::ByteString]
 ghci> is' <- Streams.takeBytes 9 is
 ghci> Streams.read is'
 Just "truncated"
 ghci> Streams.read is'
 Nothing
 ghci> Streams.peek is
 Just " string"
 ghci> Streams.unRead "cated" is'
 ghci> Streams.peek is
 Just "cated"
 ghci> Streams.peek is'
 Just "cated"
 ghci> Streams.read is'
 Just "cated"
 ghci> Streams.read is'
 Nothing
 ghci> Streams.read is
 Just " string"

throwIfConsumesMoreThanSource

Arguments

:: Int64

maximum number of bytes to send to the wrapped stream

-> OutputStream ByteString

output stream to wrap

-> IO (OutputStream ByteString) 

Wraps an OutputStream, producing a new stream that will pass along at most n bytes to the wrapped stream. If more than n bytes are sent to the outer stream, a TooManyBytesWrittenException will be thrown.

Note: if more than n bytes are sent to the outer stream, throwIfConsumesMoreThan will not necessarily send the first n bytes through to the wrapped stream before throwing the exception.

Example:

 ghci> (os :: OutputStream ByteString, getList) <- Streams.listOutputStream
 ghci> os' <- Streams.throwIfConsumesMoreThan 5 os
 ghci> Streams.fromList ["short"] >>= Streams.connectTo os'
 ghci> getList
 ["short"]
 ghci> os'' <- Streams.throwIfConsumesMoreThan 5 os
 ghci> Streams.fromList ["long", "string"] >>= Streams.connectTo os''
 *** Exception: Too many bytes written

throwIfProducesMoreThanSource

Arguments

:: Int64

maximum number of bytes to read

-> InputStream ByteString

input stream

-> IO (InputStream ByteString) 

Wraps an InputStream. If more than n bytes are produced by this stream, read will throw a TooManyBytesReadException.

If a chunk yielded by the input stream would result in more than n bytes being produced, throwIfProducesMoreThan will cut the generated string such that exactly n bytes are yielded by the returned stream, and the subsequent read will throw an exception. Example:

 ghci> is <- Streams.fromList ["abc", "def", "ghi"] >>=
             Streams.throwIfProducesMoreThan 5
 ghci> replicateM 2 (read is)
 [Just "abc",Just "de"]
 ghci> Streams.read is
 *** Exception: Too many bytes read

Strings pushed back to the returned InputStream will be propagated upstream, modifying the count of taken bytes accordingly. Example:

 ghci> is  <- Streams.fromList ["abc", "def", "ghi"]
 ghci> is' <- Streams.throwIfProducesMoreThan 5 is
 ghci> Streams.read is'
 Just "abc"
 ghci> Streams.unRead "xyz" is'
 ghci> Streams.peek is
 Just "xyz"
 ghci> Streams.read is
 Just "xyz"
 ghci> Streams.read is
 Just "de"
 ghci> Streams.read is
 *** Exception: Too many bytes read

Rate limiting

throwIfTooSlowSource

Arguments

:: IO ()

action to bump timeout

-> Double

minimum data rate, in bytes per second

-> Int

amount of time in seconds to wait before data rate calculation takes effect

-> InputStream ByteString

input stream

-> IO (InputStream ByteString) 

Rate-limits an input stream. If the input stream is not read from faster than the given rate, reading from the wrapped stream will throw a RateTooSlowException.

Strings pushed back to the returned InputStream will be propagated up to the original stream.

String search

data MatchInfo Source

MatchInfo provides match information when performing string search.

searchSource

Arguments

:: ByteString

"needle" to look for

-> InputStream ByteString

input stream to wrap

-> IO (InputStream MatchInfo) 

Given a ByteString to look for (the "needle") and an InputStream, produces a new InputStream which yields data of type MatchInfo.

Example:

 ghci> fromList ["food", "oof", "oodles", "ok"] >>=
       search "foo" >>= toList
 [Match "foo",NoMatch "d",NoMatch "oo",Match "foo",NoMatch "dlesok"]

Uses the Boyer-Moore-Horspool algorithm (http://en.wikipedia.org/wiki/Boyer%E2%80%93Moore%E2%80%93Horspool_algorithm).

Exception types

data RateTooSlowException Source

Thrown by throwIfTooSlow if input is not being produced fast enough by the given InputStream.

data ReadTooShortException Source

Thrown by readExactly when not enough bytes were available on the input.