blaze-builder-0.2.0.0: Blaze/ByteString/Builder/Write.hs
{-# LANGUAGE CPP, BangPatterns #-}
-- |
-- Module : Blaze.ByteString.Builder.Write
-- Copyright : (c) 2010 Jasper Van der Jeugt & Simon Meier
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Simon Meier <iridcode@gmail.com>
-- Stability : experimental
-- Portability : tested on GHC only
--
-- This module provides the 'Write' type, which abstracts direct writes to a
-- buffer. 'Write's form the public interface for lifting direct buffer
-- manipulations to 'Builder's.
--
module Blaze.ByteString.Builder.Write
(
-- * Atomic writes to a buffer
Write (..)
-- * Creating builders from 'Write' abstractions
, fromWrite
, fromWriteSingleton
, fromWrite1List
, fromWrite2List
, fromWrite4List
, fromWrite8List
, fromWrite16List
) where
import Blaze.ByteString.Builder.Internal
import Foreign
import Data.Monoid
------------------------------------------------------------------------------
-- Atomic writes to a buffer
------------------------------------------------------------------------------
-- | A value @Write n io@ denotes the write of @n@ bytes to a buffer. The
-- actual write is executed by calling @io@ with a pointer @pf@ to the first
-- free byte that the write should start with. Note that the caller of @io pf@
-- must ensure that @n@ bytes are free starting from @pf@.
--
-- For example, the function @'writeWord8'@ provided by
-- "Blaze.ByteString.Builder.Word" creates a 'Write' that writes a single fixed byte
-- to a buffer.
--
-- > writeWord8 :: Word8 -> Write
-- > writeWord8 x = Write 1 (\pf -> poke pf x)
--
-- The benefit of writes is that they abstract low-level manipulations (e.g.
-- 'poke' and 'copyBytes') of sequences of bytes in a form that that can be
-- completely optimized away in many cases.
--
-- For example, the 'Monoid' instance of 'Write' allows to formulate writing a
-- three-tuple of bytes as follows.
--
-- > writeThreeWord8 :: (Word8, Word8, Word8) -> Write
-- > writeThreeWord8 (x,y,z) =
-- > writeWord8 x `mappend` writeWord8 y `mappend` writeWord8 z
--
-- This expression will be optimized by the compiler to the following efficient
-- 'Write'.
--
-- > writeThreeWord8 (x, y, z) = Write 3 $ \pf -> do
-- > poke pf x
-- > poke (pf `plusPtr` 1) y
-- > poke (pf `plusPtr` 2) z
--
-- Writes are /atomic/. This means that the written data cannot be wrapped
-- over buffer boundaries as it can be done for builders. For writes it holds
-- that either the buffer has enough free space and the write can proceed or a
-- new buffer with a size larger or equal to the number of bytes to write has
-- to be allocated.
--
-- Moreover, for a 'Write', the size of the data to be written must be known
-- before the data can be written. Hence, if this size is data-dependent, the
-- control flow becomes complicated: first, all data must be forced and stored,
-- then the size check happens, and only afterwards the stored data can be
-- written. Therefore, because of cache misses, composing writes with
-- data-dependent size computations may actually be slower than combining the
-- resulting builders. Use benchmarking to make informed decisions.
--
data Write = Write
{-# UNPACK #-} !Int -- Number of bytes that will be written.
(Ptr Word8 -> IO ()) -- Function to write the bytes starting from the given
-- pointer
-- A monoid interface for the 'Write' actions.
instance Monoid Write where
mempty = Write 0 (const $ return ())
{-# INLINE mempty #-}
mappend (Write l1 f1) (Write l2 f2) = Write (l1 + l2) $ \ptr -> do
f1 ptr
f2 (ptr `plusPtr` l1)
{-# INLINE mappend #-}
-- Lifting Writes to Builders
-----------------------------
-- | Create a 'Builder' from a single write @w@. For good performance, @w@ must
-- feature an outermost 'Write' constructor such that the pattern match can be
-- eliminated during compilation.
--
-- Semantically, it holds that
--
-- > fromWrite . write = fromWriteSingleton write
--
-- However, performance-wise the right-hand side is more efficient due to
-- currently unknown reasons. Use the second form, when
-- defining functions for creating builders from writes of Haskell values.
--
-- (Use the standard benchmark in the @blaze-html@ package when investigating
-- this phenomenon.)
fromWrite :: Write -> Builder
fromWrite (Write size io) =
Builder step
where
step k pf pe
| pf `plusPtr` size <= pe = do
io pf
let pf' = pf `plusPtr` size
pf' `seq` k pf' pe
| otherwise = return $ BufferFull size pf (step k)
{-# INLINE fromWrite #-}
-- | Create a 'Builder' constructor from a single 'Write' constructor.
--
fromWriteSingleton :: (a -> Write) -> a -> Builder
fromWriteSingleton write = makeBuilder
where
makeBuilder x = Builder step
where
step k pf pe
| pf `plusPtr` size <= pe = do
io pf
let pf' = pf `plusPtr` size
pf' `seq` k pf' pe
| otherwise = return $ BufferFull size pf (step k)
where
Write size io = write x
{-# INLINE fromWriteSingleton #-}
-- | Construct a 'Builder' writing a list of data one element at a time from a 'Write' abstraction.
--
fromWrite1List :: (a -> Write) -> [a] -> Builder
fromWrite1List write = makeBuilder
where
makeBuilder [] = mempty
makeBuilder xs0 = Builder $ step xs0
where
step xs1 k pf0 pe0 = go xs1 pf0
where
go [] !pf = k pf pe0
go xs@(x':xs') !pf
| pf `plusPtr` size <= pe0 = do
io pf
go xs' (pf `plusPtr` size)
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'
{-# INLINE fromWrite1List #-}
-- | Construct a 'Builder' writing a list of data two elements at a time from a
-- 'Write' abstraction.
--
fromWrite2List :: (a -> Write) -> [a] -> Builder
fromWrite2List write = makeBuilder
where
makeBuilder [] = mempty
makeBuilder xs0 = Builder $ step xs0
where
step xs1 k pf0 pe0 = go xs1 pf0
where
go [] !pf = k pf pe0
go xs@[x'1] !pf
| pf' <= pe0 = do
io pf
k pf' pe0
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1
pf' = pf `plusPtr` size
go xs@(x'1:x'2:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
pf' = pf `plusPtr` size
{-# INLINE fromWrite2List #-}
-- | Construct a 'Builder' writing a list of data four elements at a time from a
-- 'Write' abstraction.
--
fromWrite4List :: (a -> Write) -> [a] -> Builder
fromWrite4List write = makeBuilder
where
makeBuilder [] = mempty
makeBuilder xs0 = Builder $ step xs0
where
step xs1 k pf0 pe0 = go xs1 pf0
where
go xs@(x'1:x'2:x'3:x'4:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
`mappend` write x'3
`mappend` write x'4
pf' = pf `plusPtr` size
go xs@(x'1:x'2:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
pf' = pf `plusPtr` size
go xs@[x'1] !pf
| pf' <= pe0 = do
io pf
k pf' pe0
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1
pf' = pf `plusPtr` size
go [] !pf = k pf pe0
{-# INLINE fromWrite4List #-}
-- | Construct a 'Builder' writing a list of data eight elements at a time from a
-- 'Write' abstraction.
--
fromWrite8List :: (a -> Write) -> [a] -> Builder
fromWrite8List write = makeBuilder
where
makeBuilder [] = mempty
makeBuilder xs0 = Builder $ step xs0
where
step xs1 k pf0 pe0 = go xs1 pf0
where
go xs@(x'1:x'2:x'3:x'4:x'5:x'6:x'7:x'8:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
`mappend` write x'3
`mappend` write x'4
`mappend` write x'5
`mappend` write x'6
`mappend` write x'7
`mappend` write x'8
pf' = pf `plusPtr` size
go xs@(x'1:x'2:x'3:x'4:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
`mappend` write x'3
`mappend` write x'4
pf' = pf `plusPtr` size
go xs@(x'1:x'2:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
pf' = pf `plusPtr` size
go xs@[x'1] !pf
| pf' <= pe0 = do
io pf
k pf' pe0
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1
pf' = pf `plusPtr` size
go [] !pf = k pf pe0
{-# INLINE fromWrite8List #-}
-- | Construct a 'Builder' writing a list of data 16 elements at a time from a
-- 'Write' abstraction.
--
fromWrite16List :: (a -> Write) -> [a] -> Builder
fromWrite16List write = makeBuilder
where
makeBuilder [] = mempty
makeBuilder xs0 = Builder $ step xs0
where
step xs1 k pf0 pe0 = go xs1 pf0
where
go xs@(x'1:x'2:x'3:x'4:x'5:x'6:x'7:x'8:x'9:x'10:x'11:x'12:x'13:x'14:x'15:x'16:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
`mappend` write x'3
`mappend` write x'4
`mappend` write x'5
`mappend` write x'6
`mappend` write x'7
`mappend` write x'8
`mappend` write x'9
`mappend` write x'10
`mappend` write x'11
`mappend` write x'12
`mappend` write x'13
`mappend` write x'14
`mappend` write x'15
`mappend` write x'16
pf' = pf `plusPtr` size
go xs@(x'1:x'2:x'3:x'4:x'5:x'6:x'7:x'8:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
`mappend` write x'3
`mappend` write x'4
`mappend` write x'5
`mappend` write x'6
`mappend` write x'7
`mappend` write x'8
pf' = pf `plusPtr` size
go xs@(x'1:x'2:x'3:x'4:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
`mappend` write x'3
`mappend` write x'4
pf' = pf `plusPtr` size
go xs@(x'1:x'2:xs') !pf
| pf' <= pe0 = do
io pf
go xs' pf'
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1 `mappend` write x'2
pf' = pf `plusPtr` size
go xs@[x'1] !pf
| pf' <= pe0 = do
io pf
k pf' pe0
| otherwise = do return $ BufferFull size pf (step xs k)
where
Write size io = write x'1
pf' = pf `plusPtr` size
go [] !pf = k pf pe0
{-# INLINE fromWrite16List #-}