{-# 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 #-}