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

Safe HaskellNone
LanguageHaskell2010

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

readExactly Source #

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

takeBytesWhile Source #

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

writeLazyByteString Source #

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

splitOn Source #

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.
  • if the input ends in the delimiter, a final empty string is not emitted. (/Since: 1.5.0.0. Previous versions had the opposite behaviour, which was changed to match lines./)

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

giveBytes Source #

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

takeBytes Source #

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"

takeExactly Source #

Arguments

:: Int64

number of bytes to read

-> InputStream ByteString

input stream to wrap

-> IO (InputStream ByteString) 

Like Streams.takeBytes, but throws ReadTooShortException when there aren't enough bytes present on the source.

throwIfConsumesMoreThan Source #

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

throwIfProducesMoreThan Source #

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

throwIfTooSlow Source #

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.

search Source #

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