blaze-builder-0.3.2.0: Blaze/ByteString/Builder/Internal.hs
{-# LANGUAGE CPP, BangPatterns, Rank2Types #-}
#ifdef USE_MONO_PAT_BINDS
{-# LANGUAGE MonoPatBinds #-}
#endif
-- |
-- Module : Blaze.ByteString.Builder.Internal
-- Copyright : (c) 2010 Simon Meier
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Simon Meier <iridcode@gmail.com>
-- Stability : experimental
-- Portability : tested on GHC only
--
-- Core types and functions for the 'Builder' monoid and the 'Put' monad.
--
module Blaze.ByteString.Builder.Internal (
-- * Build Steps
BufRange(..)
, BuildSignal
, BuildStep
, done
, bufferFull
, insertByteString
-- * Builder
, Builder
, fromBuildStepCont
, fromPut
, flush
-- * Put
, Put
, putBuilder
, putBuildStepCont
, putLiftIO
-- * Writes
, module Blaze.ByteString.Builder.Internal.Write
, writeToByteString
-- * Execution
, toLazyByteString
, toLazyByteStringWith
, toByteString
, toByteStringIO
, toByteStringIOWith
-- * Deafult Sizes
, defaultFirstBufferSize
, defaultMinimalBufferSize
, defaultBufferSize
, defaultMaximalCopySize
) where
#ifdef HAS_FOREIGN_UNSAFE_MODULE
import Foreign (withForeignPtr, sizeOf, copyBytes, plusPtr, minusPtr)
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
#else
import Foreign (unsafeForeignPtrToPtr, withForeignPtr, sizeOf, copyBytes, plusPtr, minusPtr)
#endif
import Control.Monad (unless)
import System.IO.Unsafe (unsafeDupablePerformIO)
import qualified Data.ByteString as S
import qualified Data.ByteString.Internal as S
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Internal as L
import Blaze.ByteString.Builder.Internal.Types
import Blaze.ByteString.Builder.Internal.Write
------------------------------------------------------------------------------
-- Internal global constants.
------------------------------------------------------------------------------
-- | Default size (~32kb) for the buffer that becomes a chunk of the output
-- stream once it is filled.
--
defaultBufferSize :: Int
defaultBufferSize = 32 * 1024 - overhead -- Copied from Data.ByteString.Lazy.
where overhead = 2 * sizeOf (undefined :: Int)
-- | The minimal length (~4kb) a buffer must have before filling it and
-- outputting it as a chunk of the output stream.
--
-- This size determines when a buffer is spilled after a 'flush' or a direct
-- bytestring insertion. It is also the size of the first chunk generated by
-- 'toLazyByteString'.
defaultMinimalBufferSize :: Int
defaultMinimalBufferSize = 4 * 1024 - overhead
where overhead = 2 * sizeOf (undefined :: Int)
-- | The default length (64) for the first buffer to be allocated when
-- converting a 'Builder' to a lazy bytestring.
--
-- See 'toLazyByteStringWith' for further explanation.
defaultFirstBufferSize :: Int
defaultFirstBufferSize = 64
-- | The maximal number of bytes for that copying is cheaper than direct
-- insertion into the output stream. This takes into account the fragmentation
-- that may occur in the output buffer due to the early 'flush' implied by the
-- direct bytestring insertion.
--
-- @'defaultMaximalCopySize' = 2 * 'defaultMinimalBufferSize'@
--
defaultMaximalCopySize :: Int
defaultMaximalCopySize = 2 * defaultMinimalBufferSize
------------------------------------------------------------------------------
-- Flushing and running a Builder
------------------------------------------------------------------------------
-- | Prepend the chunk if it is non-empty.
{-# INLINE nonEmptyChunk #-}
nonEmptyChunk :: S.ByteString -> L.ByteString -> L.ByteString
nonEmptyChunk bs lbs | S.null bs = lbs
| otherwise = L.Chunk bs lbs
-- | Output all data written in the current buffer and start a new chunk.
--
-- The use of this function depends on how the resulting bytestrings are
-- consumed. 'flush' is possibly not very useful in non-interactive scenarios.
-- However, it is kept for compatibility with the builder provided by
-- Data.Binary.Builder.
--
-- When using 'toLazyByteString' to extract a lazy 'L.ByteString' from a
-- 'Builder', this means that a new chunk will be started in the resulting lazy
-- 'L.ByteString'. The remaining part of the buffer is spilled, if the
-- reamining free space is smaller than the minimal desired buffer size.
--
{-# INLINE flush #-}
flush :: Builder
flush = fromBuildStepCont step
where
step k !(BufRange op _) = return $ insertByteString op S.empty k
-- | Run a 'Builder' with the given buffer sizes.
--
-- Use this function for integrating the 'Builder' type with other libraries
-- that generate lazy bytestrings.
--
-- Note that the builders should guarantee that on average the desired chunk
-- size is attained. Builders may decide to start a new buffer and not
-- completely fill the existing buffer, if this is faster. However, they should
-- not spill too much of the buffer, if they cannot compensate for it.
--
-- A call @toLazyByteStringWith bufSize minBufSize firstBufSize@ will generate
-- a lazy bytestring according to the following strategy. First, we allocate
-- a buffer of size @firstBufSize@ and start filling it. If it overflows, we
-- allocate a buffer of size @minBufSize@ and copy the first buffer to it in
-- order to avoid generating a too small chunk. Finally, every next buffer will
-- be of size @bufSize@. This, slow startup strategy is required to achieve
-- good speed for short (<200 bytes) resulting bytestrings, as for them the
-- allocation cost is of a large buffer cannot be compensated. Moreover, this
-- strategy also allows us to avoid spilling too much memory for short
-- resulting bytestrings.
--
-- Note that setting @firstBufSize >= minBufSize@ implies that the first buffer
-- is no longer copied but allocated and filled directly. Hence, setting
-- @firstBufSize = bufSize@ means that all chunks will use an underlying buffer
-- of size @bufSize@. This is recommended, if you know that you always output
-- more than @minBufSize@ bytes.
toLazyByteStringWith
:: Int -- ^ Buffer size (upper-bounds the resulting chunk size).
-> Int -- ^ Minimal free buffer space for continuing filling
-- the same buffer after a 'flush' or a direct bytestring
-- insertion. This corresponds to the minimal desired
-- chunk size.
-> Int -- ^ Size of the first buffer to be used and copied for
-- larger resulting sequences
-> Builder -- ^ Builder to run.
-> L.ByteString -- ^ Lazy bytestring to output after the builder is
-- finished.
-> L.ByteString -- ^ Resulting lazy bytestring
toLazyByteStringWith bufSize minBufSize firstBufSize (Builder b) k =
S.inlinePerformIO $ fillFirstBuffer (b (buildStep finalStep))
where
finalStep (BufRange pf _) = return $ Done pf ()
-- fill a first very small buffer, if we need more space then copy it
-- to the new buffer of size 'minBufSize'. This way we don't pay the
-- allocation cost of the big 'bufSize' buffer, when outputting only
-- small sequences.
fillFirstBuffer !step0
| minBufSize <= firstBufSize = fillNewBuffer firstBufSize step0
| otherwise = do
fpbuf <- S.mallocByteString firstBufSize
withForeignPtr fpbuf $ \pf -> do
let !pe = pf `plusPtr` firstBufSize
mkbs pf' = S.PS fpbuf 0 (pf' `minusPtr` pf)
{-# INLINE mkbs #-}
next <- runBuildStep step0 (BufRange pf pe)
case next of
Done pf' _
| pf' == pf -> return k
| otherwise -> return $ L.Chunk (mkbs pf') k
BufferFull newSize pf' nextStep -> do
let !l = pf' `minusPtr` pf
fillNewBuffer (max (l + newSize) minBufSize) $ buildStep $
\(BufRange pfNew peNew) -> do
copyBytes pfNew pf l
let !br' = BufRange (pfNew `plusPtr` l) peNew
runBuildStep nextStep br'
InsertByteString pf' bs nextStep
| pf' == pf ->
return $ nonEmptyChunk bs (S.inlinePerformIO $ fillNewBuffer bufSize nextStep)
| otherwise ->
return $ L.Chunk (mkbs pf')
(nonEmptyChunk bs (S.inlinePerformIO $ fillNewBuffer bufSize nextStep))
-- allocate and fill a new buffer
fillNewBuffer !size !step0 = do
fpbuf <- S.mallocByteString size
withForeignPtr fpbuf $ fillBuffer fpbuf
where
fillBuffer fpbuf !pbuf = fill pbuf step0
where
!pe = pbuf `plusPtr` size
fill !pf !step = do
next <- runBuildStep step (BufRange pf pe)
let mkbs pf' = S.PS fpbuf (pf `minusPtr` pbuf) (pf' `minusPtr` pf)
{-# INLINE mkbs #-}
case next of
Done pf' _
| pf' == pf -> return k
| otherwise -> return $ L.Chunk (mkbs pf') k
BufferFull newSize pf' nextStep
| pf' == pf ->
fillNewBuffer (max newSize bufSize) nextStep
| otherwise ->
return $ L.Chunk (mkbs pf')
(S.inlinePerformIO $
fillNewBuffer (max newSize bufSize) nextStep)
InsertByteString pf' bs nextStep
| pf' == pf ->
return $ nonEmptyChunk bs (S.inlinePerformIO $ fill pf' nextStep)
| minBufSize < pe `minusPtr` pf' ->
return $ L.Chunk (mkbs pf')
(nonEmptyChunk bs (S.inlinePerformIO $ fill pf' nextStep))
| otherwise ->
return $ L.Chunk (mkbs pf')
(nonEmptyChunk bs (S.inlinePerformIO $ fillNewBuffer bufSize nextStep))
-- | Extract the lazy 'L.ByteString' from the builder by running it with default
-- buffer sizes. Use this function, if you do not have any special
-- considerations with respect to buffer sizes.
--
-- @ 'toLazyByteString' b = 'toLazyByteStringWith' 'defaultBufferSize' 'defaultMinimalBufferSize' 'defaultFirstBufferSize' b L.empty@
--
-- Note that @'toLazyByteString'@ is a 'Monoid' homomorphism.
--
-- > toLazyByteString mempty == mempty
-- > toLazyByteString (x `mappend` y) == toLazyByteString x `mappend` toLazyByteString y
--
-- However, in the second equation, the left-hand-side is generally faster to
-- execute.
--
toLazyByteString :: Builder -> L.ByteString
toLazyByteString b = toLazyByteStringWith
defaultBufferSize defaultMinimalBufferSize defaultFirstBufferSize b L.empty
{-# INLINE toLazyByteString #-}
-- | Pack the chunks of a lazy bytestring into a single strict bytestring.
packChunks :: L.ByteString -> S.ByteString
packChunks lbs = do
S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)
where
copyChunks !L.Empty !_pf = return ()
copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf = do
withForeignPtr fpbuf $ \pbuf ->
copyBytes pf (pbuf `plusPtr` o) l
copyChunks lbs' (pf `plusPtr` l)
-- | Run the builder to construct a strict bytestring containing the sequence
-- of bytes denoted by the builder. This is done by first serializing to a lazy bytestring and then packing its
-- chunks to a appropriately sized strict bytestring.
--
-- > toByteString = packChunks . toLazyByteString
--
-- Note that @'toByteString'@ is a 'Monoid' homomorphism.
--
-- > toByteString mempty == mempty
-- > toByteString (x `mappend` y) == toByteString x `mappend` toByteString y
--
-- However, in the second equation, the left-hand-side is generally faster to
-- execute.
--
toByteString :: Builder -> S.ByteString
toByteString = packChunks . toLazyByteString
-- | @toByteStringIOWith bufSize io b@ runs the builder @b@ with a buffer of
-- at least the size @bufSize@ and executes the 'IO' action @io@ whenever the
-- buffer is full.
--
-- Compared to 'toLazyByteStringWith' this function requires less allocation,
-- as the output buffer is only allocated once at the start of the
-- serialization and whenever something bigger than the current buffer size has
-- to be copied into the buffer, which should happen very seldomly for the
-- default buffer size of 32kb. Hence, the pressure on the garbage collector is
-- reduced, which can be an advantage when building long sequences of bytes.
--
toByteStringIOWith :: Int -- ^ Buffer size (upper bounds
-- the number of bytes forced
-- per call to the 'IO' action).
-> (S.ByteString -> IO ()) -- ^ 'IO' action to execute per
-- full buffer, which is
-- referenced by a strict
-- 'S.ByteString'.
-> Builder -- ^ 'Builder' to run.
-> IO () -- ^ Resulting 'IO' action.
toByteStringIOWith bufSize io (Builder b) =
fillBuffer bufSize (b (buildStep finalStep))
where
finalStep !(BufRange pf _) = return $ Done pf ()
fillBuffer !size step = do
S.mallocByteString size >>= fill
where
fill fpbuf = do
let !pf = unsafeForeignPtrToPtr fpbuf
!br = BufRange pf (pf `plusPtr` size)
-- safe due to later reference of fpbuf
-- BETTER than withForeignPtr, as we lose a tail call otherwise
signal <- runBuildStep step br
case signal of
Done pf' _ -> io $ S.PS fpbuf 0 (pf' `minusPtr` pf)
BufferFull minSize pf' nextStep -> do
io $ S.PS fpbuf 0 (pf' `minusPtr` pf)
fillBuffer (max bufSize minSize) nextStep
InsertByteString pf' bs nextStep -> do
io $ S.PS fpbuf 0 (pf' `minusPtr` pf)
unless (S.null bs) (io bs)
fillBuffer bufSize nextStep
-- | Run the builder with a 'defaultBufferSize'd buffer and execute the given
-- 'IO' action whenever the buffer is full or gets flushed.
--
-- @ 'toByteStringIO' = 'toByteStringIOWith' 'defaultBufferSize'@
--
-- This is a 'Monoid' homomorphism in the following sense.
--
-- > toByteStringIO io mempty == return ()
-- > toByteStringIO io (x `mappend` y) == toByteStringIO io x >> toByteStringIO io y
--
toByteStringIO :: (S.ByteString -> IO ()) -> Builder -> IO ()
toByteStringIO = toByteStringIOWith defaultBufferSize
{-# INLINE toByteStringIO #-}
-- | Run a 'Write' to produce a strict 'S.ByteString'.
-- This is equivalent to @('toByteString' . 'fromWrite')@, but is more
-- efficient because it uses just one appropriately-sized buffer.
writeToByteString :: Write -> S.ByteString
writeToByteString !w = unsafeDupablePerformIO $ do
fptr <- S.mallocByteString (getBound w)
len <- withForeignPtr fptr $ \ptr -> do
end <- runWrite w ptr
return $! end `minusPtr` ptr
return $! S.fromForeignPtr fptr 0 len
{-# INLINE writeToByteString #-}
------------------------------------------------------------------------------
-- Draft of new builder/put execution code
------------------------------------------------------------------------------
{- FIXME: Generalize this code such that it can replace the above clunky
- implementations.
-- | A monad for lazily composing lazy bytestrings using continuations.
newtype LBSM a = LBSM { unLBSM :: (a, L.ByteString -> L.ByteString) }
instance Monad LBSM where
return x = LBSM (x, id)
(LBSM (x,k)) >>= f = let LBSM (x',k') = f x in LBSM (x', k . k')
(LBSM (_,k)) >> (LBSM (x',k')) = LBSM (x', k . k')
-- | Execute a put and return the written buffers as the chunks of a lazy
-- bytestring.
toLazyByteString :: Put a -> (a, L.ByteString)
toLazyByteString put =
(fst result, k (bufToLBSCont (snd result) L.empty))
where
-- FIXME: Check with ByteString guys why allocation in inlinePerformIO is
-- bad.
-- initial buffer
buf0 = S.inlinePerformIO $ allocBuffer defaultBufferSize
-- run put, but don't force result => we're lazy enough
LBSM (result, k) = runPut liftIO outputBuf outputBS put buf0
-- convert a buffer to a lazy bytestring continuation
bufToLBSCont = maybe id L.Chunk . unsafeFreezeNonEmptyBuffer
-- lifting an io putsignal to a lazy bytestring monad
liftIO io = LBSM (S.inlinePerformIO io, id)
-- add buffer as a chunk prepare allocation of new one
outputBuf minSize buf = LBSM
( S.inlinePerformIO $ allocBuffer (max minSize defaultBufferSize)
, bufToLBSCont buf )
-- add bytestring directly as a chunk; exploits postcondition of runPut
-- that bytestrings are non-empty
outputBS bs = LBSM ((), L.Chunk bs)
{-
-- | A Builder that traces a message
traceBuilder :: String -> Builder
traceBuilder msg = fromBuildStepCont $ \k br@(BufRange op ope) -> do
putStrLn $ "traceBuilder " ++ show (op, ope) ++ ": " ++ msg
k br
test2 :: Word8 -> [S.ByteString]
test2 x = L.toChunks $ toLazyByteString2 $ fromBuilder $ mconcat
[ traceBuilder "before flush"
, fromWord8 48
, flushBuilder
, flushBuilder
, traceBuilder "after flush"
, fromWord8 x
]
-}
-}