Copyright | (c) Don Stewart 2006 (c) Duncan Coutts 2006-2011 (c) Michael Thompson 2015 |
---|---|
License | BSD-style |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- data ByteStream m r
- = Empty r
- | Chunk !ByteString (ByteStream m r)
- | Go (m (ByteStream m r))
- type ByteString = ByteStream
- consChunk :: ByteString -> ByteStream m r -> ByteStream m r
- chunkOverhead :: Int
- defaultChunkSize :: Int
- materialize :: (forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x) -> ByteStream m r
- dematerialize :: Monad m => ByteStream m r -> forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x
- foldrChunks :: Monad m => (ByteString -> a -> a) -> a -> ByteStream m r -> m a
- foldlChunks :: Monad m => (a -> ByteString -> a) -> a -> ByteStream m r -> m (Of a r)
- foldrChunksM :: Monad m => (ByteString -> m a -> m a) -> m a -> ByteStream m r -> m a
- foldlChunksM :: Monad m => (a -> ByteString -> m a) -> m a -> ByteStream m r -> m (Of a r)
- chunkFold :: Monad m => (x -> ByteString -> x) -> x -> (x -> a) -> ByteStream m r -> m (Of a r)
- chunkFoldM :: Monad m => (x -> ByteString -> m x) -> m x -> (x -> m a) -> ByteStream m r -> m (Of a r)
- chunkMap :: Monad m => (ByteString -> ByteString) -> ByteStream m r -> ByteStream m r
- chunkMapM :: Monad m => (ByteString -> m ByteString) -> ByteStream m r -> ByteStream m r
- chunkMapM_ :: Monad m => (ByteString -> m x) -> ByteStream m r -> m r
- unfoldMChunks :: Monad m => (s -> m (Maybe (ByteString, s))) -> s -> ByteStream m ()
- unfoldrChunks :: Monad m => (s -> m (Either r (ByteString, s))) -> s -> ByteStream m r
- packChars :: Monad m => Stream (Of Char) m r -> ByteStream m r
- smallChunkSize :: Int
- unpackBytes :: Monad m => ByteStream m r -> Stream (Of Word8) m r
- packBytes :: Monad m => Stream (Of Word8) m r -> ByteStream m r
- chunk :: ByteString -> ByteStream m ()
- mwrap :: m (ByteStream m r) -> ByteStream m r
- unfoldrNE :: Int -> (a -> Either r (Word8, a)) -> a -> (ByteString, Either r a)
- reread :: Monad m => (s -> m (Maybe ByteString)) -> s -> ByteStream m ()
- unsafeLast :: ByteString -> Word8
- unsafeInit :: ByteString -> ByteString
- copy :: Monad m => ByteStream m r -> ByteStream (ByteStream m) r
- findIndexOrEnd :: (Word8 -> Bool) -> ByteString -> Int
- bracketByteString :: MonadResource m => IO a -> (a -> IO ()) -> (a -> ByteStream m b) -> ByteStream m b
Documentation
data ByteStream m r Source #
A space-efficient representation of a succession of Word8
vectors,
supporting many efficient operations.
An effectful ByteStream
contains 8-bit bytes, or by using the operations
from Streaming.ByteString.Char8 it can be interpreted as containing
8-bit characters.
Empty r | |
Chunk !ByteString (ByteStream m r) | |
Go (m (ByteStream m r)) |
Instances
type ByteString = ByteStream Source #
Deprecated: Use ByteStream instead.
A type alias for back-compatibility.
consChunk :: ByteString -> ByteStream m r -> ByteStream m r Source #
Smart constructor for Chunk
.
chunkOverhead :: Int Source #
The memory management overhead. Currently this is tuned for GHC only.
defaultChunkSize :: Int Source #
The chunk size used for I/O. Currently set to 32k, less the memory management overhead
materialize :: (forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x) -> ByteStream m r Source #
Construct a succession of chunks from its Church encoding (compare GHC.Exts.build
)
dematerialize :: Monad m => ByteStream m r -> forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x Source #
Resolve a succession of chunks into its Church encoding; this is not a safe operation; it is equivalent to exposing the constructors
foldrChunks :: Monad m => (ByteString -> a -> a) -> a -> ByteStream m r -> m a Source #
Consume the chunks of an effectful ByteString
with a natural right fold.
foldlChunks :: Monad m => (a -> ByteString -> a) -> a -> ByteStream m r -> m (Of a r) Source #
Consume the chunks of an effectful ByteString
with a left fold. Suitable
for use with mapped
.
foldrChunksM :: Monad m => (ByteString -> m a -> m a) -> m a -> ByteStream m r -> m a Source #
Consume the chunks of an effectful ByteString with a natural right monadic fold.
foldlChunksM :: Monad m => (a -> ByteString -> m a) -> m a -> ByteStream m r -> m (Of a r) Source #
Like foldlChunks
, but fold effectfully. Suitable for use with mapped
.
chunkFold :: Monad m => (x -> ByteString -> x) -> x -> (x -> a) -> ByteStream m r -> m (Of a r) Source #
chunkFold
is preferable to foldlChunks
since it is an appropriate
argument for Control.Foldl.purely
which permits many folds and sinks to be
run simultaneously on one bytestream.
chunkFoldM :: Monad m => (x -> ByteString -> m x) -> m x -> (x -> m a) -> ByteStream m r -> m (Of a r) Source #
chunkFoldM
is preferable to foldlChunksM
since it is an appropriate
argument for impurely
which permits many folds and sinks to
be run simultaneously on one bytestream.
chunkMap :: Monad m => (ByteString -> ByteString) -> ByteStream m r -> ByteStream m r Source #
Instead of mapping over each Word8
or Char
, map over each strict
ByteString
chunk in the stream.
chunkMapM :: Monad m => (ByteString -> m ByteString) -> ByteStream m r -> ByteStream m r Source #
Like chunkMap
, but map effectfully.
chunkMapM_ :: Monad m => (ByteString -> m x) -> ByteStream m r -> m r Source #
Like chunkMapM
, but discard the result of each effectful mapping.
unfoldMChunks :: Monad m => (s -> m (Maybe (ByteString, s))) -> s -> ByteStream m () Source #
Given some continual monadic action that produces strict ByteString
chunks, produce a stream of bytes.
unfoldrChunks :: Monad m => (s -> m (Either r (ByteString, s))) -> s -> ByteStream m r Source #
Like unfoldMChunks
, but feed through a final r
return value.
smallChunkSize :: Int Source #
The recommended chunk size. Currently set to 4k, less the memory management overhead
unpackBytes :: Monad m => ByteStream m r -> Stream (Of Word8) m r Source #
packBytes :: Monad m => Stream (Of Word8) m r -> ByteStream m r Source #
Packing and unpacking from lists
packBytes' :: Monad m => [Word8] -> ByteString m ()
packBytes' cs0 =
packChunks 32 cs0
where
packChunks n cs = case B.packUptoLenBytes n cs of
(bs, []) -> Chunk bs (Empty ())
(bs, cs') -> Chunk bs (packChunks (min (n * 2) BI.smallChunkSize) cs')
-- packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8])
packUptoLenBytes len xs0 =
accursedUnutterablePerformIO (createUptoN' len $ p -> go p len xs0)
where
go !_ !n [] = return (len-n, [])
go !_ !0 xs = return (len, xs)
go !p !n (x:xs) = poke p x >> go (p plusPtr
1) (n-1) xs
createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (B.ByteString, a)
createUptoN' l f = do
fp <- B.mallocByteString l
(l', res) withForeignPtr fp $ p - f p
assert (l' <= l) $ return (B.PS fp 0 l', res)
{--}
chunk :: ByteString -> ByteStream m () Source #
Yield-style smart constructor for Chunk
.
mwrap :: m (ByteStream m r) -> ByteStream m r Source #
Reconceive an effect that results in an effectful bytestring as an effectful bytestring. Compare Streaming.mwrap. The closes equivalent of
>>>
Streaming.wrap :: f (Stream f m r) -> Stream f m r
is here consChunk
. mwrap
is the smart constructor for the internal Go
constructor.
unfoldrNE :: Int -> (a -> Either r (Word8, a)) -> a -> (ByteString, Either r a) Source #
Internal utility for unfoldr
.
reread :: Monad m => (s -> m (Maybe ByteString)) -> s -> ByteStream m () Source #
Stream chunks from something that contains IO (Maybe ByteString)
until it
returns Nothing
. reread
is of particular use rendering io-streams
input
streams as byte streams in the present sense.
Q.reread Streams.read :: InputStream B.ByteString -> Q.ByteString IO () Q.reread (liftIO . Streams.read) :: MonadIO m => InputStream B.ByteString -> Q.ByteString m ()
The other direction here is
Streams.unfoldM Q.unconsChunk :: Q.ByteString IO r -> IO (InputStream B.ByteString)
unsafeLast :: ByteString -> Word8 Source #
Copied from Data.ByteString.Unsafe for compatibility with older bytestring.
unsafeInit :: ByteString -> ByteString Source #
Copied from Data.ByteString.Unsafe for compatibility with older bytestring.
copy :: Monad m => ByteStream m r -> ByteStream (ByteStream m) r Source #
Make the information in a bytestring available to more than one eliminating fold, e.g.
>>>
Q.count 'l' $ Q.count 'o' $ Q.copy $ "hello\nworld"
3 :> (2 :> ())
>>>
Q.length $ Q.count 'l' $ Q.count 'o' $ Q.copy $ Q.copy "hello\nworld"
11 :> (3 :> (2 :> ()))
>>>
runResourceT $ Q.writeFile "hello2.txt" $ Q.writeFile "hello1.txt" $ Q.copy $ "hello\nworld\n"
>>>
:! cat hello2.txt
hello world>>>
:! cat hello1.txt
hello world
This sort of manipulation could as well be acheived by combining folds - using
Control.Foldl
for example. But any sort of manipulation can be involved in
the fold. Here are a couple of trivial complications involving splitting by lines:
>>>
let doubleLines = Q.unlines . maps (<* Q.chunk "\n" ) . Q.lines
>>>
let emphasize = Q.unlines . maps (<* Q.chunk "!" ) . Q.lines
>>>
runResourceT $ Q.writeFile "hello2.txt" $ emphasize $ Q.writeFile "hello1.txt" $ doubleLines $ Q.copy $ "hello\nworld"
>>>
:! cat hello2.txt
hello! world!>>>
:! cat hello1.txt
hello
world
As with the parallel operations in Streaming.Prelude
, we have
Q.effects . Q.copy = id hoist Q.effects . Q.copy = id
The duplication does not by itself involve the copying of bytestring chunks; it just makes two references to each chunk as it arises. This does, however double the number of constructors associated with each chunk.
findIndexOrEnd :: (Word8 -> Bool) -> ByteString -> Int Source #
findIndexOrEnd
is a variant of findIndex, that returns the length of the
string if no element is found, rather than Nothing.
ResourceT help
bracketByteString :: MonadResource m => IO a -> (a -> IO ()) -> (a -> ByteStream m b) -> ByteStream m b Source #
Like bracket
, but specialized for ByteString
.