module Data.Conduit.Blaze
(
builderToByteString
, unsafeBuilderToByteString
, builderToByteStringWith
, builderToByteStringFlush
, builderToByteStringWithFlush
, Buffer
, freeSize
, sliceSize
, bufferSize
, allocBuffer
, reuseBuffer
, nextSlice
, unsafeFreezeBuffer
, unsafeFreezeNonEmptyBuffer
, BufferAllocStrategy
, allNewBuffersStrategy
, reuseBufferStrategy
) where
import Data.Conduit
import Control.Monad (unless, liftM)
import Control.Monad.Trans.Class (lift, MonadTrans)
import qualified Data.ByteString as S
import Blaze.ByteString.Builder.Internal
import Blaze.ByteString.Builder.Internal.Types
import Blaze.ByteString.Builder.Internal.Buffer
import Control.Monad.Primitive (PrimMonad, unsafePrimToPrim)
import Control.Monad.Base (MonadBase, liftBase)
unsafeLiftIO :: (MonadBase base m, PrimMonad base) => IO a -> m a
unsafeLiftIO = liftBase . unsafePrimToPrim
builderToByteString :: (MonadBase base m, PrimMonad base) => Conduit Builder m S.ByteString
builderToByteString =
builderToByteStringWith (allNewBuffersStrategy defaultBufferSize)
builderToByteStringFlush :: (MonadBase base m, PrimMonad base) => Conduit (Flush Builder) m (Flush S.ByteString)
builderToByteStringFlush =
builderToByteStringWithFlush (allNewBuffersStrategy defaultBufferSize)
unsafeBuilderToByteString :: (MonadBase base m, PrimMonad base)
=> IO Buffer
-> Conduit Builder m S.ByteString
unsafeBuilderToByteString = builderToByteStringWith . reuseBufferStrategy
builderToByteStringWith :: (MonadBase base m, PrimMonad base)
=> BufferAllocStrategy
-> Conduit Builder m S.ByteString
builderToByteStringWith =
helper (liftM (fmap Chunk) await) yield'
where
yield' Flush = return ()
yield' (Chunk bs) = yield bs
builderToByteStringWithFlush
:: (MonadBase base m, PrimMonad base)
=> BufferAllocStrategy
-> Conduit (Flush Builder) m (Flush S.ByteString)
builderToByteStringWithFlush = helper await yield
helper :: (MonadBase base m, PrimMonad base, Monad (t m), MonadTrans t)
=> t m (Maybe (Flush Builder))
-> (Flush S.ByteString -> t m ())
-> BufferAllocStrategy
-> t m ()
helper await' yield' (ioBufInit, nextBuf) =
loop ioBufInit
where
loop ioBuf = do
await' >>= maybe (close ioBuf) (cont' ioBuf)
cont' ioBuf Flush = push ioBuf flush $ \ioBuf' -> yield' Flush >> loop ioBuf'
cont' ioBuf (Chunk builder) = push ioBuf builder loop
close ioBuf = do
buf <- lift $ unsafeLiftIO $ ioBuf
maybe (return ()) (yield' . Chunk) (unsafeFreezeNonEmptyBuffer buf)
push ioBuf0 x continue = do
go (unBuilder x (buildStep finalStep)) ioBuf0
where
finalStep !(BufRange pf _) = return $ Done pf ()
go bStep ioBuf = do
!buf <- lift $ unsafeLiftIO $ ioBuf
signal <- lift $ unsafeLiftIO $ execBuildStep bStep buf
case signal of
Done op' _ -> continue $ return $ updateEndOfSlice buf op'
BufferFull minSize op' bStep' -> do
let buf' = updateEndOfSlice buf op'
cont = do
ioBuf' <- lift $ unsafeLiftIO $ nextBuf minSize buf'
go bStep' ioBuf'
case unsafeFreezeNonEmptyBuffer buf' of
Nothing -> return ()
Just bs -> yield' (Chunk bs)
cont
InsertByteString op' bs bStep' -> do
let buf' = updateEndOfSlice buf op'
case unsafeFreezeNonEmptyBuffer buf' of
Nothing -> return ()
Just bs' -> yield' $ Chunk bs'
unless (S.null bs) $ yield' $ Chunk bs
lift (unsafeLiftIO $ nextBuf 1 buf') >>= go bStep'