streaming-bytestring-0.3.2: Fast, effectful byte streams.
Copyright(c) Don Stewart 2006
(c) Duncan Coutts 2006-2011
(c) Michael Thompson 2015
LicenseBSD-style
Safe HaskellSafe-Inferred
LanguageHaskell2010

Streaming.ByteString.Internal

Description

 
Synopsis

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.

Constructors

Empty r 
Chunk !ByteString (ByteStream m r) 
Go (m (ByteStream m r)) 

Instances

Instances details
MonadTrans ByteStream Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

lift :: Monad m => m a -> ByteStream m a #

MFunctor ByteStream Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

hoist :: forall m n (b :: k). Monad m => (forall a. m a -> n a) -> ByteStream m b -> ByteStream n b #

MonadBase b m => MonadBase b (ByteStream m) Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

liftBase :: b α -> ByteStream m α #

MonadIO m => MonadIO (ByteStream m) Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

liftIO :: IO a -> ByteStream m a #

Monad m => Applicative (ByteStream m) Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

pure :: a -> ByteStream m a #

(<*>) :: ByteStream m (a -> b) -> ByteStream m a -> ByteStream m b #

liftA2 :: (a -> b -> c) -> ByteStream m a -> ByteStream m b -> ByteStream m c #

(*>) :: ByteStream m a -> ByteStream m b -> ByteStream m b #

(<*) :: ByteStream m a -> ByteStream m b -> ByteStream m a #

Monad m => Functor (ByteStream m) Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

fmap :: (a -> b) -> ByteStream m a -> ByteStream m b #

(<$) :: a -> ByteStream m b -> ByteStream m a #

Monad m => Monad (ByteStream m) Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

(>>=) :: ByteStream m a -> (a -> ByteStream m b) -> ByteStream m b #

(>>) :: ByteStream m a -> ByteStream m b -> ByteStream m b #

return :: a -> ByteStream m a #

MonadCatch m => MonadCatch (ByteStream m) Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

catch :: Exception e => ByteStream m a -> (e -> ByteStream m a) -> ByteStream m a #

MonadThrow m => MonadThrow (ByteStream m) Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

throwM :: Exception e => e -> ByteStream m a #

MonadResource m => MonadResource (ByteStream m) Source # 
Instance details

Defined in Streaming.ByteString.Internal

r ~ () => IsString (ByteStream m r) Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

fromString :: String -> ByteStream m r #

(Monoid r, Monad m) => Monoid (ByteStream m r) Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

mempty :: ByteStream m r #

mappend :: ByteStream m r -> ByteStream m r -> ByteStream m r #

mconcat :: [ByteStream m r] -> ByteStream m r #

(Semigroup r, Monad m) => Semigroup (ByteStream m r) Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

(<>) :: ByteStream m r -> ByteStream m r -> ByteStream m r #

sconcat :: NonEmpty (ByteStream m r) -> ByteStream m r #

stimes :: Integral b => b -> ByteStream m r -> ByteStream m r #

(m ~ Identity, Show r) => Show (ByteStream m r) Source # 
Instance details

Defined in Streaming.ByteString.Internal

Methods

showsPrec :: Int -> ByteStream m r -> ShowS #

show :: ByteStream m r -> String #

showList :: [ByteStream m r] -> ShowS #

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.

packChars :: Monad m => Stream (Of Char) m r -> ByteStream m r Source #

Convert a vanilla Stream of characters into a stream of bytes.

Note: Each Char value is truncated to 8 bits.

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 #

The reverse of packChars. Given a stream of bytes, produce a Stream individual bytes.

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.