Copyright | (c) Don Stewart 2006 (c) Duncan Coutts 2006-2011 (c) Michael Thompson 2015 |
---|---|
License | BSD-style |
Safe Haskell | Safe-Inferred |
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
- packBytes :: Monad m => Stream (Of Word8) m r -> ByteStream m r
- unpackBytes :: Monad m => ByteStream m r -> Stream (Of Word8) m r
- chunk :: ByteString -> ByteStream m ()
- smallChunkSize :: Int
- 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
- unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO 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.
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)
{-# INLINABLE packBytes' #-}
Convert a Stream
of pure Word8
into a chunked ByteStream
.
unpackBytes :: Monad m => ByteStream m r -> Stream (Of Word8) m r Source #
chunk :: ByteString -> ByteStream m () Source #
Yield-style smart constructor for Chunk
.
smallChunkSize :: Int Source #
The recommended chunk size. Currently set to 4k, less the memory management overhead
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 closest 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 m (Maybe ByteString)
until it
returns Nothing
. reread
is of particular use rendering io-streams
input
streams as byte streams in the present sense.
import qualified Data.ByteString as B import qualified System.IO.Streams as S Q.reread S.read :: S.InputStream B.ByteString -> Q.ByteStream IO () Q.reread (liftIO . S.read) :: MonadIO m => S.InputStream B.ByteString -> Q.ByteStream m ()
The other direction here is
S.unfoldM Q.unconsChunk :: Q.ByteString IO r -> IO (S.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
.
Re-export from GHC 9.0
unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b #
This is similar to withForeignPtr
but comes with an important caveat:
the user must guarantee that the continuation does not diverge (e.g. loop or
throw an exception). In exchange for this loss of generality, this function
offers the ability of GHC to optimise more aggressively.
Specifically, applications of the form:
unsafeWithForeignPtr fptr (
forever
something)
See GHC issue #17760 for more information about the unsoundness behavior that this function can result in.