blaze-builder 0.1 → 0.2.0.0

raw patch · 35 files changed

+7037/−385 lines, 35 filesdep ~basedep ~bytestringdep ~textnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, text

API changes (from Hackage documentation)

Files

• Blaze/ByteString/Builder.hs +205/−0
• Blaze/ByteString/Builder/ByteString.hs +229/−0
• Blaze/ByteString/Builder/Char/Utf8.hs +149/−0
• Blaze/ByteString/Builder/Html/Utf8.hs +81/−0
• Blaze/ByteString/Builder/Int.hs +301/−0
• Blaze/ByteString/Builder/Internal.hs +441/−0
• Blaze/ByteString/Builder/Word.hs +436/−0
• Blaze/ByteString/Builder/Write.hs +384/−0
• CHANGES +34/−0
• Makefile +101/−0
• README.markdown +30/−0
• TODO +63/−0
• Text/Blaze/Builder/Core.hs +0/−219
• Text/Blaze/Builder/Html.hs +0/−55
• Text/Blaze/Builder/Utf8.hs +0/−91
• benchmarks/BenchThroughput.hs +239/−0
• benchmarks/BlazeVsBinary.hs +83/−0
• benchmarks/ChunkedWrite.hs +158/−0
• benchmarks/Compression.hs +55/−0
• benchmarks/PlotTest.hs +218/−0
• benchmarks/StringAndText.hs +125/−0
• benchmarks/Throughput/BinaryBuilder.hs +697/−0
• benchmarks/Throughput/BinaryBuilderDeclarative.hs +118/−0
• benchmarks/Throughput/BinaryPut.hs +696/−0
• benchmarks/Throughput/BlazeBuilder.hs +702/−0
• benchmarks/Throughput/BlazeBuilderDeclarative.hs +197/−0
• benchmarks/Throughput/BlazePut.hs +742/−0
• benchmarks/Throughput/BlazePutMonad.hs +222/−0
• benchmarks/Throughput/CBenchmark.c +39/−0
• benchmarks/Throughput/CBenchmark.h +4/−0
• benchmarks/Throughput/Memory.hs +98/−0
• benchmarks/Throughput/Utils.hs +12/−0
• blaze-builder.cabal +47/−20
• tests/LlvmSegfault.hs +35/−0
• tests/Tests.hs +96/−0

@@ -0,0 +1,205 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Blaze.ByteString.Builder+-- 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+--+-- "Blaze.ByteString.Builder" is the main module, which you should import as a user+-- of the @blaze-builder@ library.+--+-- > import Blaze.ByteString.Builder+-- +-- It provides you with a type 'Builder' that allows to efficiently construct+-- lazy bytestrings with a large average chunk size.+--+-- Intuitively, a 'Builder' denotes the construction of a part of a lazy+-- bytestring. Builders can either be created using one of the primitive+-- combinators in "Blaze.ByteString.Builder.Write" or by using one of the predefined+-- combinators for standard Haskell values (see the exposed modules of this+-- package).  Concatenation of builders is done using 'mappend' from the+-- 'Monoid' typeclass.+--+-- Here is a small example that serializes a list of strings using the UTF-8+-- encoding.+--+-- @ import "Blaze.ByteString.Builder.Char.Utf8"@+--+-- > strings :: [String]+-- > strings = replicate 10000 "Hello there!"+--+-- The function @'fromString'@ creates a 'Builder' denoting the UTF-8 encoded+-- argument. Hence, UTF-8 encoding and concatenating all @strings@ can be done+-- follows.+--+-- > concatenation :: Builder+-- > concatenation = mconcat $ map fromString strings+--+-- The function 'toLazyByteString'  can be used to execute a 'Builder' and+-- obtain the resulting lazy bytestring.+--+-- > result :: L.ByteString+-- > result = toLazyByteString concatenation+--+-- The @result@ is a lazy bytestring containing 10000 repetitions of the string+-- @\"Hello there!\"@ encoded using UTF-8. The corresponding 120000 bytes are+-- distributed among three chunks of 32kb and a last chunk of 6kb.+--+-- /A note on history./ This serialization library was inspired by the+-- @Data.Binary.Builder@ module provided by the @binary@ package. It was+-- originally developed with the specific needs of the @blaze-html@ package in+-- mind. Since then it has been restructured to serve as a drop-in replacement+-- for @Data.Binary.Builder@, which it improves upon both in speed as well as+-- expressivity.+-----------------------------------------------------------------------------++module Blaze.ByteString.Builder+    ( +      -- * The @Builder@ type+      Builder++      -- * Creating builders+    , module Blaze.ByteString.Builder.Write +    , module Blaze.ByteString.Builder.Int+    , module Blaze.ByteString.Builder.Word+    , module Blaze.ByteString.Builder.ByteString+    , flush++      -- * Executing builders+    , toLazyByteString+    , toLazyByteStringWith+    , toByteString+    , toByteStringIO+    , toByteStringIOWith+    ++      -- * Compatibility to Data.Binary.Builder from the binary package+      --+      -- | The following functions ensure that @"Blaze.ByteString.Builder"@ is a+      -- drop-in replacement for @Data.Binary.Builder@ from the @binary@+      -- package. Note that these functions are deprecated and may be removed+      -- in future versions of the @blaze-builder@ package.+      --+    , empty                   -- DEPRECATED: use 'mempty' instead+    , singleton               -- DEPRECATED: use 'fromByte' instead+    , append                  -- DEPRECATED: use 'mappend' instead+                              +    , putWord16be             -- DEPRECATED: use 'fromWord<n><endian>' instead+    , putWord32be             --+    , putWord64be             --+    , putWord16le             --+    , putWord32le             --+    , putWord64le             --   for all these functions+    , putWordhost             --+    , putWord16host           --+    , putWord32host           --+    , putWord64host           --+    ) where++import Blaze.ByteString.Builder.Internal+import Blaze.ByteString.Builder.Write+import Blaze.ByteString.Builder.Int+import Blaze.ByteString.Builder.Word+import Blaze.ByteString.Builder.ByteString++import Data.Monoid+import Data.Word++------------------------------------------------------------------------------+-- API Compatibility to Data.Binary.Builder from 'binary'+------------------------------------------------------------------------------++-- | /O(1)/. An empty builder. +--+-- /Deprecated:/ use 'mempty' instead.+empty :: Builder+empty = mempty+{-# DEPRECATED empty "Use 'mempty' instead." #-}++-- | /O(1)/. Append two builders. +--+-- /Deprecated:/ use 'mappend' instead.+append :: Builder -> Builder -> Builder+append = mappend+{-# DEPRECATED append "Use 'mappend' instead." #-}++-- | /O(1)/. Serialize a single byte.+--+-- /Deprecated:/ use 'fromWord8' instead.+singleton :: Word8 -> Builder+singleton = fromWriteSingleton writeWord8+{-# DEPRECATED singleton "Use 'fromWord8' instead." #-}++-- | /O(1)/. Serialize a 'Word16' in big endian format.+--+-- /Deprecated:/ use 'fromWord16be' instead.+putWord16be :: Word16 -> Builder+putWord16be = fromWord16be +{-# DEPRECATED putWord16be "Use 'fromWord16be' instead." #-}++-- | /O(1)/. Serialize a 'Word32' in big endian format.+--+-- /Deprecated:/ use 'fromWord32be' instead.+putWord32be :: Word32 -> Builder+putWord32be = fromWord32be+{-# DEPRECATED putWord32be "Use 'fromWord32be' instead." #-}++-- | /O(1)/. Serialize a 'Word64' in big endian format.+--+-- /Deprecated:/ use 'fromWord64be' instead.+putWord64be :: Word64 -> Builder+putWord64be = fromWord64be+{-# DEPRECATED putWord64be "Use 'fromWord64be' instead." #-}++-- | /O(1)/. Serialize a 'Word16' in little endian format.+--+-- /Deprecated:/ use 'fromWord16le' instead.+putWord16le :: Word16 -> Builder+putWord16le = fromWord16le+{-# DEPRECATED putWord16le "Use 'fromWord16le' instead." #-}++-- | /O(1)/. Serialize a 'Word32' in little endian format.+--+-- /Deprecated:/ use 'fromWord32le' instead.+putWord32le :: Word32 -> Builder+putWord32le = fromWord32le+{-# DEPRECATED putWord32le "Use 'fromWord32le' instead." #-}++-- | /O(1)/. Serialize a 'Word64' in little endian format.+--+-- /Deprecated:/ use 'fromWord64le' instead.+putWord64le :: Word64 -> Builder+putWord64le = fromWord64le+{-# DEPRECATED putWord64le "Use 'fromWord64le' instead." #-}++-- | /O(1)/. Serialize a 'Word' in host endian format.+--+-- /Deprecated:/ use 'fromWordhost' instead.+putWordhost :: Word -> Builder+putWordhost = fromWordhost+{-# DEPRECATED putWordhost "Use 'fromWordhost' instead." #-}++-- | /O(1)/. Serialize a 'Word16' in host endian format.+--+-- /Deprecated:/ use 'fromWord16host' instead.+putWord16host :: Word16 -> Builder+putWord16host = fromWord16host+{-# DEPRECATED putWord16host "Use 'fromWord16host' instead." #-}++-- | /O(1)/. Serialize a 'Word32' in host endian format.+--+-- /Deprecated:/ use 'fromWord32host' instead.+putWord32host :: Word32 -> Builder+putWord32host = fromWord32host+{-# DEPRECATED putWord32host "Use 'fromWord32host' instead." #-}++-- | /O(1)/. Serialize a 'Word64' in host endian format.+--+-- /Deprecated:/ use 'fromWord64host' instead.+putWord64host :: Word64 -> Builder+putWord64host = fromWord64host+{-# DEPRECATED putWord64host "Use 'fromWord64host' instead." #-}+

@@ -0,0 +1,229 @@+{-# LANGUAGE CPP, BangPatterns, OverloadedStrings #-}++-- |+-- Module      : Blaze.ByteString.Builder.ByteString+-- 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+--+-- 'Write's and 'Builder's for strict and lazy bytestrings.+--+-- We assume the following qualified imports in order to differentiate between+-- strict and lazy bytestrings in the code examples.+--+-- > import qualified Data.ByteString      as S+-- > import qualified Data.ByteString.Lazy as L+--+module Blaze.ByteString.Builder.ByteString+    ( +    -- * Strict bytestrings+      writeByteString+    , fromByteString+    , fromByteStringWith+    , copyByteString+    , insertByteString++    -- * Lazy bytestrings+    , fromLazyByteString+    , fromLazyByteStringWith+    , copyLazyByteString+    , insertLazyByteString++    ) where++import Blaze.ByteString.Builder.Write+import Blaze.ByteString.Builder.Internal++import Foreign+import Data.Monoid++import qualified Data.ByteString      as S+import qualified Data.ByteString.Lazy as L++#ifdef BYTESTRING_IN_BASE+import qualified Data.ByteString.Base as S+import qualified Data.ByteString.Lazy.Base as L -- FIXME: check if this is the right module+#else+import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Lazy.Internal as L+#endif+++------------------------------------------------------------------------------+-- Strict ByteStrings+------------------------------------------------------------------------------++-- | Write a strict 'S.ByteString' to a buffer.+--+writeByteString :: S.ByteString -> Write+writeByteString bs = Write l io+  where+  (fptr, o, l) = S.toForeignPtr bs+  io pf = withForeignPtr fptr $ \p -> copyBytes pf (p `plusPtr` o) l+{-# INLINE writeByteString #-}++-- | Smart serialization of a strict bytestring.+--+-- @'fromByteString' = 'fromByteStringWith' 'defaultMaximalCopySize'@+--+-- Use this function to serialize strict bytestrings. It guarantees an+-- average chunk size of 4kb, which has been shown to be a reasonable size in+-- benchmarks. Note that the check whether to copy or to insert is (almost)+-- free as the builder performance is mostly memory-bound.+--+-- If you statically know that copying or inserting the strict bytestring is+-- always the best choice, then you can use the 'copyByteString' or+-- 'insertByteString' functions. +--+fromByteString :: S.ByteString -> Builder+fromByteString = fromByteStringWith defaultMaximalCopySize+{-# INLINE fromByteString #-}+++-- | @fromByteStringWith maximalCopySize bs@ serializes the strict bytestring+-- @bs@ according to the following rules.+--+--   [@S.length bs <= maximalCopySize@:] @bs@ is copied to the output buffer.+--+--   [@S.length bs >  maximalCopySize@:] @bs@ the output buffer is flushed and+--   @bs@ is inserted directly as separate chunk in the output stream.+--+-- These rules guarantee that average chunk size in the output stream is at+-- least half the @maximalCopySize@.+--+fromByteStringWith :: Int          -- ^ Maximal number of bytes to copy.+                   -> S.ByteString -- ^ Strict 'S.ByteString' to serialize.+                   -> Builder      -- ^ Resulting 'Builder'.+fromByteStringWith maximalCopySize bs = Builder step+  where+    step k pf pe+      | maximalCopySize < size  = +          return $ ModifyChunks pf (L.Chunk bs) k+      | pf `plusPtr` size <= pe = do+          withForeignPtr fpbuf $ \pbuf -> +              copyBytes pf (pbuf `plusPtr` offset) size+          let pf' = pf `plusPtr` size+          pf' `seq` k pf' pe+      | otherwise               = return $ BufferFull size pf (step k)+      where+        (fpbuf, offset, size) = S.toForeignPtr bs+{-# INLINE fromByteStringWith #-}+++-- | @copyByteString bs@ serialize the strict bytestring @bs@ by copying it to+-- the output buffer. +--+-- Use this function to serialize strict bytestrings that are statically known+-- to be smallish (@<= 4kb@).+--+copyByteString :: S.ByteString -> Builder+copyByteString = fromWriteSingleton writeByteString+{-# INLINE copyByteString #-}++-- | @insertByteString bs@ serializes the strict bytestring @bs@ by inserting+-- it directly as a chunk of the output stream. +--+-- Note that this implies flushing the output buffer; even if it contains just+-- a single byte. Hence, you should use this operation only for large (@> 8kb@)+-- bytestrings, as otherwise the resulting output stream may be too fragmented+-- to be processed efficiently.+--+insertByteString :: S.ByteString -> Builder+insertByteString bs = Builder $ \ k pf _ ->+    return $ ModifyChunks pf (L.Chunk bs) k+{-# INLINE insertByteString #-}+++-- Lazy bytestrings+------------------------------------------------------------------------------++-- | /O(n)/. Smart serialization of a lazy bytestring.+--+-- @'fromLazyByteString' = 'fromLazyByteStringWith' 'defaultMaximalCopySize'@+--+-- Use this function to serialize lazy bytestrings. It guarantees an average+-- chunk size of 4kb, which has been shown to be a reasonable size in+-- benchmarks. Note that the check whether to copy or to insert is (almost)+-- free as the builder performance is mostly memory-bound.+--+-- If you statically know that copying or inserting /all/ chunks of the lazy+-- bytestring is always the best choice, then you can use the+-- 'copyLazyByteString' or 'insertLazyByteString' functions. +--+fromLazyByteString :: L.ByteString -> Builder+fromLazyByteString = fromLazyByteStringWith defaultMaximalCopySize+{-# INLINE fromLazyByteString #-}++-- | /O(n)/. Serialize a lazy bytestring chunk-wise according to the same rules+-- as in 'fromByteStringWith'.+--+-- Semantically, it holds that+--+-- >   fromLazyByteStringWith maxCopySize+-- > = mconcat . map (fromByteStringWith maxCopySize) . L.toChunks+--+-- However, the left-hand-side is much more efficient, as it moves the+-- end-of-buffer pointer out of the inner loop and provides the compiler with+-- more strictness information.+--+fromLazyByteStringWith :: Int          -- ^ Maximal number of bytes to copy.+                       -> L.ByteString -- ^ Lazy 'L.ByteString' to serialize.+                       -> Builder      -- ^ Resulting 'Builder'.+fromLazyByteStringWith maximalCopySize = +    makeBuilder+  where+    -- FIXME: Justify this first case split. Can we justify it at all? I seem+    -- to remember that its idea was to enable a partial inlining; i.e. sharing+    -- of 'step' between different calls to 'fromLazyByteStringWith'.+    makeBuilder L.Empty  = mempty+    makeBuilder lbs0     = Builder $ step lbs0+      where+        step lbs1 k pf0 pe0 = go lbs1 pf0+          where+            go L.Empty                !pf = k pf pe0+            go lbs@(L.Chunk bs' lbs') !pf+              | maximalCopySize < size = +                  return $ ModifyChunks pf (L.Chunk bs') (step lbs' k)++              | pf' <= pe0 = do+                  withForeignPtr fpbuf $ \pbuf -> +                      copyBytes pf (pbuf `plusPtr` offset) size+                  go lbs' pf'++              | otherwise  = return $ BufferFull size pf (step lbs k)+              where+                pf' = pf `plusPtr` size+                (fpbuf, offset, size) = S.toForeignPtr bs'+{-# INLINE fromLazyByteStringWith #-}+++-- | /O(n)/. Serialize a lazy bytestring by copying /all/ chunks sequentially+-- to the output buffer.+--+-- See 'copyByteString' for usage considerations.+--++-- FIXME: Implement fused L.toChunks and fromWrite1List+copyLazyByteString :: L.ByteString -> Builder+copyLazyByteString = fromWrite1List writeByteString . L.toChunks+{-# INLINE copyLazyByteString #-}++-- | /O(n)/. Serialize a lazy bytestring by inserting /all/ its chunks directly+-- into the output stream.+--+-- See 'insertByteString' for usage considerations.+--+-- For library developers, see the 'ModifyChunks' build signal, if you+-- need an /O(1)/ lazy bytestring insert based on difference lists.+--+insertLazyByteString :: L.ByteString -> Builder+insertLazyByteString lbs = Builder step+  where+    step k pf _ = +        return $ ModifyChunks pf (\lbs' -> L.foldrChunks L.Chunk lbs' lbs) k++{-# INLINE insertLazyByteString #-}+

@@ -0,0 +1,149 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-} +-- ignore warning from 'import Data.Text.Encoding'++-- |+-- Module      : Blaze.ByteString.Builder.Char.Utf8+-- 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+--+-- 'Write's and 'Builder's for serializing Unicode characters using the UTF-8+-- encoding. +--+module Blaze.ByteString.Builder.Char.Utf8+    ( +      -- * Writing UTF-8 encoded characters to a buffer+      writeChar++      -- * Creating Builders from UTF-8 encoded characters+    , fromChar+    , fromString+    , fromShow+    , fromText+    , fromLazyText+    ) where++import Foreign+import Data.Char (ord)++import qualified Data.Text               as TS+import qualified Data.Text.Encoding      as TS -- imported for documentation links+import qualified Data.Text.Lazy          as TL+import qualified Data.Text.Lazy.Encoding as TS -- imported for documentation links++import Blaze.ByteString.Builder.Internal+import Blaze.ByteString.Builder.Write++-- | Write a UTF-8 encoded Unicode character to a buffer.+--+-- Note that the control flow of 'writeChar' is more complicated than the one+-- of 'writeWord8', as the size of the write depends on the 'Char' written.+-- Therefore,+--+-- > fromWrite $ writeChar a `mappend` writeChar b+--+-- must not always be faster than+--+-- > fromChar a `mappend` fromChar b+--+-- Use benchmarking to make informed decisions.+--++-- FIXME: Use a Write that always checks if 4 bytes are available and only take+-- care of the precise pointer advance once the data has been written. Either+-- formulate it using continuation passing or returning the increment using the+-- IO action. The latter is probably simpler and better understandable.+--+writeChar :: Char -> Write+writeChar = encodeCharUtf8 f1 f2 f3 f4+  where+    f1 x = Write 1 $ \ptr -> poke ptr x++    f2 x1 x2 = Write 2 $ \ptr -> do poke ptr x1+                                    poke (ptr `plusPtr` 1) x2++    f3 x1 x2 x3 = Write 3 $ \ptr -> do poke ptr x1+                                       poke (ptr `plusPtr` 1) x2+                                       poke (ptr `plusPtr` 2) x3++    f4 x1 x2 x3 x4 = Write 4 $ \ptr -> do poke ptr x1+                                          poke (ptr `plusPtr` 1) x2+                                          poke (ptr `plusPtr` 2) x3+                                          poke (ptr `plusPtr` 3) x4+{-# INLINE writeChar #-}++-- | Encode a Unicode character to another datatype, using UTF-8. This function+-- acts as an abstract way of encoding characters, as it is unaware of what+-- needs to happen with the resulting bytes: you have to specify functions to+-- deal with those.+--+encodeCharUtf8 :: (Word8 -> a)                             -- ^ 1-byte UTF-8+               -> (Word8 -> Word8 -> a)                    -- ^ 2-byte UTF-8+               -> (Word8 -> Word8 -> Word8 -> a)           -- ^ 3-byte UTF-8+               -> (Word8 -> Word8 -> Word8 -> Word8 -> a)  -- ^ 4-byte UTF-8+               -> Char                                     -- ^ Input 'Char'+               -> a                                        -- ^ Result+encodeCharUtf8 f1 f2 f3 f4 c = case ord c of+    x | x <= 0x7F -> f1 $ fromIntegral x+      | x <= 0x07FF ->+           let x1 = fromIntegral $ (x `shiftR` 6) + 0xC0+               x2 = fromIntegral $ (x .&. 0x3F)   + 0x80+           in f2 x1 x2+      | x <= 0xFFFF ->+           let x1 = fromIntegral $ (x `shiftR` 12) + 0xE0+               x2 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80+               x3 = fromIntegral $ (x .&. 0x3F) + 0x80+           in f3 x1 x2 x3+      | otherwise ->+           let x1 = fromIntegral $ (x `shiftR` 18) + 0xF0+               x2 = fromIntegral $ ((x `shiftR` 12) .&. 0x3F) + 0x80+               x3 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80+               x4 = fromIntegral $ (x .&. 0x3F) + 0x80+           in f4 x1 x2 x3 x4+{-# INLINE encodeCharUtf8 #-}++-- | /O(1)/. Serialize a Unicode character using the UTF-8 encoding.+--+fromChar :: Char -> Builder+fromChar = fromWriteSingleton writeChar++-- | /O(n)/. Serialize a Unicode 'String' using the UTF-8 encoding.+--+fromString :: String -> Builder+fromString = fromWrite1List writeChar+-- Performance note: ^^^+--+--   fromWrite2List made things slightly worse for the blaze-html benchmarks+--   despite being better when serializing only a list.  Probably, the cache is+--   already occupied enough with dealing with the data from Html rendering.+--+++-- | /O(n)/. Serialize a value by 'Show'ing it and UTF-8 encoding the resulting+-- 'String'.+--+fromShow :: Show a => a -> Builder+fromShow = fromString . show++-- | /O(n)/. Serialize a strict Unicode 'TS.Text' value using the UTF-8 encoding.+--+-- Note that this function is currently faster than 'TS.encodeUtf8' provided by+-- "Data.Text.Encoding". Moreover, 'fromText' is also lazy, while 'TL.encodeUtf8'+-- is strict.+--+fromText :: TS.Text -> Builder+fromText = fromString . TS.unpack+{-# INLINE fromText #-}+++-- | /O(n)/. Serialize a lazy Unicode 'TL.Text' value using the UTF-8 encoding.+--+-- Note that this function is currently faster than 'TL.encodeUtf8' provided by+-- "Data.Text.Lazy.Encoding".+--+fromLazyText :: TL.Text -> Builder+fromLazyText = fromString . TL.unpack+{-# INLINE fromLazyText #-}

@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Blaze.ByteString.Builder.Html.Utf8+-- 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+--+-- 'Write's and 'Builder's for serializing HTML escaped and UTF-8 encoded+-- characters.+--+-- This module is used by both the 'blaze-html' and the \'hamlet\' HTML+-- templating libraries. If the 'Builder' from 'blaze-builder' replaces the+-- 'Data.Binary.Builder' implementation, this module will most likely keep its+-- place, as it provides a set of very specialized functions.+module Blaze.ByteString.Builder.Html.Utf8+    ( +      module Blaze.ByteString.Builder.Char.Utf8++      -- * Writing HTML escaped and UTF-8 encoded characters to a buffer+    , writeHtmlEscapedChar++      -- * Creating Builders from HTML escaped and UTF-8 encoded characters+    , fromHtmlEscapedChar+    , fromHtmlEscapedString+    , fromHtmlEscapedShow+    , fromHtmlEscapedText+    , fromHtmlEscapedLazyText+    ) where++import Data.ByteString.Char8 ()  -- for the 'IsString' instance of bytesrings++import qualified Data.Text      as TS+import qualified Data.Text.Lazy as TL++import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char.Utf8++-- | Write a HTML escaped and UTF-8 encoded Unicode character to a bufffer.+--+writeHtmlEscapedChar :: Char -> Write+writeHtmlEscapedChar '<'  = writeByteString "&lt;"+writeHtmlEscapedChar '>'  = writeByteString "&gt;"+writeHtmlEscapedChar '&'  = writeByteString "&amp;"+writeHtmlEscapedChar '"'  = writeByteString "&quot;"+writeHtmlEscapedChar '\'' = writeByteString "&apos;"+writeHtmlEscapedChar c    = writeChar c+{-# INLINE writeHtmlEscapedChar #-}++-- | /O(1)./ Serialize a HTML escaped Unicode character using the UTF-8+-- encoding.+--+fromHtmlEscapedChar :: Char -> Builder+fromHtmlEscapedChar = fromWriteSingleton writeHtmlEscapedChar++-- | /O(n)/. Serialize a HTML escaped Unicode 'String' using the UTF-8+-- encoding.+--+fromHtmlEscapedString :: String -> Builder+fromHtmlEscapedString = fromWrite1List writeHtmlEscapedChar++-- | /O(n)/. Serialize a value by 'Show'ing it and then, HTML escaping and+-- UTF-8 encoding the resulting 'String'.+--+fromHtmlEscapedShow :: Show a => a -> Builder+fromHtmlEscapedShow = fromHtmlEscapedString . show+++-- | /O(n)/. Serialize a HTML escaped strict Unicode 'TS.Text' value using the+-- UTF-8 encoding.+--+fromHtmlEscapedText :: TS.Text -> Builder+fromHtmlEscapedText = fromHtmlEscapedString . TS.unpack++-- | /O(n)/. Serialize a HTML escaped Unicode 'TL.Text' using the UTF-8 encoding.+--+fromHtmlEscapedLazyText :: TL.Text -> Builder+fromHtmlEscapedLazyText = fromHtmlEscapedString . TL.unpack+

@@ -0,0 +1,301 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Blaze.ByteString.Builder.Int+-- Copyright   : (c) 2010 Simon Meier+--+-- License     : BSD3-style (see LICENSE)+-- +-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : tested on GHC only+--+-- 'Write's and 'Builder's for serializing integers.+--+-- See "Blaze.ByteString.Builder.Word" for information about how to best write several+-- integers at once.+--+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#include "MachDeps.h"+#endif++module Blaze.ByteString.Builder.Int+    ( +    -- * Writing integers to a buffer++      writeInt8++    -- ** Big-endian writes+    , writeInt16be           -- :: Int16 -> Write+    , writeInt32be           -- :: Int32 -> Write+    , writeInt64be           -- :: Int64 -> Write++    -- ** Little-endian writes+    , writeInt16le           -- :: Int16 -> Write+    , writeInt32le           -- :: Int32 -> Write+    , writeInt64le           -- :: Int64 -> Write++    -- ** Host-endian writes+    , writeInthost           -- :: Int -> Write+    , writeInt16host         -- :: Int16 -> Write+    , writeInt32host         -- :: Int32 -> Write+    , writeInt64host         -- :: Int64 -> Write++    -- * Creating builders from integers+    +    -- | We provide serialization functions both for singleton integers as well as+    -- for lists of integers. Using these list serialization functions is /much/ faster+    -- than using @mconcat . map fromInt/<n/>@, as the list serialization+    -- functions use a tighter inner loop and a chunked write like it is+    -- provided by functions such as 'fromWrite2List'.++    , fromInt8+    , fromInt8s++    -- ** Big-endian serialization+    , fromInt16be            -- :: Int16   -> Builder+    , fromInt32be            -- :: Int32   -> Builder+    , fromInt64be            -- :: Int64   -> Builder+    , fromInt32sbe           -- :: [Int32] -> Builder+    , fromInt16sbe           -- :: [Int16] -> Builder+    , fromInt64sbe           -- :: [Int64] -> Builder++    -- ** Little-endian serialization+    , fromInt16le            -- :: Int16   -> Builder+    , fromInt32le            -- :: Int32   -> Builder+    , fromInt64le            -- :: Int64   -> Builder+    , fromInt16sle           -- :: [Int16] -> Builder+    , fromInt32sle           -- :: [Int32] -> Builder+    , fromInt64sle           -- :: [Int64] -> Builder++    -- ** Host-endian serialization+    , fromInthost            -- :: Int     -> Builder+    , fromInt16host          -- :: Int16   -> Builder+    , fromInt32host          -- :: Int32   -> Builder+    , fromInt64host          -- :: Int64   -> Builder+    , fromIntshost           -- :: [Int]   -> Builder+    , fromInt16shost         -- :: [Int16] -> Builder+    , fromInt32shost         -- :: [Int32] -> Builder+    , fromInt64shost         -- :: [Int64] -> Builder++    ) where++import Blaze.ByteString.Builder.Internal+import Blaze.ByteString.Builder.Write+import Blaze.ByteString.Builder.Word++import Foreign++------------------------------------------------------------------------------+-- Int writes+--------------+--+-- we rely on 'fromIntegral' to do a loss-less conversion to the corresponding+-- 'Word' type+-- +------------------------------------------------------------------------------+++-- | Write a single signed byte.+--+writeInt8 :: Int8 -> Write+writeInt8 = writeWord8 . fromIntegral+{-# INLINE writeInt8 #-}++-- | Write an 'Int16' in big endian format.+writeInt16be :: Int16 -> Write+writeInt16be = writeWord16be . fromIntegral+{-# INLINE writeInt16be #-}++-- | Write an 'Int16' in little endian format.+writeInt16le :: Int16 -> Write+writeInt16le = writeWord16le . fromIntegral+{-# INLINE writeInt16le #-}++-- | Write an 'Int32' in big endian format.+writeInt32be :: Int32 -> Write+writeInt32be = writeWord32be . fromIntegral+{-# INLINE writeInt32be #-}++-- | Write an 'Int32' in little endian format.+writeInt32le :: Int32 -> Write+writeInt32le = writeWord32le . fromIntegral+{-# INLINE writeInt32le #-}++-- | Write an 'Int64' in big endian format.+writeInt64be :: Int64 -> Write+writeInt64be = writeWord64be . fromIntegral+{-# INLINE writeInt64be #-}++-- | Write an 'Int64' in little endian format.+writeInt64le :: Int64 -> Write+writeInt64le = writeWord64le . fromIntegral+{-# INLINE writeInt64le #-}+++------------------------------------------------------------------------+-- Unaligned, integer size ops++-- | Write a single native machine 'Int'. The 'Int' is written in host order,+-- host endian form, for the machine you're on. On a 64 bit machine the 'Int'+-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values written this way+-- are not portable to different endian or integer sized machines, without+-- conversion.+--+writeInthost :: Int -> Write+writeInthost w = +    Write (sizeOf (undefined :: Int)) (\p -> poke (castPtr p) w)+{-# INLINE writeInthost #-}++-- | Write an 'Int16' in native host order and host endianness.+writeInt16host :: Int16 -> Write+writeInt16host w16 = +    Write (sizeOf (undefined :: Int16)) (\p -> poke (castPtr p) w16)+{-# INLINE writeInt16host #-}++-- | Write an 'Int32' in native host order and host endianness.+writeInt32host :: Int32 -> Write+writeInt32host w32 = +    Write (sizeOf (undefined :: Int32)) (\p -> poke (castPtr p) w32)+{-# INLINE writeInt32host #-}++-- | Write an 'Int64' in native host order and host endianness.+writeInt64host :: Int64 -> Write+writeInt64host w = +    Write (sizeOf (undefined :: Int64)) (\p -> poke (castPtr p) w)+{-# INLINE writeInt64host #-}+++------------------------------------------------------------------------------+-- Builders corresponding to the integer writes+------------------------------------------------------------------------------++-- Single bytes+------------------------------------------------------------------------------++-- | Serialize a single byte.+--+fromInt8 :: Int8 -> Builder+fromInt8 = fromWriteSingleton writeInt8++-- | Serialize a list of bytes.+--+fromInt8s :: [Int8] -> Builder+fromInt8s = fromWrite8List writeInt8+++-- Int16+------------------------------------------------------------------------------++-- | Serialize an 'Int16' in big endian format.+fromInt16be :: Int16 -> Builder+fromInt16be = fromWriteSingleton writeInt16be +{-# INLINE fromInt16be #-}++-- | Serialize a list of 'Int16's in big endian format.+fromInt16sbe :: [Int16] -> Builder+fromInt16sbe = fromWrite4List writeInt16be +{-# INLINE fromInt16sbe #-}++-- | Serialize an 'Int16' in little endian format.+fromInt16le :: Int16 -> Builder+fromInt16le = fromWriteSingleton writeInt16le +{-# INLINE fromInt16le #-}++-- | Serialize a list of 'Int16's in little endian format.+fromInt16sle :: [Int16] -> Builder+fromInt16sle = fromWrite4List writeInt16le +{-# INLINE fromInt16sle #-}+++-- Int32+-----------------------------------------------------------------------------++-- | Serialize an 'Int32' in big endian format.+fromInt32be :: Int32 -> Builder+fromInt32be = fromWriteSingleton writeInt32be +{-# INLINE fromInt32be #-}++-- | Serialize a list of 'Int32's in big endian format.+fromInt32sbe :: [Int32] -> Builder+fromInt32sbe = fromWrite2List writeInt32be +{-# INLINE fromInt32sbe #-}++-- | Serialize an 'Int32' in little endian format.+fromInt32le :: Int32 -> Builder+fromInt32le = fromWriteSingleton writeInt32le +{-# INLINE fromInt32le #-}++-- | Serialize a list of 'Int32's in little endian format.+fromInt32sle :: [Int32] -> Builder+fromInt32sle = fromWrite2List writeInt32le +{-# INLINE fromInt32sle #-}++-- | Serialize an 'Int64' in big endian format.+fromInt64be :: Int64 -> Builder+fromInt64be = fromWriteSingleton writeInt64be +{-# INLINE fromInt64be #-}++-- | Serialize a list of 'Int64's in big endian format.+fromInt64sbe :: [Int64] -> Builder+fromInt64sbe = fromWrite1List writeInt64be +{-# INLINE fromInt64sbe #-}++-- | Serialize an 'Int64' in little endian format.+fromInt64le :: Int64 -> Builder+fromInt64le = fromWriteSingleton writeInt64le +{-# INLINE fromInt64le #-}++-- | Serialize a list of 'Int64's in little endian format.+fromInt64sle :: [Int64] -> Builder+fromInt64sle = fromWrite1List writeInt64le +{-# INLINE fromInt64sle #-}+++------------------------------------------------------------------------+-- Unaligned, integer size ops++-- | Serialize a single native machine 'Int'. The 'Int' is serialized in host+-- order, host endian form, for the machine you're on. On a 64 bit machine the+-- 'Int' is an 8 byte value, on a 32 bit machine, 4 bytes. Values written this+-- way are not portable to different endian or integer sized machines, without+-- conversion.+--+fromInthost :: Int -> Builder+fromInthost = fromWriteSingleton writeInthost +{-# INLINE fromInthost #-}++-- | Serialize a list of 'Int's.+-- See 'fromInthost' for usage considerations.+fromIntshost :: [Int] -> Builder+fromIntshost = fromWrite2List writeInthost +{-# INLINE fromIntshost #-}++-- | Write an 'Int16' in native host order and host endianness.+fromInt16host :: Int16 -> Builder+fromInt16host = fromWriteSingleton writeInt16host +{-# INLINE fromInt16host #-}++-- | Write a list of 'Int16's in native host order and host endianness.+fromInt16shost :: [Int16] -> Builder+fromInt16shost = fromWrite4List writeInt16host +{-# INLINE fromInt16shost #-}++-- | Write an 'Int32' in native host order and host endianness.+fromInt32host :: Int32 -> Builder+fromInt32host = fromWriteSingleton writeInt32host +{-# INLINE fromInt32host #-}++-- | Write a list of 'Int32's in native host order and host endianness.+fromInt32shost :: [Int32] -> Builder+fromInt32shost = fromWrite2List writeInt32host +{-# INLINE fromInt32shost #-}++-- | Write an 'Int64' in native host order and host endianness.+fromInt64host :: Int64 -> Builder+fromInt64host = fromWriteSingleton writeInt64host+{-# INLINE fromInt64host #-}++-- | Write a list of 'Int64's in native host order and host endianness.+fromInt64shost :: [Int64] -> Builder+fromInt64shost = fromWrite1List writeInt64host+{-# INLINE fromInt64shost #-}

@@ -0,0 +1,441 @@+{-# LANGUAGE CPP, BangPatterns #-}+-- |+-- 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+--+-- Implementation of the 'Builder' monoid.+--+-- A standard library user must never import this module directly. Instead, he+-- should import "Blaze.ByteString.Builder", which re-exports the 'Builder' type and+-- its associated public functions defined in this module.+--+-- Developers of other libraries may import this module to gain access to the+-- internal representation of builders. For example, in some cases, creating a+-- 'Builder' with a custom low-level 'BuildStep' may improve performance+-- considerably compared to the creating it using the public 'Builder'+-- combinators (e.g., @'fromWrite1List'@ in "Blaze.ByteString.Builder.Write").+-- Another example, is the use of 'ModifyChunks' to efficiently wire the+-- 'Builder' type with another library that generates lazy bytestrings.+--+-- In any case, whenever you import this module you /must/ reference the full+-- version of the 'blaze-builder' package in your cabal file, as the+-- implementation and the guarantees given in this file may change in any+-- version! The release notes will tell, if this was the case.+--+module Blaze.ByteString.Builder.Internal+    ( +    -- * The @Builder@ type+      Builder(..)+    , BuildStep+    , BuildSignal(..)++    -- * Flushing the buffer+    , flush++    -- * Executing builders+    , toLazyByteStringWith+    , toLazyByteString+    , toByteString+    , toByteStringIOWith+    , toByteStringIO++    -- * Default sizes+    , defaultBufferSize+    , defaultMinimalBufferSize+    , defaultMaximalCopySize+    ) where+++import Foreign+import Data.Monoid+import Control.Monad (unless)+import qualified Data.ByteString      as S+import qualified Data.ByteString.Lazy as L++#ifdef BYTESTRING_IN_BASE+import Data.ByteString.Base (inlinePerformIO)+import qualified Data.ByteString.Base as S+import qualified Data.ByteString.Lazy.Base as L -- FIXME: is this the right module for access to 'Chunks'?+#else+import Data.ByteString.Internal (inlinePerformIO)+import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Lazy.Internal as L+#endif+++------------------------------------------------------------------------------+-- The Builder type+------------------------------------------------------------------------------++-- | Intuitively, a builder denotes the construction of a lazy bytestring. +--+-- Builders can be created from primitive buffer manipulations using the+-- @'Write'@ abstraction provided by in "Blaze.ByteString.Builder.Write". However for+-- many Haskell values, there exist predefined functions doing that already. +-- For example, UTF-8 encoding 'Char' and 'String' values is provided by the+-- functions in "Blaze.ByteString.Builder.Char.Utf8". Concatenating builders is done+-- using their 'Monoid' instance.+--+-- Semantically, builders are nothing special. They just denote a sequence of+-- bytes. However, their representation is chosen such that this sequence of+-- bytes can be efficiently (in terms of CPU cycles) computed in an+-- incremental, chunk-wise fashion such that the average chunk-size is large.+-- Note that the large average chunk size allows to make good use of cache+-- prefetching in later processing steps (e.g. compression) or to reduce the+-- sytem call overhead when writing the resulting lazy bytestring to a file or+-- sending it over the network.+--+-- For precisely understanding the performance of a specific 'Builder',+-- benchmarking is unavoidable. Moreover, it also helps to understand the+-- implementation of builders and the predefined combinators. This should be+-- amenable to the average Haskell programmer by reading the source code of+-- "Blaze.ByteString.Builder.Internal" and the other modules of this library. +--+-- The guiding implementation principle was to reduce the abstraction cost per+-- output byte. We use continuation passing to achieve a constant time append.+-- The output buffer is filled by the individual builders as long as possible.+-- They call each other directly when they are done and control is returned to+-- the driver (e.g., 'toLazyByteString') only when the buffer is full, a+-- bytestring needs to be inserted directly, or no more bytes can be written.+-- We also try to take the pressure off the cache by moving variables as far+-- out of loops as possible. This leads to some duplication of code, but+-- results in sometimes dramatic increases in performance. For example, see the+-- @'fromWord8s'@ function in "Blaze.ByteString.Builder.Word".+--+newtype Builder = Builder (BuildStep -> BuildStep)++-- | A 'BuildSignal' signals to the driver of the 'Builder' execution the next+-- step to be taken.+--+data BuildSignal =+  -- | @Done pf@ signals that the 'BuildStep' is finished and data has been+  -- written up to the next free byte @pf@.+    Done {-# UNPACK #-} !(Ptr Word8) +  -- | @BufferFull newSize pf nextStep@ signals that the buffer is full and+  -- data has been written up to the next free byte @pf@. Moreover, the next+  -- build step to be executed @nextStep@ requires a buffer of at least size+  -- @newSize@ to execute successfully.+  --+  -- A driver /must/ guarantee that the buffer used to call @nextStep@ is at+  -- least of size @newSize@.+  | BufferFull+      {-# UNPACK #-} !Int+      {-# UNPACK #-} !(Ptr Word8)+                     !BuildStep+  -- | @ModifyChunks pf fbs nextStep@ signals that the data written up to the+  -- next free byte @pf@ must be output and the remaining lazy bytestring that+  -- is produced by executing @nextStep@ must be modified using the function+  -- @fbs@.+  --+  -- This signal is used to insert bytestrings directly into the output stream.+  -- It can also be used to efficiently hand over control to another library+  -- for generating streams of strict bytestrings.+  | ModifyChunks+      {-# UNPACK #-} !(Ptr Word8) +                     !(L.ByteString -> L.ByteString) +                     !BuildStep++-- | A 'BuildStep' fills a buffer from the given start pointer as long as+-- possible and returns control to the caller using a 'BuildSignal', once it is+-- required.+--+type BuildStep =  Ptr Word8       -- ^ Pointer to the next free byte in the+                                  -- buffer. A 'BuildStep' must start writing+                                  -- its data from this address.+               -> Ptr Word8       -- ^ Pointer to the first byte /after/ the+                                  -- buffer.  A 'BuildStep' must never write+                                  -- data at or after this address.+               -> IO BuildSignal  -- ^ Signal to the driver about the next step+                                  -- to be taken.++instance Monoid Builder where+    mempty = Builder id+    {-# INLINE mempty #-}+    mappend (Builder f) (Builder g) = Builder $ f . g+    {-# INLINE mappend #-}+    mconcat = foldr mappend mempty+    {-# INLINE mconcat #-}++------------------------------------------------------------------------------+-- 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+------------------------------------------------------------------------------+++-- | Output all data written in the current buffer and start a new chunk.+--+-- The use uf 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.+--+flush :: Builder+flush = Builder $ \k pf _ -> return $ ModifyChunks pf id 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 = +    inlinePerformIO $ fillFirstBuffer (b finalStep)+  where+    finalStep 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 <- step0 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) $+                          \pfNew peNew -> do+                              copyBytes pfNew pf l+                              nextStep (pfNew `plusPtr` l) peNew+                      +                  ModifyChunks pf' bsk nextStep +                      | pf' == pf ->+                          return $ bsk (inlinePerformIO $ fillNewBuffer bufSize nextStep)+                      | otherwise ->+                          return $ L.Chunk (mkbs pf')+                              (bsk (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 <- step 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 ->+                        return $ L.Chunk (mkbs pf')+                            (inlinePerformIO $ +                                fillNewBuffer (max newSize bufSize) nextStep)+                        +                    ModifyChunks  pf' bsk nextStep+                      | pf' == pf                      ->+                          return $ bsk (inlinePerformIO $ fill pf' nextStep)+                      | minBufSize < pe `minusPtr` pf' ->+                          return $ L.Chunk (mkbs pf')+                              (bsk (inlinePerformIO $ fill pf' nextStep))+                      | otherwise                      ->+                          return $ L.Chunk (mkbs pf')+                              (bsk (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) = +    fillNewBuffer bufSize (b finalStep)+  where+    finalStep pf _ = return $ Done pf++    fillNewBuffer !size !step0 = do+        S.mallocByteString size >>= fillBuffer+      where+        fillBuffer fpbuf = fill step0+          where+            -- safe because the constructed ByteString references the foreign+            -- pointer AFTER its buffer was filled.+            pf = unsafeForeignPtrToPtr fpbuf+            fill !step = do+                next <- step pf (pf `plusPtr` size)+                case next of+                    Done pf' ->+                        unless (pf' == pf) (io $  S.PS fpbuf 0 (pf' `minusPtr` pf))++                    BufferFull newSize pf' nextStep  -> do+                        io $ S.PS fpbuf 0 (pf' `minusPtr` pf)+                        if bufSize < newSize+                          then fillNewBuffer newSize nextStep+                          else fill nextStep+                        +                    ModifyChunks  pf' bsk nextStep  -> do+                        unless (pf' == pf) (io $  S.PS fpbuf 0 (pf' `minusPtr` pf))+                        -- was: mapM_ io $ L.toChunks (bsk L.empty)+                        L.foldrChunks (\bs -> (io bs >>)) (return ()) (bsk L.empty)+                        fill 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 #-}+

@@ -0,0 +1,436 @@+{-# OPTIONS_GHC -fglasgow-exts #-}+-- for unboxed shifts++{-# LANGUAGE CPP #-}+-- |+-- Module      : Blaze.ByteString.Builder.Word+-- Copyright   : (c) 2010 Jasper Van der Jeugt & Simon Meier+--+--               Original serialization code from 'Data.Binary.Builder':+--               (c) Lennart Kolmodin, Ross Patterson+--+-- License     : BSD3-style (see LICENSE)+-- +-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : tested on GHC only+--+-- 'Write's and 'Builder's for serializing words.+--+-- Note that for serializing a three tuple @(x,y,z)@ of bytes (or other word+-- values) you should use the expression +--+-- > fromWrite $ writeWord8 x `mappend` writeWord8 y `mappend` writeWord z+--+-- instead of+--+-- > fromWord8 x `mappend` fromWord8 y `mappend` fromWord z+--+-- The first expression will result in a single atomic write of three bytes,+-- while the second expression will check for each byte, if there is free space+-- left in the output buffer. Coalescing these checks can improve performance+-- quite a bit, as long as you use it sensibly.+--+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#include "MachDeps.h"+#endif++module Blaze.ByteString.Builder.Word+    ( +    -- * Writing words to a buffer++      writeWord8++    -- ** Big-endian writes+    , writeWord16be           -- :: Word16 -> Write+    , writeWord32be           -- :: Word32 -> Write+    , writeWord64be           -- :: Word64 -> Write++    -- ** Little-endian writes+    , writeWord16le           -- :: Word16 -> Write+    , writeWord32le           -- :: Word32 -> Write+    , writeWord64le           -- :: Word64 -> Write++    -- ** Host-endian writes+    , writeWordhost           -- :: Word -> Write+    , writeWord16host         -- :: Word16 -> Write+    , writeWord32host         -- :: Word32 -> Write+    , writeWord64host         -- :: Word64 -> Write++    -- * Creating builders from words+    +    -- | We provide serialization functions both for singleton words as well as+    -- for lists of words. Using these list serialization functions is /much/ faster+    -- than using @mconcat . map fromWord/<n/>@, as the list serialization+    -- functions use a tighter inner loop and a chunked write like it is+    -- provided by functions such as 'fromWrite2List'.++    , fromWord8+    , fromWord8s++    -- ** Big-endian serialization+    , fromWord16be            -- :: Word16   -> Builder+    , fromWord32be            -- :: Word32   -> Builder+    , fromWord64be            -- :: Word64   -> Builder+    , fromWord32sbe           -- :: [Word32] -> Builder+    , fromWord16sbe           -- :: [Word16] -> Builder+    , fromWord64sbe           -- :: [Word64] -> Builder++    -- ** Little-endian serialization+    , fromWord16le            -- :: Word16   -> Builder+    , fromWord32le            -- :: Word32   -> Builder+    , fromWord64le            -- :: Word64   -> Builder+    , fromWord16sle           -- :: [Word16] -> Builder+    , fromWord32sle           -- :: [Word32] -> Builder+    , fromWord64sle           -- :: [Word64] -> Builder++    -- ** Host-endian serialization+    , fromWordhost            -- :: Word     -> Builder+    , fromWord16host          -- :: Word16   -> Builder+    , fromWord32host          -- :: Word32   -> Builder+    , fromWord64host          -- :: Word64   -> Builder+    , fromWordshost           -- :: [Word]   -> Builder+    , fromWord16shost         -- :: [Word16] -> Builder+    , fromWord32shost         -- :: [Word32] -> Builder+    , fromWord64shost         -- :: [Word64] -> Builder++    ) where++import Blaze.ByteString.Builder.Internal+import Blaze.ByteString.Builder.Write++import Foreign++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+import GHC.Base+import GHC.Word (Word32(..),Word16(..),Word64(..))++#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608+import GHC.Word (uncheckedShiftRL64#)+#endif+#else+import Data.Word+#endif++------------------------------------------------------------------------------+-- Word writes+--------------+--+-- Based upon the 'putWordX' functions from "Data.Binary.Builder" from the+-- 'binary' package.+-- +------------------------------------------------------------------------------+++-- | Write a single byte.+--+writeWord8 :: Word8 -> Write+writeWord8 x = Write 1 (\pf -> poke pf x)+{-# INLINE writeWord8 #-}++--+-- We rely on the fromIntegral to do the right masking for us.+-- The inlining here is critical, and can be worth 4x performance+--++-- | Write a 'Word16' in big endian format.+writeWord16be :: Word16 -> Write+writeWord16be w = Write 2 $ \p -> do+    poke p               (fromIntegral (shiftr_w16 w 8) :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (w)              :: Word8)+{-# INLINE writeWord16be #-}++-- | Write a 'Word16' in little endian format.+writeWord16le :: Word16 -> Write+writeWord16le w = Write 2 $ \p -> do+    poke p               (fromIntegral (w)              :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w16 w 8) :: Word8)+{-# INLINE writeWord16le #-}++-- writeWord16le w16 = Write 2 (\p -> poke (castPtr p) w16)++-- | Write a 'Word32' in big endian format.+writeWord32be :: Word32 -> Write+writeWord32be w = Write 4 $ \p -> do+    poke p               (fromIntegral (shiftr_w32 w 24) :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w 16) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w  8) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (w)               :: Word8)+{-# INLINE writeWord32be #-}++-- | Write a 'Word32' in little endian format.+writeWord32le :: Word32 -> Write+writeWord32le w = Write 4 $ \p -> do+    poke p               (fromIntegral (w)               :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w  8) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w 16) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 w 24) :: Word8)+{-# INLINE writeWord32le #-}++-- on a little endian machine:+-- writeWord32le w32 = Write 4 (\p -> poke (castPtr p) w32)++-- | Write a 'Word64' in big endian format.+writeWord64be :: Word64 -> Write+#if WORD_SIZE_IN_BITS < 64+--+-- To avoid expensive 64 bit shifts on 32 bit machines, we cast to+-- Word32, and write that+--+writeWord64be w =+    let a = fromIntegral (shiftr_w64 w 32) :: Word32+        b = fromIntegral w                 :: Word32+    in Write 8 $ \p -> do+    poke p               (fromIntegral (shiftr_w32 a 24) :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a 16) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a  8) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (a)               :: Word8)+    poke (p `plusPtr` 4) (fromIntegral (shiftr_w32 b 24) :: Word8)+    poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b 16) :: Word8)+    poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b  8) :: Word8)+    poke (p `plusPtr` 7) (fromIntegral (b)               :: Word8)+#else+writeWord64be w = Write 8 $ \p -> do+    poke p               (fromIntegral (shiftr_w64 w 56) :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w 48) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 40) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 32) :: Word8)+    poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 24) :: Word8)+    poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 16) :: Word8)+    poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w  8) :: Word8)+    poke (p `plusPtr` 7) (fromIntegral (w)               :: Word8)+#endif+{-# INLINE writeWord64be #-}++-- | Write a 'Word64' in little endian format.+writeWord64le :: Word64 -> Write++#if WORD_SIZE_IN_BITS < 64+writeWord64le w =+    let b = fromIntegral (shiftr_w64 w 32) :: Word32+        a = fromIntegral w                 :: Word32+    in Write 8 $ \p -> do+    poke (p)             (fromIntegral (a)               :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a  8) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a 16) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 a 24) :: Word8)+    poke (p `plusPtr` 4) (fromIntegral (b)               :: Word8)+    poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b  8) :: Word8)+    poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b 16) :: Word8)+    poke (p `plusPtr` 7) (fromIntegral (shiftr_w32 b 24) :: Word8)+#else+writeWord64le w = Write 8 $ \p -> do+    poke p               (fromIntegral (w)               :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w  8) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 16) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 24) :: Word8)+    poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 32) :: Word8)+    poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 40) :: Word8)+    poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w 48) :: Word8)+    poke (p `plusPtr` 7) (fromIntegral (shiftr_w64 w 56) :: Word8)+#endif+{-# INLINE writeWord64le #-}++-- on a little endian machine:+-- writeWord64le w64 = Write 8 (\p -> poke (castPtr p) w64)++------------------------------------------------------------------------+-- Unaligned, word size ops++-- | Write a single native machine 'Word'. The 'Word' is written in host order,+-- host endian form, for the machine you're on. On a 64 bit machine the 'Word'+-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values written this way+-- are not portable to different endian or word sized machines, without+-- conversion.+--+writeWordhost :: Word -> Write+writeWordhost w = +    Write (sizeOf (undefined :: Word)) (\p -> poke (castPtr p) w)+{-# INLINE writeWordhost #-}++-- | Write a 'Word16' in native host order and host endianness.+writeWord16host :: Word16 -> Write+writeWord16host w16 = +    Write (sizeOf (undefined :: Word16)) (\p -> poke (castPtr p) w16)+{-# INLINE writeWord16host #-}++-- | Write a 'Word32' in native host order and host endianness.+writeWord32host :: Word32 -> Write+writeWord32host w32 = +    Write (sizeOf (undefined :: Word32)) (\p -> poke (castPtr p) w32)+{-# INLINE writeWord32host #-}++-- | Write a 'Word64' in native host order and host endianness.+writeWord64host :: Word64 -> Write+writeWord64host w = +    Write (sizeOf (undefined :: Word64)) (\p -> poke (castPtr p) w)+{-# INLINE writeWord64host #-}++------------------------------------------------------------------------+-- Unchecked shifts++{-# INLINE shiftr_w16 #-}+shiftr_w16 :: Word16 -> Int -> Word16+{-# INLINE shiftr_w32 #-}+shiftr_w32 :: Word32 -> Int -> Word32+{-# INLINE shiftr_w64 #-}+shiftr_w64 :: Word64 -> Int -> Word64++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#`   i)+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#`   i)++#if WORD_SIZE_IN_BITS < 64+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)++#if __GLASGOW_HASKELL__ <= 606+-- Exported by GHC.Word in GHC 6.8 and higher+foreign import ccall unsafe "stg_uncheckedShiftRL64"+    uncheckedShiftRL64#     :: Word64# -> Int# -> Word64#+#endif++#else+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)+#endif++#else+shiftr_w16 = shiftR+shiftr_w32 = shiftR+shiftr_w64 = shiftR+#endif+++------------------------------------------------------------------------------+-- Builders corresponding to the word writes+------------------------------------------------------------------------------++-- Single bytes+------------------------------------------------------------------------------++-- | Serialize a single byte.+--+fromWord8 :: Word8 -> Builder+fromWord8 = fromWriteSingleton writeWord8++-- | Serialize a list of bytes.+--+fromWord8s :: [Word8] -> Builder+fromWord8s = fromWrite8List writeWord8+++-- Word16+------------------------------------------------------------------------------++-- | Serialize a 'Word16' in big endian format.+fromWord16be :: Word16 -> Builder+fromWord16be = fromWriteSingleton writeWord16be +{-# INLINE fromWord16be #-}++-- | Serialize a list of 'Word16's in big endian format.+fromWord16sbe :: [Word16] -> Builder+fromWord16sbe = fromWrite4List writeWord16be +{-# INLINE fromWord16sbe #-}++-- | Serialize a 'Word16' in little endian format.+fromWord16le :: Word16 -> Builder+fromWord16le = fromWriteSingleton writeWord16le +{-# INLINE fromWord16le #-}++-- | Serialize a list of 'Word16's in little endian format.+fromWord16sle :: [Word16] -> Builder+fromWord16sle = fromWrite4List writeWord16le +{-# INLINE fromWord16sle #-}+++-- Word32+-----------------------------------------------------------------------------++-- | Serialize a 'Word32' in big endian format.+fromWord32be :: Word32 -> Builder+fromWord32be = fromWriteSingleton writeWord32be +{-# INLINE fromWord32be #-}++-- | Serialize a list of 'Word32's in big endian format.+fromWord32sbe :: [Word32] -> Builder+fromWord32sbe = fromWrite2List writeWord32be +{-# INLINE fromWord32sbe #-}++-- | Serialize a 'Word32' in little endian format.+fromWord32le :: Word32 -> Builder+fromWord32le = fromWriteSingleton writeWord32le +{-# INLINE fromWord32le #-}++-- | Serialize a list of 'Word32's in little endian format.+fromWord32sle :: [Word32] -> Builder+fromWord32sle = fromWrite2List writeWord32le +{-# INLINE fromWord32sle #-}++-- | Serialize a 'Word64' in big endian format.+fromWord64be :: Word64 -> Builder+fromWord64be = fromWriteSingleton writeWord64be +{-# INLINE fromWord64be #-}++-- | Serialize a list of 'Word64's in big endian format.+fromWord64sbe :: [Word64] -> Builder+fromWord64sbe = fromWrite1List writeWord64be +{-# INLINE fromWord64sbe #-}++-- | Serialize a 'Word64' in little endian format.+fromWord64le :: Word64 -> Builder+fromWord64le = fromWriteSingleton writeWord64le +{-# INLINE fromWord64le #-}++-- | Serialize a list of 'Word64's in little endian format.+fromWord64sle :: [Word64] -> Builder+fromWord64sle = fromWrite1List writeWord64le +{-# INLINE fromWord64sle #-}+++------------------------------------------------------------------------+-- Unaligned, word size ops++-- | Serialize a single native machine 'Word'. The 'Word' is serialized in host+-- order, host endian form, for the machine you're on. On a 64 bit machine the+-- 'Word' is an 8 byte value, on a 32 bit machine, 4 bytes. Values written this+-- way are not portable to different endian or word sized machines, without+-- conversion.+--+fromWordhost :: Word -> Builder+fromWordhost = fromWriteSingleton writeWordhost +{-# INLINE fromWordhost #-}++-- | Serialize a list of 'Word's.+-- See 'fromWordhost' for usage considerations.+fromWordshost :: [Word] -> Builder+fromWordshost = fromWrite2List writeWordhost +{-# INLINE fromWordshost #-}++-- | Write a 'Word16' in native host order and host endianness.+fromWord16host :: Word16 -> Builder+fromWord16host = fromWriteSingleton writeWord16host +{-# INLINE fromWord16host #-}++-- | Write a list of 'Word16's in native host order and host endianness.+fromWord16shost :: [Word16] -> Builder+fromWord16shost = fromWrite4List writeWord16host +{-# INLINE fromWord16shost #-}++-- | Write a 'Word32' in native host order and host endianness.+fromWord32host :: Word32 -> Builder+fromWord32host = fromWriteSingleton writeWord32host +{-# INLINE fromWord32host #-}++-- | Write a list of 'Word32's in native host order and host endianness.+fromWord32shost :: [Word32] -> Builder+fromWord32shost = fromWrite2List writeWord32host +{-# INLINE fromWord32shost #-}++-- | Write a 'Word64' in native host order and host endianness.+fromWord64host :: Word64 -> Builder+fromWord64host = fromWriteSingleton writeWord64host+{-# INLINE fromWord64host #-}++-- | Write a list of 'Word64's in native host order and host endianness.+fromWord64shost :: [Word64] -> Builder+fromWord64shost = fromWrite1List writeWord64host+{-# INLINE fromWord64shost #-}

@@ -0,0 +1,384 @@+{-# 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 #-}++

@@ -0,0 +1,34 @@++* blaze-builder-0.2.0.0++  Heavily restructured 'blaze-builder' such that 'Blaze.ByteString.Builder' serves as+  a drop-in replacement of 'binary:Data.Binary.Builder' which it improves upon+  with respect to both speed as well as expressivity. See the documentation and+  the benchmarks for details on improvements and new functionality.++  Changed module structure:+    Blaze.ByteString.Builder.Core -> Blaze.ByteString.Builder+    Blaze.ByteString.Builder.Utf8 -> Blaze.ByteString.Builder.Char.Utf8+    Blaze.ByteString.Builder.Html -> Blaze.ByteString.Builder.Html.Utf8 ++  Changed function names:+    writeByte     -> writeWord8+    fromByte      -> fromWord8+    fromWriteList -> fromWrite1List++  Possibly performance sensitive implementation changes:+    - 'fromByteString' and 'fromLazyByteString' check now if a direct insertion+      of the bytestring(s) would be cheaper than copying it. See their+      documentation on how to recover the old behaviour.++  Deprecated functions:+    'empty'    : use 'mempty' instead+    'singleton': use 'fromWord8' instead+    'append'   : use 'mappend' instead+  ++* blaze-builder-0.1++  This is the first version of 'blaze-builder'. It is explicitely targeted at+  fast generation of UTF-8 encoded HTML documents in the 'blaze-html' and the+  'hamlet' HTML templating libraries.

@@ -0,0 +1,101 @@++##############################################################################+## Benchmarks+##############################################################################++## Config+#########++GHC = ghc-6.12.3+# GHC = ghc-7.0.0.20100924++GHCI = ghci-6.12.3+++## All benchmarks+#################++bench-all: bench-compression bench-string-and-text bench-throughput bench-chunked-write++clean-bench-all:+	rm -f benchmarks/*.o benchmarks/*.hi+	rm -f benchmarks/Throughput/*.o benchmarks/Throughput/*.hi+	rm -f Text/Blaze/Builder.o Text/Blaze/Builder.hi+	rm -f Text/Blaze/Builder/*.o Text/Blaze/Builder/*.hi+	rm -f Text/Blaze/Builder/Char/*.o Text/Blaze/Builder/Char/*.hi+	rm -f Text/Blaze/Builder/Html/*.o Text/Blaze/Builder/Html/*.hi+	rm -f Text/Blaze/Builder/Core/*.o Text/Blaze/Builder/Core/*.hi+	rm -f benchmarks/Compression benchmarks/StringAndText benchmarks/BenchThroughput benchmarks/ChunkedWrite benchmarks/BlazeVsBinary+	rm -f Criterion/*.o Criterion/*.hi+	rm -f Criterion/ScalingBenchmark++## Individual benchmarks+########################++# 'blaze-builder' vs. 'binary' comparision+bench-blaze-vs-binary:+	$(GHC) --make -O2 -fforce-recomp -main-is BlazeVsBinary benchmarks/BlazeVsBinary.hs+	./benchmarks/BlazeVsBinary --resamples 10000++# throughput benchmarks: interactive development+ghci-throughput: benchmarks/Throughput/CBenchmark.o +	$(GHCI) -O2 -fforce-recomp -ibenchmarks -main-is BenchThroughput benchmarks/Throughput/CBenchmark.o benchmarks/BenchThroughput.hs++bench-throughput: benchmarks/Throughput/CBenchmark.o+	$(GHC) --make -O2 -fforce-recomp -fliberate-case-threshold=1000 -ibenchmarks -main-is BenchThroughput benchmarks/Throughput/CBenchmark.o benchmarks/BenchThroughput.hs+	./benchmarks/BenchThroughput 100++benchmarks/Throughput/CBenchmark.o: benchmarks/Throughput/CBenchmark.c+	gcc -O3 -c $< -o $@++# Benchmark benefit of serializing several list elements at once+bench-chunked-write:+	$(GHC) --make -O2 -fforce-recomp -main-is ChunkedWrite benchmarks/ChunkedWrite.hs+	./benchmarks/ChunkedWrite --resamples 10000++core-chunked-write:+	ghc-core -- --make -O2 -fforce-recomp -main-is ChunkedWrite benchmarks/ChunkedWrite.hs++# Benchmark best serialization techniques for 'String' and 'Text'+bench-string-and-text:+	$(GHC) --make -O2 -fforce-recomp -ibenchmarks -main-is StringAndText StringAndText+	echo $(GHC)+	./benchmarks/StringAndText --resamples 10000++# Benchmark benefit of compaction before compression+bench-compression:+	$(GHC) --make -O2 -fforce-recomp -ibenchmarks -main-is Compression Compression+	./benchmarks/Compression --resamples 10000++##############################################################################+## Plots+##############################################################################++plot-all:+	$(GHC) --make -O2 -fforce-recomp -main-is Criterion.ScalingBenchmark Criterion.ScalingBenchmark+	./Criterion/ScalingBenchmark --resamples 10000+++##############################################################################+## Tests+##############################################################################++test:+	$(GHC) --make -O2 -itests -main-is Tests Tests+	./tests/Tests++clean-tests:+	rm -f tests/Tests tests/*.o tests/*.hi++ghci-llvm-segfault: +	$(GHCI) -itests -main-is LlvmSegfault tests/LlvmSegfault ++test-llvm-segfault: +	ghc-7.0.0.20100924 --make -fllvm -itests -main-is LlvmSegfault tests/LlvmSegfault +	./tests/LlvmSegfault++##############################################################################+## All inclusive targets+##############################################################################++clean: clean-tests clean-bench-all

@@ -0,0 +1,30 @@+blaze-builder+=============++This library allows to efficiently serialize Haskell values to lazy bytestrings+with a large average chunk size. The large average chunk size allows to make+good use of cache prefetching in later processing steps (e.g. compression) and+reduces the sytem call overhead when writing the resulting lazy bytestring to a+file or sending it over the network.++This library was inspired by the module Data.Binary.Builder provided by the+binary package. It was originally developed with the specific needs of the+blaze-html package in mind. Since then it has been restructured to serve as a+drop-in replacement for Data.Binary.Builder, which it improves upon both in+speed as well as expressivity.++To see the improvements in speed, run the throughput benchmark, which measures+serialization speeds for writing Word8, Word16, Word32 and Word64 in different+endian formats and different chunk sizes, using the command++  make bench-throughput++or run the list serialization comparison benchmark++  make bench-blaze-vs-binary++Checkout the combinators in the module "Blaze.ByteString.Builder.Write" to see+the improvements in expressivity. This module allows to incorporate efficient+primitive buffer manipulations as parts of a builder. We use this facility+in the 'blaze-html' HTML templating library to allow for the efficient+serialization of HTML escaped and UTF-8 encoded characters.

@@ -0,0 +1,63 @@+  +  * custom serialization functions for lists of 'WordX's+      - benchmark chunk size speedup for more complicated computations of list+        elements => to be expected that we get no speedup anymore or even a+        slowdown => adapt Blaze.ByteString.Builder.Word accordingly.++  * fast serialization for 'Text' values (currently unpacking to 'String' is+    the fastest :-/)++  * implementation+      - further encodings for 'Char'+      - think about end-of-buffer wrapping when copying bytestrings+      - toByteStringIO with accumulator capability => provide 'toByteStringIO_'+      - allow buildr/foldr deforestation to happen for input to 'fromWrite<n>List'+        (or whatever stream fusion framework is in place for lists)+      - implement 'toByteString' with an amortized O(n) runtime using the+        exponentional scaling trick. If the start size is chosen wisely this+        may even be faster than 'S.pack', as the one copy per element is+        cheaper than one list thunk per element. It is even likely that we can+        amortize three copies per element, which allows to avoid spilling any+        buffer space by doing a last compaction copy.++  * extend tests to new functions++  * benchmarks+      - understand why the declarative blaze-builder version is the fastest+        serializer for Word64 little-endian and big-endian +      - check the cost of using `mappend` on builders instead of writes.+      - show that using toByteStringIO has an advantage over toLazyByteString+      - check performance of toByteStringIO+      - compare speed of 'L.pack' to speed of 'toLazyByteString . fromWord8s'++  * documentation+      - sort out formultion: "serialization" vs. "encoding"++  * check portability to Hugs++  * performance:+      - check if reordering 'pe' and 'pf' change performance; it seems that 'pe'+        is only a reader argument while 'pf' is a state argument.+      - perhaps we could improve performance by taking page size, page+        alignment, and memory access alignment into account.+      - detect machine endianness and use host order writes for the supported+        endianness.+      - introduce a type 'BoundedWrite' that encapsulates a 'Write' generator+        with a bound on the number of bytes maximally written by the write.+        This way we can achieve data independence for the size check by+        sacrificing just a little bit of buffer space at buffer ends.+      - investigate where we would profit from static bounds on number of bytes+        written (e.g. to make the control flow more linear)++  * testing+      - port tests from 'Data.Binary.Builder' to ensure that the word writes+        and builders are working correctly. I may have missed some pitfalls+        about word types in Haskell during porting the functions from+        'Data.Binary.Builder'.++  * portability+      - port to Hugs+      - test lower versions of GHC++  * deployment+      - add source repository to 'blaze-html' and 'blaze-builder' cabal files

@@ -1,219 +0,0 @@--- | The builder monoid from BlazeHtml.------ Usage is fairly straightforward. Builders can be constructed from many--- values, including 'String' and 'Text' values.------ > strings :: [String]--- > strings = replicate 10000 "Hello there!"------ Concatenation should happen through the 'Monoid' interface.------ > concatenation :: Builder--- > concatenation = mconcat $ map fromString strings------ There is only one way to efficiently obtain the result: to convert the--- 'Builder' to a lazy 'L.ByteString' using 'toLazyByteString'.------ > result :: L.ByteString--- > result = toLazyByteString concatenation----{-# LANGUAGE BangPatterns, OverloadedStrings #-}-module Text.Blaze.Builder.Core-    ( -      -- * Main builder type-      Builder--      -- * Custom writes to the builder-    , Write (..)-    , writeByte-    , writeByteString-    , writeSingleton-    , writeList--      -- * Creating builders-    , singleton-    , fromByteString--      -- * Extracting the result from a builder-    , toLazyByteString-    ) where--import Foreign-import Data.Monoid (Monoid, mempty, mappend, mconcat)-import qualified Data.ByteString.Char8 ()-import qualified Data.ByteString as S-import qualified Data.ByteString.Internal as S-import qualified Data.ByteString.Lazy as L---- | Main builder type. It simply contains a function to extract the actual--- data.----newtype Builder = Builder (BuildStep -> BuildStep)---- | A buildsignal is a signal returned from a write to the builder, it tells us--- what should happen next.----data BuildSignal-  -- | Signal the completion of the write process.-  = Done {-# UNPACK #-} !(Ptr Word8)  -- ^ Pointer to the next free byte-  -- | Signal that the buffer is full and a new one needs to be allocated.-  -- It contains the minimal size required for the next buffer, a pointer to the-  -- next free byte, and a continuation.-  | BufferFull-      {-# UNPACK #-} !Int-      {-# UNPACK #-} !(Ptr Word8)-      {-# UNPACK #-} !BuildStep---- | Type for a single build step. Every build step checks that------ > free + bytes-written <= last----type BuildStep =  Ptr Word8       -- ^ Ptr to the next free byte in the buffer-               -> Ptr Word8       -- ^ Ptr to the first byte AFTER the buffer-               -> IO BuildSignal  -- ^ Signal the next step to be taken--instance Monoid Builder where-    mempty = Builder id-    {-# INLINE mempty #-}-    mappend (Builder f) (Builder g) = Builder $ f . g-    {-# INLINE mappend #-}-    mconcat = foldr mappend mempty-    {-# INLINE mconcat #-}---- | Write abstraction so we can avoid some gory and bloody details. A write--- abstration holds the exact size of the write in bytes, and a function to--- carry out the write operation.----data Write = Write-    {-# UNPACK #-} !Int-    (Ptr Word8 -> IO ())---- 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 #-}---- | Write a single byte.----writeByte :: Word8  -- ^ Byte to write-          -> Write  -- ^ Resulting write-writeByte x = Write 1 (\pf -> poke pf x)-{-# INLINE writeByte #-}---- | Write a strict 'S.ByteString'.----writeByteString :: S.ByteString  -- ^ 'S.ByteString' to write-                -> Write         -- ^ Resulting write-writeByteString bs = Write l io-  where-  (fptr, o, l) = S.toForeignPtr bs-  io pf = withForeignPtr fptr $ \p -> copyBytes pf (p `plusPtr` o) l-{-# INLINE writeByteString #-}---- | Construct a 'Builder' from a single 'Write' abstraction.----writeSingleton :: (a -> Write)  -- ^ 'Write' abstraction-               -> a             -- ^ Actual value to write-               -> Builder       -- ^ Resulting 'Builder'-writeSingleton 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 writeSingleton #-}---- | Construct a builder writing a list of data from a write abstraction.----writeList :: (a -> Write)  -- ^ 'Write' abstraction-          -> [a]           -- ^ List of values to write-          -> Builder       -- ^ Resulting 'Builder'-writeList 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 writeList #-}---- | Construct a 'Builder' from a single byte.----singleton :: Word8    -- ^ Byte to create a 'Builder' from-          -> Builder  -- ^ Resulting 'Builder'-singleton = writeSingleton writeByte---- | /O(n)./ A Builder taking a 'S.ByteString`, copying it.----fromByteString :: S.ByteString  -- ^ Strict 'S.ByteString' to copy-               -> Builder       -- ^ Resulting 'Builder'-fromByteString = writeSingleton writeByteString-{-# INLINE fromByteString #-}---- | Copied from Data.ByteString.Lazy.----defaultSize :: Int-defaultSize = 32 * k - overhead-    where k = 1024-          overhead = 2 * sizeOf (undefined :: Int)---- | Run the builder with the default buffer size.----runBuilder :: Builder -> [S.ByteString] -> [S.ByteString]-runBuilder = runBuilderWith defaultSize-{-# INLINE runBuilder #-}---- | Run the builder with buffers of at least the given size.------ Note that the builders should guarantee that on average the desired buffer--- size is attained almost perfectly. "Almost" because 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.----runBuilderWith :: Int -> Builder -> [S.ByteString] -> [S.ByteString]-runBuilderWith bufSize (Builder b) k = -    S.inlinePerformIO $ go bufSize (b finalStep)-  where-    finalStep pf _ = return $ Done pf--    go !size !step = do-        buf <- S.mallocByteString size-        withForeignPtr buf $ \pf -> do-            next <- step pf (pf `plusPtr` size)-            case next of-                Done pf'-                  | pf == pf' -> return k-                  | otherwise -> return $ S.PS buf 0 (pf' `minusPtr` pf) : k -                BufferFull newSize pf' nextStep-                  | pf == pf' -> bufferFullError-                  | otherwise -> return $ S.PS buf 0 (pf' `minusPtr` pf) : -                       S.inlinePerformIO (go (max newSize bufSize) nextStep)--    bufferFullError =-        error "runBuilder: buffer cannot be full; no data was written."---- | /O(n)./ Extract the lazy 'L.ByteString' from the builder.----toLazyByteString :: Builder       -- ^ 'Builder' to evaluate-                 -> L.ByteString  -- ^ Resulting UTF-8 encoded 'L.ByteString'-toLazyByteString = L.fromChunks . flip runBuilder []-{-# INLINE toLazyByteString #-}

@@ -1,55 +0,0 @@--- | A module that extends the builder monoid from BlazeHtml with function to--- insert HTML, including HTML escaping and the like.----{-# LANGUAGE OverloadedStrings #-}-module Text.Blaze.Builder.Html-    ( -      -- * Custom writes to the builder-      writeHtmlEscapedChar--      -- * Creating builders-    , fromHtmlEscapedChar-    , fromHtmlEscapedString-    , fromHtmlEscapedText-    ) where--import Data.ByteString.Char8 ()-import Data.Monoid (mempty, mappend)--import Data.Text (Text)-import qualified Data.Text as T--import Text.Blaze.Builder.Core-import Text.Blaze.Builder.Utf8---- | Write an unicode character to a 'Builder', doing HTML escaping.----writeHtmlEscapedChar :: Char   -- ^ Character to write-                     -> Write  -- ^ Resulting write-writeHtmlEscapedChar '<'  = writeByteString "&lt;"-writeHtmlEscapedChar '>'  = writeByteString "&gt;"-writeHtmlEscapedChar '&'  = writeByteString "&amp;"-writeHtmlEscapedChar '"'  = writeByteString "&quot;"-writeHtmlEscapedChar '\'' = writeByteString "&apos;"-writeHtmlEscapedChar c    = writeChar c-{-# INLINE writeHtmlEscapedChar #-}---- | A HTML escaped 'Char'.----fromHtmlEscapedChar :: Char     -- ^ Character to write-                    -> Builder  -- ^ Resulting 'Builder'-fromHtmlEscapedChar = writeSingleton writeHtmlEscapedChar---- | A HTML escaped 'String'.----fromHtmlEscapedString :: String   -- ^ String to create a 'Builder' from-                      -> Builder  -- ^ Resulting 'Builder'-fromHtmlEscapedString = writeList writeHtmlEscapedChar---- | An HTML escaped piece of 'Text'.----fromHtmlEscapedText :: Text     -- ^ 'Text' to insert-                    -> Builder  -- ^ Resulting 'Builder'-fromHtmlEscapedText = writeSingleton (T.foldl appendChar mempty)-  where-    appendChar w c = w `mappend` writeHtmlEscapedChar c

@@ -1,91 +0,0 @@--- | A module that extends the builder monoid from BlazeHtml with a number of--- functions to insert unicode as UTF-8.----module Text.Blaze.Builder.Utf8-    ( -      -- * Custom writes to the builder-      writeChar--      -- * Creating builders-    , fromChar-    , fromString-    , fromText-    ) where--import Foreign-import Data.Char (ord)-import Data.Monoid (mempty, mappend)--import Data.Text (Text)-import qualified Data.Text as T--import Text.Blaze.Builder.Core---- | Write a Unicode character, encoding it as UTF-8.----writeChar :: Char   -- ^ Character to write-          -> Write  -- ^ Resulting write-writeChar = encodeCharUtf8 f1 f2 f3 f4-  where-    f1 x = Write 1 $ \ptr -> poke ptr x--    f2 x1 x2 = Write 2 $ \ptr -> do poke ptr x1-                                    poke (ptr `plusPtr` 1) x2--    f3 x1 x2 x3 = Write 3 $ \ptr -> do poke ptr x1-                                       poke (ptr `plusPtr` 1) x2-                                       poke (ptr `plusPtr` 2) x3--    f4 x1 x2 x3 x4 = Write 4 $ \ptr -> do poke ptr x1-                                          poke (ptr `plusPtr` 1) x2-                                          poke (ptr `plusPtr` 2) x3-                                          poke (ptr `plusPtr` 3) x4-{-# INLINE writeChar #-}---- | Encode a Unicode character to another datatype, using UTF-8. This function--- acts as an abstract way of encoding characters, as it is unaware of what--- needs to happen with the resulting bytes: you have to specify functions to--- deal with those.----encodeCharUtf8 :: (Word8 -> a)                             -- ^ 1-byte UTF-8-               -> (Word8 -> Word8 -> a)                    -- ^ 2-byte UTF-8-               -> (Word8 -> Word8 -> Word8 -> a)           -- ^ 3-byte UTF-8-               -> (Word8 -> Word8 -> Word8 -> Word8 -> a)  -- ^ 4-byte UTF-8-               -> Char                                     -- ^ Input 'Char'-               -> a                                        -- ^ Result-encodeCharUtf8 f1 f2 f3 f4 c = case ord c of-    x | x <= 0x7F -> f1 $ fromIntegral x-      | x <= 0x07FF ->-           let x1 = fromIntegral $ (x `shiftR` 6) + 0xC0-               x2 = fromIntegral $ (x .&. 0x3F)   + 0x80-           in f2 x1 x2-      | x <= 0xFFFF ->-           let x1 = fromIntegral $ (x `shiftR` 12) + 0xE0-               x2 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80-               x3 = fromIntegral $ (x .&. 0x3F) + 0x80-           in f3 x1 x2 x3-      | otherwise ->-           let x1 = fromIntegral $ (x `shiftR` 18) + 0xF0-               x2 = fromIntegral $ ((x `shiftR` 12) .&. 0x3F) + 0x80-               x3 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80-               x4 = fromIntegral $ (x .&. 0x3F) + 0x80-           in f4 x1 x2 x3 x4-{-# INLINE encodeCharUtf8 #-}---- | An unescaped, utf8 encoded character.----fromChar :: Char     -- ^ 'Char' to insert-         -> Builder  -- ^ Resulting 'Builder'-fromChar = writeSingleton writeChar---- | A list of unescaped, utf8 encoded characters.----fromString :: String   -- ^ 'String' to insert-           -> Builder  -- ^ Resulting 'Builder'-fromString = writeList writeChar---- | Create an UTF-8 encoded 'Builder' from some 'Text'.----fromText :: Text     -- ^ 'Text' to insert-         -> Builder  -- ^ Resulting 'Builder'-fromText = writeSingleton (T.foldl (\w c -> w `mappend` writeChar c) mempty)

@@ -0,0 +1,239 @@+-----------------------------------------------------------------------------+-- |+-- Module      : BenchThroughput+-- Copyright   : Simon Meier+-- License     : BSD3-style (see LICENSE)+-- +-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : GHC+--+-- This benchmark is based on 'tests/Benchmark.hs' from the 'binary-0.5.0.2'+-- package.+--+-- Benchmark the throughput of 'blaze-builder' and 'binary' for serializing+-- sequences of 'Word8' .. 'Word64' values in little-endian, big-endian, and+-- "host-endian" formats.+--+-- The results on a Core2 Duo T7500 with Linux 2.6.32-24 i686 and GHC 6.12.3+-- are as follows:+--+--   Using the Blaze.Builder directly (i.e. not encapsulated in a writer monad+--   as Put is doing it) gives the best scalability. Up to 'Word32', it holds+--   that the bigger the chunk size, the bigger the relative speedup of using+--   the Blaze.Builder. For 'Word64', the speedup is not as impressive.+--   Probably due to the more expensive writes.+--+-----------------------------------------------------------------------------++module BenchThroughput (main) where++import qualified Throughput.BinaryBuilder as BinaryBuilder+import qualified Throughput.BinaryPut     as BinaryPut+import qualified Throughput.BinaryBuilderDeclarative as BinaryBuilderDecl++import qualified Throughput.BlazeBuilder as BlazeBuilder+import qualified Throughput.BlazePut     as BlazePut+import qualified Throughput.BlazeBuilderDeclarative as BlazeBuilderDecl++import Throughput.Utils+import Throughput.Memory++import qualified Data.ByteString.Lazy as L+import Debug.Trace+import Data.Binary+import Data.Binary.Put+import Data.Binary.Get++import Control.Exception+import Control.Monad+import System.CPUTime+import Numeric+import Text.Printf+import System.Environment+import System.IO++import Data.Maybe+import Data.Accessor+import Data.Colour+import Data.Colour.Names+import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Gtk+++-- The different serialization functions+----------------------------------------++supportAllSizes f wS cS e i = return $ f wS cS e i++blazeLineStyle = solidLine 1 . opaque+binaryLineStyle = dashedLine 1 [5, 5] . opaque++blazeBuilder      = +  ( "BlazeBuilder"+  , blazeLineStyle green+  , supportAllSizes $ BlazeBuilder.serialize)++blazeBuilderDecl  = +  ( "BlazeBuilderDecl"+  , blazeLineStyle blue+  , supportAllSizes $ BlazeBuilderDecl.serialize)++blazePut          = +  ( "BlazePut"+  , blazeLineStyle red+  , supportAllSizes $ BlazePut.serialize)++binaryBuilder     = +  ( "BinaryBuilder"+  , binaryLineStyle green+  , supportAllSizes $ BinaryBuilder.serialize)++binaryBuilderDecl = +  ( "BinaryBuilderDecl"+  , binaryLineStyle blue+  , BinaryBuilderDecl.serialize)++binaryPut  = +  ( "BinaryPut"+  , binaryLineStyle red+  , supportAllSizes $ BinaryPut.serialize)+++main :: IO ()+main = do+  mb <- getArgs >>= readIO . head+  -- memBench (mb*10) +  putStrLn ""+  putStrLn "Binary serialisation benchmarks:"++  -- do bytewise +  -- sequence_+    -- [ test wordSize chunkSize Host mb+    -- | wordSize  <- [1]+    -- , chunkSize <- [1,2,4,8,16]+    -- ]++  -- now Word16 .. Word64+  let lift f wS cS e i = return $ f wS cS e i+      serializers = +        [ blazeBuilder , blazeBuilderDecl , blazePut+        , binaryBuilder, binaryBuilderDecl, binaryPut+        ]+      wordSizes  = [1,2,4,8]+      chunkSizes = [1,2,4,8,16] +      endians    = [Host,Big,Little]++  let compares = +        [ compareResults serialize wordSize chunkSize end mb+        | wordSize  <- wordSizes+        , chunkSize <- chunkSizes+        , end       <- endians+        , serialize <- serializers+        , wordSize /= 1 || end == Host -- no endianess for Word8+        ]+  -- putStrLn "checking equality of serialization results:"+  -- sequence_ compares+++  let serializes = +        [  [ ( serialize+             , [ (chunkSize, test serialize wordSize chunkSize end mb)+               | chunkSize <- [1,2,4,8,16]+               ]+             )+           | serialize <- serializers+           ]+        | wordSize  <- [1,2,4,8]+        , end       <- [Host,Big,Little]+        , wordSize /= 1 || end == Host -- no endianess for Word8+        ]+++  putStrLn "\n\nbenchmarking serialization speed:"+  results <- mapM mkChart serializes+  print results++mkChart :: [((String,CairoLineStyle,a), [(Int, IO (Maybe Double))])] -> IO ()+mkChart task = do+  lines <- catMaybes `liftM` mapM measureSerializer task+  let plottedLines = flip map lines $ \ ((name,lineStyle,_), points) ->+          plot_lines_title ^= name $+          plot_lines_style ^= lineStyle $+          plot_lines_values ^= [points] $ +          defaultPlotLines+  let layout = +        defaultLayout1+          { layout1_plots_ = map (Right . toPlot) plottedLines }+  -- renderableToWindow (toRenderable layout) 640 480  +++measureSerializer :: (a, [(Int, IO (Maybe Double))]) -> IO (Maybe (a, [(Int,Double)]))+measureSerializer (info, tests) = do+  optPoints <- forM tests $ \ (x, test) -> do+    optY <- test+    case optY of +      Nothing -> return Nothing+      Just y  -> return $ Just (x, y)+  case catMaybes optPoints of+    []     -> return Nothing+    points -> return $ Just (info, points)++------------------------------------------------------------------------++time :: IO a -> IO Double+time action = do+    start <- getCPUTime+    action+    end   <- getCPUTime+    return $! (fromIntegral (end - start)) / (10^12)++------------------------------------------------------------------------++test :: (String, a, Int -> Int -> Endian -> Int -> Maybe L.ByteString) +     -> Int -> Int -> Endian -> Int -> IO (Maybe Double)+test (serializeName, _, serialize) wordSize chunkSize end mb = do+    let bytes :: Int+        bytes = mb * 2^20+        iterations = bytes `div` wordSize+    case serialize wordSize chunkSize end iterations of+      Nothing -> return Nothing+      Just bs -> do+        _ <- printf "%17s: %dMB of Word%-2d in chunks of %2d (%6s endian):"+            serializeName (mb :: Int) (8 * wordSize :: Int) (chunkSize :: Int) (show end)++        putSeconds <- time $ evaluate (L.length bs)+        -- getSeconds <- time $ evaluate sum+    --    print (L.length bs, sum)+        let putThroughput = fromIntegral mb / putSeconds+            -- getThroughput = fromIntegral mb / getSeconds++        _ <- printf "%6.1f MB/s write\n"+               putThroughput+               -- getThroughput+               -- (getThroughput/putThroughput)+     +        hFlush stdout+        return $ Just putThroughput++------------------------------------------------------------------------++compareResults :: (String, a, Int -> Int -> Endian -> Int -> Maybe L.ByteString) +     -> Int -> Int -> Endian -> Int -> IO ()+compareResults (serializeName, _, serialize) wordSize chunkSize end mb0 = do+    let mb :: Int+        mb = max 1 (mb0 `div` 100)+        bytes :: Int+        bytes = mb * 2^20+        iterations = bytes `div` wordSize+        bs0 = BinaryBuilder.serialize wordSize chunkSize end iterations+    case serialize wordSize chunkSize end iterations of+      Nothing -> return ()+      Just bs1 -> do+        _ <- printf "%17s: %dMB of Word%-2d in chunks of %2d (%6s endian):"+          serializeName (mb :: Int) (8 * wordSize :: Int) (chunkSize :: Int) (show end)+        if (bs0 == bs1) +          then putStrLn " Ok"+          else putStrLn " Failed"+        hFlush stdout+      

@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : BlazeVsBinary+-- Copyright   : (c) 2010 Jasper Van der Jeught & Simon Meier+-- License     : BSD3-style (see LICENSE)+-- +-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : tested on GHC only+--+-- A comparison between 'blaze-builder' and the Data.Binary.Builder from+-- 'binary'. The goal is to measure the performance on serializing dynamic+-- data referenced by a list.+--+-- Note that some of the benchmarks are a bit unfair with respect to+-- blaze-builder, as it does more than 'binary':+--+--   1. It encodes chars as utf-8 strings and does not just truncate character+--      value to one byte.+--+--   2. It copies the contents of the lazy bytestring chunks if they are+--      shorter than 4kb. This ensures efficient processing of the resulting+--      lazy bytestring. 'binary' just inserts the chunks directly in the+--      resulting output stream.+--+module BlazeVsBinary where++import Data.Char (ord)+import Data.Monoid (mconcat)+import Data.Word (Word8)++import qualified Data.Binary.Builder as Binary+import Criterion.Main+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as S+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)++import qualified Blaze.ByteString.Builder           as Blaze+import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze++main :: IO ()+main = defaultMain $ concat+    [ benchmark "[String]"+        (mconcat . concatMap (map $ Binary.singleton .  fromIntegral . ord))+        (mconcat . map Blaze.fromString)+        strings+    , benchmark "L.ByteString"+        (Binary.fromLazyByteString)+        (Blaze.fromLazyByteString)+        byteStrings+    , benchmark "[Text]"+        (mconcat . map (Binary.fromByteString . encodeUtf8))+        (mconcat . map Blaze.fromText)+        texts+    , benchmark "[Word8]"+        (mconcat . map Binary.singleton)+        (Blaze.fromWord8s)+        word8s+    ]+  where+    benchmark name binaryF blazeF x =+        [ bench (name ++ " (Data.Binary builder)") $+            whnf (L.length . Binary.toLazyByteString . binaryF) x+        , bench (name ++ " (blaze builder)") $+            whnf (L.length . Blaze.toLazyByteString . blazeF) x+        ]++strings :: [String]+strings = replicate 10000 "<img>"+{-# NOINLINE strings #-}++byteStrings :: L.ByteString+byteStrings = L.fromChunks $ replicate 10000 "<img>"+{-# NOINLINE byteStrings #-}++texts :: [Text]+texts = replicate 10000 "<img>"+{-# NOINLINE texts #-}++word8s :: [Word8]+word8s = replicate 10000 $ fromIntegral $ ord 'a'+{-# NOINLINE word8s #-}

@@ -0,0 +1,158 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : ChunkedWrite+-- Copyright   : (c) 2010 Simon Meier+-- License     : BSD3-style (see LICENSE)+-- +-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : tested on GHC only+--+-- Test different strategies for writing lists of simple values:+--+--  1. Using 'mconcat . map from<Value>'+--+--  2. Using the specialized 'fromWrite<n>List' function where 'n' denotes+--     the number of elements to write at the same time. Writing chunks of+--     elements reduces the overhead from the buffer overflow test that has+--     to be done before every write.+--+module ChunkedWrite where++import Data.Char (chr)+import Data.Int (Int64)+import Data.Word (Word8, Word32)+import Data.Monoid++import Criterion.Main+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as S++import qualified Blaze.ByteString.Builder           as BB+import qualified Blaze.ByteString.Builder.Char.Utf8 as BB++main :: IO ()+main = defaultMain +    [ bench "S.pack: [Word8] -> S.ByteString" $ +        whnf (S.pack) word8s++    , bench "toByteString . fromWord8s: [Word8] -> Builder -> S.ByteString" $ +        whnf (BB.toByteString . BB.fromWord8s) word8s++    , bench "L.pack: [Word8] -> L.ByteString" $ +        whnf (L.length . L.pack) word8s++    , bench "mconcat . map fromByte: [Word8] -> Builder -> L.ByteString" $ +        whnf benchMConcatWord8s word8s+    , bench "fromWrite1List: [Word8] -> Builder -> L.ByteString" $ +        whnf bench1Word8s word8s+    , bench "fromWrite2List: [Word8] -> Builder -> L.ByteString" $ +        whnf bench2Word8s word8s+    , bench "fromWrite4List: [Word8] -> Builder -> L.ByteString" $ +        whnf bench4Word8s word8s+    , bench "fromWrite8List: [Word8] -> Builder -> L.ByteString" $ +        whnf bench8Word8s word8s+    , bench "fromWrite16List: [Word8] -> Builder -> L.ByteString" $ +        whnf bench16Word8s word8s++    , bench "mconcat . map fromByte: [Char] -> Builder -> L.ByteString" $ +        whnf benchMConcatChars chars+    , bench "fromWrite1List: [Char] -> Builder -> L.ByteString" $ +        whnf bench1Chars chars+    , bench "fromWrite2List: [Char] -> Builder -> L.ByteString" $ +        whnf bench2Chars chars+    , bench "fromWrite4List: [Char] -> Builder -> L.ByteString" $ +        whnf bench4Chars chars+    , bench "fromWrite8List: [Char] -> Builder -> L.ByteString" $ +        whnf bench8Chars chars+    , bench "fromWrite16List: [Char] -> Builder -> L.ByteString" $ +        whnf bench16Chars chars++    , bench "mconcat . map fromWord32host: [Word32] -> Builder -> L.ByteString" $ +        whnf benchMConcatWord32s word32s+    , bench "fromWrite1List: [Word32] -> Builder -> L.ByteString" $ +        whnf bench1Word32s word32s+    , bench "fromWrite2List: [Word32] -> Builder -> L.ByteString" $ +        whnf bench2Word32s word32s+    , bench "fromWrite4List: [Word32] -> Builder -> L.ByteString" $ +        whnf bench4Word32s word32s+    , bench "fromWrite8List: [Word32] -> Builder -> L.ByteString" $ +        whnf bench8Word32s word32s+    , bench "fromWrite16List: [Word32] -> Builder -> L.ByteString" $ +        whnf bench16Word32s word32s+    ]+  where+    n = 100000++    word8s :: [Word8]+    word8s = take n $ map fromIntegral $ [(1::Int)..]+    {-# NOINLINE word8s #-}++    word32s :: [Word32]+    word32s = take n $ [1..]+    {-# NOINLINE word32s #-}++    chars :: String+    chars = take n $ map (chr . fromIntegral) $ word8s+    {-# NOINLINE chars #-}++-- Char++benchMConcatChars :: [Char] -> Int64+benchMConcatChars = L.length . BB.toLazyByteString . mconcat . map BB.fromChar++bench1Chars :: [Char] -> Int64+bench1Chars = L.length . BB.toLazyByteString . BB.fromWrite1List BB.writeChar++bench2Chars :: [Char] -> Int64+bench2Chars = L.length . BB.toLazyByteString . BB.fromWrite2List BB.writeChar++bench4Chars :: [Char] -> Int64+bench4Chars = L.length . BB.toLazyByteString . BB.fromWrite4List BB.writeChar++bench8Chars :: [Char] -> Int64+bench8Chars = L.length . BB.toLazyByteString . BB.fromWrite8List BB.writeChar++bench16Chars :: [Char] -> Int64+bench16Chars = L.length . BB.toLazyByteString . BB.fromWrite16List BB.writeChar++-- Word8++benchMConcatWord8s :: [Word8] -> Int64+benchMConcatWord8s = L.length . BB.toLazyByteString . mconcat . map BB.fromWord8++bench1Word8s :: [Word8] -> Int64+bench1Word8s = L.length . BB.toLazyByteString . BB.fromWrite1List BB.writeWord8++bench2Word8s :: [Word8] -> Int64+bench2Word8s = L.length . BB.toLazyByteString . BB.fromWrite2List BB.writeWord8++bench4Word8s :: [Word8] -> Int64+bench4Word8s = L.length . BB.toLazyByteString . BB.fromWrite4List BB.writeWord8++bench8Word8s :: [Word8] -> Int64+bench8Word8s = L.length . BB.toLazyByteString . BB.fromWrite8List BB.writeWord8++bench16Word8s :: [Word8] -> Int64+bench16Word8s = L.length . BB.toLazyByteString . BB.fromWrite16List BB.writeWord8++-- Word32++benchMConcatWord32s :: [Word32] -> Int64+benchMConcatWord32s = L.length . BB.toLazyByteString . mconcat . map BB.fromWord32host++bench1Word32s :: [Word32] -> Int64+bench1Word32s = L.length . BB.toLazyByteString . BB.fromWrite1List BB.writeWord32host++bench2Word32s :: [Word32] -> Int64+bench2Word32s = L.length . BB.toLazyByteString . BB.fromWrite2List BB.writeWord32host++bench4Word32s :: [Word32] -> Int64+bench4Word32s = L.length . BB.toLazyByteString . BB.fromWrite4List BB.writeWord32host++bench8Word32s :: [Word32] -> Int64+bench8Word32s = L.length . BB.toLazyByteString . BB.fromWrite8List BB.writeWord32host++bench16Word32s :: [Word32] -> Int64+bench16Word32s = L.length . BB.toLazyByteString . BB.fromWrite16List BB.writeWord32host+

@@ -0,0 +1,55 @@+-- |+-- Module      : Compression+-- Copyright   : (c) 2010 Simon Meier+-- License     : BSD3-style (see LICENSE)+-- +-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : tested on GHC only+--+-- Benchmark the effect of first compacting the input stream for the 'zlib'+-- compression package.+--+-- On a Core2 Duo T7500 with Linux 2.6.32-24 i686 and GHC 6.12.3 compacting+-- first is worth its price up to chunks of 2kb size. Hence, in most+-- serialization scenarios it is better to first use a builder and only then+-- compress the output.+--+module Compression where++import Data.Int+import Data.Monoid (mconcat, mappend)++import Criterion.Main+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Char8 as S++import qualified Blaze.ByteString.Builder as B+import Codec.Compression.GZip++main = defaultMain +    [ bench "compress directly (chunksize 10)" $+        whnf benchCompressDirectly byteString10+    , bench "compress compacted (chunksize 10)" $+        whnf benchCompressCompacted byteString10+    , bench "compress directly (chunksize 2kb)" $+        whnf benchCompressDirectly byteString2kb+    , bench "compress compacted (chunksize 2kb)" $+        whnf benchCompressCompacted byteString2kb+    ]+  where+    n = 100000++    byteString10 = L.fromChunks $ replicate n $ S.pack $ take 10 ['\x0'..]+    {-# NOINLINE byteString10 #-}++    byteString2kb = L.fromChunks $ replicate (n `div` 200) $ S.pack $ take 2048 ['\x0'..]+    {-# NOINLINE byteString2kb #-}+++benchCompressDirectly :: L.ByteString -> Int64+benchCompressDirectly = L.length . compress++benchCompressCompacted :: L.ByteString -> Int64+benchCompressCompacted = +  L.length . compress . B.toLazyByteString . B.fromLazyByteString

@@ -0,0 +1,218 @@+-----------------------------------------------------------------------------+-- |+-- Module      : PlotTest+-- Copyright   : Simon Meier+-- License     : BSD3-style (see LICENSE)+-- +-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : GHC+--+-- Test plotting for the benchmarks.+-- package.+--+-----------------------------------------------------------------------------++module PlotTest where++import Prelude hiding (lines)++import Data.List (unfoldr)+import Data.Word (Word8)++import Data.Maybe+import Data.Accessor+import Data.Colour+import Data.Colour.Names++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Grid+import Graphics.Rendering.Chart.Gtk++import Criterion+import Criterion.Environment+import Criterion.Monad+import Criterion.Types+import Criterion.Config++import Control.Monad+import Control.Monad.Trans+import Control.Monad.Trans.Reader++import Statistics.Types++import qualified System.Random as R++-- Plots to be generated+------------------------++{-++Compression:+  1 plot (title "compressing <n> MB of random data using 'zlib')+    3 lines (direct, compacted using a Builder, compaction time) [chunk size/ms]+++ChunkedWrite:+  1 plot (title "serializing a list of <n> elements")+    1 line per type of element [chunk size/ms]+++Throughput:+  5 x 3 plots (word type x endianness) (title "<n> MB of <type> (<endianness>)")+    1 line per type of Word [chunk size/ MB/s]++-}++-- | A pseudo-random stream of 'Word8' always started from the same initial+-- seed.+randomWord8s :: [Word8]+randomWord8s = map fromIntegral $ unfoldr (Just . R.next) (R.mkStdGen 666) ++-- Main function+----------------++main :: IO ()+main = undefined+++-- Benchmarking Infrastructure+------------------------------++type MyCriterion a = ReaderT Environment Criterion a++-- | Run a list of benchmarks; flattening benchmark groups to a path of strings.+runFlattenedBenchmarks :: [Benchmark] -> MyCriterion [([String],Sample)]+runFlattenedBenchmarks = +    (concat `liftM`) . mapM (go id)+  where+    go path (Benchmark name b)   = do+      env <- ask+      sample <- lift $ runBenchmark env b+      return [(path [name], sample)]+    go path (BenchGroup name bs) = +      concat `liftM` mapM (go (path . (name:))) bs++-- | Run a benchmark for a series of data points; e.g. to measure scalability+-- properties.+runSeriesBenchmark :: (a -> Benchmark) -> [a] -> MyCriterion [(a,Sample)]+runSeriesBenchmark mkBench xs =+    (zip xs . map snd) `liftM` runFlattenedBenchmarks (map mkBench xs)+++-- | Use the given config to measure the environment and then run the embedded+-- criterion operation with this information about the environment.+runMyCriterion :: Config -> MyCriterion a -> IO a+runMyCriterion config criterion = do+    env <- withConfig config measureEnvironment+    withConfig config (runReaderT criterion env)+    +++-- Plotting Infrastructure+--------------------------++colorPalette :: [Colour Double]+colorPalette = [blue, green, red, yellow, magenta, cyan]++lineStylePalette :: [CairoLineStyle]+lineStylePalette = +    map (solidLine 1 . opaque)         colorPalette +++    map (dashedLine 1 [5, 5] . opaque) colorPalette++-- | > ((title, xName, yName), [(lineName,[(x,y)])])+type PlotData = ((String, String, String), [(String, [(Int, Double)])])++layoutPlot :: PlotData -> Layout1 Int Double+layoutPlot ((title, xName, yName), lines) =+    layout1_plots ^= map (Right . toPlot) plots $ +    layout1_title ^= title $+    layout1_bottom_axis ^= mkLinearAxis xName $+    layout1_right_axis ^= mkLogAxis yName $+    defaultLayout1+  where+    (linesName, linesData) = unzip lines+    plots = zipWith3 plotLine linesName (cycle lineStylePalette) linesData++-- | Plot a single named line using the given line style.+plotLine :: String -> CairoLineStyle -> [(Int,Double)] -> PlotLines Int Double+plotLine name style points = +    plot_lines_title ^= name $+    plot_lines_style ^= style $+    plot_lines_values ^= [points] $ +    defaultPlotLines++mkLinearAxis :: String -> LayoutAxis Int+mkLinearAxis name = laxis_title ^= name $ defaultLayoutAxis++mkLogAxis :: String -> LayoutAxis Double+mkLogAxis name = +  laxis_title ^= name $ +  laxis_generate ^= autoScaledLogAxis defaultLogAxis $+  defaultLayoutAxis+++++{-+-- Plot Experiments+-------------------+++testData :: [(Int,Double)]+testData = zip xs (map (fromIntegral . (^2)) xs)+  where xs = [1,2,4,8,16,32]+++blazeLineStyle = solidLine 1 . opaque+binaryLineStyle = dashedLine 1 [5, 5] . opaque+++plots :: [PlotLines Int Double]+plots = [ plotLine [c] style testData +        | (c, style) <- zip ['a'..] (cycle lineStylePalette) ]+++mkLayout xname yname title p = +    layout1_plots ^= [Right p] $ +    layout1_title ^= title $+    layout1_bottom_axis ^= mkLinearAxis xname $+    layout1_right_axis ^= mkLogAxis yname $+    defaultLayout1++layouts = zipWith (mkLayout "chunksize" "MB/s") (map return ['A'..]) (map toPlot plots)++testGrid = aboveN $ map (besideN . map (flip tspan (1,1) . toRenderable)) [l1,l2]+  where+  (l1,l2) = splitAt 3 layouts++testIt = renderableToWindow (gridToRenderable testGrid) 640 480+-}++{-+mkChart :: [((String,CairoLineStyle,a), [(Int, IO (Maybe Double))])] -> IO ()+mkChart task = do+  lines <- catMaybes `liftM` mapM measureSerializer task+  let plottedLines = flip map lines $ \ ((name,lineStyle,_), points) ->+          plot_lines_title ^= name $+          plot_lines_style ^= lineStyle $+          plot_lines_values ^= [points] $ +          defaultPlotLines+  let layout = +        defaultLayout1+          { layout1_plots_ = map (Right . toPlot) plottedLines }+  renderableToWindow (toRenderable layout) 640 480  +++measureSerializer :: (a, [(Int, IO (Maybe Double))]) -> IO (Maybe (a, [(Int,Double)]))+measureSerializer (info, tests) = do+  optPoints <- forM tests $ \ (x, test) -> do+    optY <- test+    case optY of +      Nothing -> return Nothing+      Just y  -> return $ Just (x, y)+  case catMaybes optPoints of+    []     -> return Nothing+    points -> return $ Just (info, points)++-}

@@ -0,0 +1,125 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : StringAndText+-- Copyright   : (c) 2010 Simon Meier+-- License     : BSD3-style (see LICENSE)+-- +-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : tested on GHC only+--+-- Benchmarking of String and Text serialization.+module StringAndText (main)  where++import Data.Char (ord)+import Data.Monoid ++import Criterion.Main++import Foreign (plusPtr)+import qualified Data.ByteString      as S+import qualified Data.ByteString.Lazy as L+import qualified Data.Text               as TS+import qualified Data.Text.Encoding      as TS+import qualified Data.Text.Lazy          as TL+import qualified Data.Text.Lazy.Encoding as TL++import qualified Blaze.ByteString.Builder           as Blaze+import qualified Blaze.ByteString.Builder.Internal  as Blaze+import qualified Blaze.ByteString.Builder.Html.Utf8 as Blaze++main :: IO ()+main = defaultMain +    [ bench "TL.unpack :: LazyText -> String" $ nf+        TL.unpack benchLazyText++    , bench "TL.foldr  :: LazyText -> String" $ nf+        (TL.foldr (:) []) benchLazyText+    +    , bench "fromString :: String --[Utf8 encoding]--> L.ByteString" $ whnf+        (L.length . Blaze.toLazyByteString . Blaze.fromString) benchString++    , bench "fromStrictTextUnpacked :: StrictText --[Utf8 encoding]--> L.ByteString" $ whnf+        (L.length . Blaze.toLazyByteString . Blaze.fromText) benchStrictText+     +    , bench "fromStrictTextFolded :: StrictText --[Utf8 encoding]--> L.ByteString" $ whnf+        (L.length . Blaze.toLazyByteString . fromStrictTextFolded) benchStrictText++    , bench "TS.encodeUtf8 :: StrictText --[Utf8 encoding]--> S.ByteString" $ whnf+        (TS.encodeUtf8) benchStrictText++    , bench "fromLazyTextUnpacked :: LazyText --[Utf8 encoding]--> L.ByteString" $ whnf+        (L.length . Blaze.toLazyByteString . Blaze.fromLazyText) benchLazyText++    , bench "fromLazyTextFolded :: LazyText --[Utf8 encoding]--> L.ByteString" $ whnf+        (L.length . Blaze.toLazyByteString . fromLazyTextFolded) benchLazyText++    , bench "TL.encodeUtf8 :: LazyText --[Utf8 encoding]--> L.ByteString" $ whnf+        (L.length . TL.encodeUtf8) benchLazyText++    , bench "fromHtmlEscapedString :: String --[Html esc. & Utf8 encoding]--> L.ByteString" $ whnf+        (L.length . Blaze.toLazyByteString . Blaze.fromHtmlEscapedString) benchString++    , bench "fromHtmlEscapedStrictTextUnpacked :: StrictText --[HTML esc. & Utf8 encoding]--> L.ByteString" $ whnf+        (L.length . Blaze.toLazyByteString . Blaze.fromHtmlEscapedText) benchStrictText+     +    , bench "fromHtmlEscapedLazyTextUnpacked :: LazyText --[HTML esc. & Utf8 encoding]--> L.ByteString" $ whnf+        (L.length . Blaze.toLazyByteString . Blaze.fromHtmlEscapedLazyText) benchLazyText+     +    ]++n :: Int+n = 100000++benchString :: String+benchString = take n $ concatMap show [(1::Int)..]+{-# NOINLINE benchString #-}++benchStrictText :: TS.Text+benchStrictText = TS.pack benchString+{-# NOINLINE benchStrictText #-}++benchLazyText :: TL.Text+benchLazyText = TL.pack benchString+{-# NOINLINE benchLazyText #-}+++-- | Encode the 'TS.Text' as UTF-8 by folding it and filling the raw buffer+-- directly.+fromStrictTextFolded :: TS.Text -> Blaze.Builder+fromStrictTextFolded t = Blaze.Builder $ \k -> TS.foldr step k t+  where+    step c k pf pe+      | pf' <= pe = do+          io pf+          k pf' pe  -- here it would be great, if we wouldn't have to pass+                    -- around pe: requires a more powerful fold for StrictText.+      | otherwise =+          return $ Blaze.BufferFull size pf $ \pfNew peNew -> do+            let pfNew' = pfNew `plusPtr` size+            io pfNew+            k pfNew' peNew+      where+        pf' = pf `plusPtr` size+        Blaze.Write size io = Blaze.writeChar c+{-# INLINE fromStrictTextFolded #-}++-- | Encode the 'TL.Text' as UTF-8 by folding it and filling the raw buffer+-- directly.+fromLazyTextFolded :: TL.Text -> Blaze.Builder+fromLazyTextFolded t = Blaze.Builder $ \k -> TL.foldr step k t+  where+    step c k pf pe+      | pf' <= pe = do+          io pf+          k pf' pe  -- here it would be great, if we wouldn't have to pass+                    -- around pe: requires a more powerful fold for StrictText.+      | otherwise =+          return $ Blaze.BufferFull size pf $ \pfNew peNew -> do+            let pfNew' = pfNew `plusPtr` size+            io pfNew+            k pfNew' peNew+      where+        pf' = pf `plusPtr` size+        Blaze.Write size io = Blaze.writeChar c+{-# INLINE fromLazyTextFolded #-}

@@ -0,0 +1,697 @@+{-# LANGUAGE BangPatterns #-}+module Throughput.BinaryBuilder (serialize) where++import Data.Monoid+import qualified Data.ByteString.Lazy as L+import Data.Binary.Builder++import Throughput.Utils++serialize :: Int -> Int -> Endian -> Int -> L.ByteString+serialize wordSize chunkSize end = toLazyByteString .+  case (wordSize, chunkSize, end) of+    (1, 1,_)   -> writeByteN1+    (1, 2,_)   -> writeByteN2+    (1, 4,_)   -> writeByteN4+    (1, 8,_)   -> writeByteN8+    (1, 16, _) -> writeByteN16++    (2, 1,  Big)    -> writeWord16N1Big+    (2, 2,  Big)    -> writeWord16N2Big+    (2, 4,  Big)    -> writeWord16N4Big+    (2, 8,  Big)    -> writeWord16N8Big+    (2, 16, Big)    -> writeWord16N16Big+    (2, 1,  Little) -> writeWord16N1Little+    (2, 2,  Little) -> writeWord16N2Little+    (2, 4,  Little) -> writeWord16N4Little+    (2, 8,  Little) -> writeWord16N8Little+    (2, 16, Little) -> writeWord16N16Little+    (2, 1,  Host)   -> writeWord16N1Host+    (2, 2,  Host)   -> writeWord16N2Host+    (2, 4,  Host)   -> writeWord16N4Host+    (2, 8,  Host)   -> writeWord16N8Host+    (2, 16, Host)   -> writeWord16N16Host++    (4, 1,  Big)    -> writeWord32N1Big+    (4, 2,  Big)    -> writeWord32N2Big+    (4, 4,  Big)    -> writeWord32N4Big+    (4, 8,  Big)    -> writeWord32N8Big+    (4, 16, Big)    -> writeWord32N16Big+    (4, 1,  Little) -> writeWord32N1Little+    (4, 2,  Little) -> writeWord32N2Little+    (4, 4,  Little) -> writeWord32N4Little+    (4, 8,  Little) -> writeWord32N8Little+    (4, 16, Little) -> writeWord32N16Little+    (4, 1,  Host)   -> writeWord32N1Host+    (4, 2,  Host)   -> writeWord32N2Host+    (4, 4,  Host)   -> writeWord32N4Host+    (4, 8,  Host)   -> writeWord32N8Host+    (4, 16, Host)   -> writeWord32N16Host++    (8, 1,  Host)        -> writeWord64N1Host+    (8, 2,  Host)        -> writeWord64N2Host+    (8, 4,  Host)        -> writeWord64N4Host+    (8, 8,  Host)        -> writeWord64N8Host+    (8, 16, Host)        -> writeWord64N16Host+    (8, 1,  Big)         -> writeWord64N1Big+    (8, 2,  Big)         -> writeWord64N2Big+    (8, 4,  Big)         -> writeWord64N4Big+    (8, 8,  Big)         -> writeWord64N8Big+    (8, 16, Big)         -> writeWord64N16Big+    (8, 1,  Little)      -> writeWord64N1Little+    (8, 2,  Little)      -> writeWord64N2Little+    (8, 4,  Little)      -> writeWord64N4Little+    (8, 8,  Little)      -> writeWord64N8Little+    (8, 16, Little)      -> writeWord64N16Little++------------------------------------------------------------------------++writeByteN1 bytes = loop 0 0+  where loop !s !n | n == bytes = mempty+                   | otherwise  = singleton s `mappend`+                                  loop (s+1) (n+1)++writeByteN2 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          singleton (s+0) `mappend`+          singleton (s+1)) `mappend`+          loop (s+2) (n-2)++writeByteN4 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          singleton (s+0) `mappend`+          singleton (s+1) `mappend`+          singleton (s+2) `mappend`+          singleton (s+3)) `mappend`+          loop (s+4) (n-4)++writeByteN8 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          singleton (s+0) `mappend`+          singleton (s+1) `mappend`+          singleton (s+2) `mappend`+          singleton (s+3) `mappend`+          singleton (s+4) `mappend`+          singleton (s+5) `mappend`+          singleton (s+6) `mappend`+          singleton (s+7)) `mappend`+          loop (s+8) (n-8)++writeByteN16 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          singleton (s+0) `mappend`+          singleton (s+1) `mappend`+          singleton (s+2) `mappend`+          singleton (s+3) `mappend`+          singleton (s+4) `mappend`+          singleton (s+5) `mappend`+          singleton (s+6) `mappend`+          singleton (s+7) `mappend`+          singleton (s+8) `mappend`+          singleton (s+9) `mappend`+          singleton (s+10) `mappend`+          singleton (s+11) `mappend`+          singleton (s+12) `mappend`+          singleton (s+13) `mappend`+          singleton (s+14) `mappend`+          singleton (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------+-- Big endian, word16 writes++writeWord16N1Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16be (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord16N2Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16be (s+0) `mappend`+          putWord16be (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord16N4Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16be (s+0) `mappend`+          putWord16be (s+1) `mappend`+          putWord16be (s+2) `mappend`+          putWord16be (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord16N8Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16be (s+0) `mappend`+          putWord16be (s+1) `mappend`+          putWord16be (s+2) `mappend`+          putWord16be (s+3) `mappend`+          putWord16be (s+4) `mappend`+          putWord16be (s+5) `mappend`+          putWord16be (s+6) `mappend`+          putWord16be (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord16N16Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16be (s+0) `mappend`+          putWord16be (s+1) `mappend`+          putWord16be (s+2) `mappend`+          putWord16be (s+3) `mappend`+          putWord16be (s+4) `mappend`+          putWord16be (s+5) `mappend`+          putWord16be (s+6) `mappend`+          putWord16be (s+7) `mappend`+          putWord16be (s+8) `mappend`+          putWord16be (s+9) `mappend`+          putWord16be (s+10) `mappend`+          putWord16be (s+11) `mappend`+          putWord16be (s+12) `mappend`+          putWord16be (s+13) `mappend`+          putWord16be (s+14) `mappend`+          putWord16be (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------+-- Little endian, word16 writes++writeWord16N1Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = +          (putWord16le (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord16N2Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16le (s+0) `mappend`+          putWord16le (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord16N4Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16le (s+0) `mappend`+          putWord16le (s+1) `mappend`+          putWord16le (s+2) `mappend`+          putWord16le (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord16N8Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16le (s+0) `mappend`+          putWord16le (s+1) `mappend`+          putWord16le (s+2) `mappend`+          putWord16le (s+3) `mappend`+          putWord16le (s+4) `mappend`+          putWord16le (s+5) `mappend`+          putWord16le (s+6) `mappend`+          putWord16le (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord16N16Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16le (s+0) `mappend`+          putWord16le (s+1) `mappend`+          putWord16le (s+2) `mappend`+          putWord16le (s+3) `mappend`+          putWord16le (s+4) `mappend`+          putWord16le (s+5) `mappend`+          putWord16le (s+6) `mappend`+          putWord16le (s+7) `mappend`+          putWord16le (s+8) `mappend`+          putWord16le (s+9) `mappend`+          putWord16le (s+10) `mappend`+          putWord16le (s+11) `mappend`+          putWord16le (s+12) `mappend`+          putWord16le (s+13) `mappend`+          putWord16le (s+14) `mappend`+          putWord16le (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------+-- Host endian, unaligned, word16 writes++writeWord16N1Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16host (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord16N2Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16host (s+0) `mappend`+          putWord16host (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord16N4Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16host (s+0) `mappend`+          putWord16host (s+1) `mappend`+          putWord16host (s+2) `mappend`+          putWord16host (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord16N8Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16host (s+0) `mappend`+          putWord16host (s+1) `mappend`+          putWord16host (s+2) `mappend`+          putWord16host (s+3) `mappend`+          putWord16host (s+4) `mappend`+          putWord16host (s+5) `mappend`+          putWord16host (s+6) `mappend`+          putWord16host (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord16N16Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord16host (s+0) `mappend`+          putWord16host (s+1) `mappend`+          putWord16host (s+2) `mappend`+          putWord16host (s+3) `mappend`+          putWord16host (s+4) `mappend`+          putWord16host (s+5) `mappend`+          putWord16host (s+6) `mappend`+          putWord16host (s+7) `mappend`+          putWord16host (s+8) `mappend`+          putWord16host (s+9) `mappend`+          putWord16host (s+10) `mappend`+          putWord16host (s+11) `mappend`+          putWord16host (s+12) `mappend`+          putWord16host (s+13) `mappend`+          putWord16host (s+14) `mappend`+          putWord16host (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord32N1Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32be (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord32N2Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32be (s+0) `mappend`+          putWord32be (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord32N4Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32be (s+0) `mappend`+          putWord32be (s+1) `mappend`+          putWord32be (s+2) `mappend`+          putWord32be (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord32N8Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32be (s+0) `mappend`+          putWord32be (s+1) `mappend`+          putWord32be (s+2) `mappend`+          putWord32be (s+3) `mappend`+          putWord32be (s+4) `mappend`+          putWord32be (s+5) `mappend`+          putWord32be (s+6) `mappend`+          putWord32be (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord32N16Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32be (s+0) `mappend`+          putWord32be (s+1) `mappend`+          putWord32be (s+2) `mappend`+          putWord32be (s+3) `mappend`+          putWord32be (s+4) `mappend`+          putWord32be (s+5) `mappend`+          putWord32be (s+6) `mappend`+          putWord32be (s+7) `mappend`+          putWord32be (s+8) `mappend`+          putWord32be (s+9) `mappend`+          putWord32be (s+10) `mappend`+          putWord32be (s+11) `mappend`+          putWord32be (s+12) `mappend`+          putWord32be (s+13) `mappend`+          putWord32be (s+14) `mappend`+          putWord32be (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord32N1Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32le (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord32N2Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32le (s+0) `mappend`+          putWord32le (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord32N4Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32le (s+0) `mappend`+          putWord32le (s+1) `mappend`+          putWord32le (s+2) `mappend`+          putWord32le (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord32N8Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32le (s+0) `mappend`+          putWord32le (s+1) `mappend`+          putWord32le (s+2) `mappend`+          putWord32le (s+3) `mappend`+          putWord32le (s+4) `mappend`+          putWord32le (s+5) `mappend`+          putWord32le (s+6) `mappend`+          putWord32le (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord32N16Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32le (s+0) `mappend`+          putWord32le (s+1) `mappend`+          putWord32le (s+2) `mappend`+          putWord32le (s+3) `mappend`+          putWord32le (s+4) `mappend`+          putWord32le (s+5) `mappend`+          putWord32le (s+6) `mappend`+          putWord32le (s+7) `mappend`+          putWord32le (s+8) `mappend`+          putWord32le (s+9) `mappend`+          putWord32le (s+10) `mappend`+          putWord32le (s+11) `mappend`+          putWord32le (s+12) `mappend`+          putWord32le (s+13) `mappend`+          putWord32le (s+14) `mappend`+          putWord32le (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord32N1Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32host (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord32N2Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32host (s+0) `mappend`+          putWord32host (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord32N4Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32host (s+0) `mappend`+          putWord32host (s+1) `mappend`+          putWord32host (s+2) `mappend`+          putWord32host (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord32N8Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32host (s+0) `mappend`+          putWord32host (s+1) `mappend`+          putWord32host (s+2) `mappend`+          putWord32host (s+3) `mappend`+          putWord32host (s+4) `mappend`+          putWord32host (s+5) `mappend`+          putWord32host (s+6) `mappend`+          putWord32host (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord32N16Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord32host (s+0) `mappend`+          putWord32host (s+1) `mappend`+          putWord32host (s+2) `mappend`+          putWord32host (s+3) `mappend`+          putWord32host (s+4) `mappend`+          putWord32host (s+5) `mappend`+          putWord32host (s+6) `mappend`+          putWord32host (s+7) `mappend`+          putWord32host (s+8) `mappend`+          putWord32host (s+9) `mappend`+          putWord32host (s+10) `mappend`+          putWord32host (s+11) `mappend`+          putWord32host (s+12) `mappend`+          putWord32host (s+13) `mappend`+          putWord32host (s+14) `mappend`+          putWord32host (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord64N1Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64be (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord64N2Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64be (s+0) `mappend`+          putWord64be (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord64N4Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64be (s+0) `mappend`+          putWord64be (s+1) `mappend`+          putWord64be (s+2) `mappend`+          putWord64be (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord64N8Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64be (s+0) `mappend`+          putWord64be (s+1) `mappend`+          putWord64be (s+2) `mappend`+          putWord64be (s+3) `mappend`+          putWord64be (s+4) `mappend`+          putWord64be (s+5) `mappend`+          putWord64be (s+6) `mappend`+          putWord64be (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord64N16Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64be (s+0) `mappend`+          putWord64be (s+1) `mappend`+          putWord64be (s+2) `mappend`+          putWord64be (s+3) `mappend`+          putWord64be (s+4) `mappend`+          putWord64be (s+5) `mappend`+          putWord64be (s+6) `mappend`+          putWord64be (s+7) `mappend`+          putWord64be (s+8) `mappend`+          putWord64be (s+9) `mappend`+          putWord64be (s+10) `mappend`+          putWord64be (s+11) `mappend`+          putWord64be (s+12) `mappend`+          putWord64be (s+13) `mappend`+          putWord64be (s+14) `mappend`+          putWord64be (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord64N1Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64le (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord64N2Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64le (s+0) `mappend`+          putWord64le (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord64N4Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64le (s+0) `mappend`+          putWord64le (s+1) `mappend`+          putWord64le (s+2) `mappend`+          putWord64le (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord64N8Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64le (s+0) `mappend`+          putWord64le (s+1) `mappend`+          putWord64le (s+2) `mappend`+          putWord64le (s+3) `mappend`+          putWord64le (s+4) `mappend`+          putWord64le (s+5) `mappend`+          putWord64le (s+6) `mappend`+          putWord64le (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord64N16Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64le (s+0) `mappend`+          putWord64le (s+1) `mappend`+          putWord64le (s+2) `mappend`+          putWord64le (s+3) `mappend`+          putWord64le (s+4) `mappend`+          putWord64le (s+5) `mappend`+          putWord64le (s+6) `mappend`+          putWord64le (s+7) `mappend`+          putWord64le (s+8) `mappend`+          putWord64le (s+9) `mappend`+          putWord64le (s+10) `mappend`+          putWord64le (s+11) `mappend`+          putWord64le (s+12) `mappend`+          putWord64le (s+13) `mappend`+          putWord64le (s+14) `mappend`+          putWord64le (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord64N1Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64host (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord64N2Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64host (s+0) `mappend`+          putWord64host (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord64N4Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64host (s+0) `mappend`+          putWord64host (s+1) `mappend`+          putWord64host (s+2) `mappend`+          putWord64host (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord64N8Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64host (s+0) `mappend`+          putWord64host (s+1) `mappend`+          putWord64host (s+2) `mappend`+          putWord64host (s+3) `mappend`+          putWord64host (s+4) `mappend`+          putWord64host (s+5) `mappend`+          putWord64host (s+6) `mappend`+          putWord64host (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord64N16Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = (+          putWord64host (s+0) `mappend`+          putWord64host (s+1) `mappend`+          putWord64host (s+2) `mappend`+          putWord64host (s+3) `mappend`+          putWord64host (s+4) `mappend`+          putWord64host (s+5) `mappend`+          putWord64host (s+6) `mappend`+          putWord64host (s+7) `mappend`+          putWord64host (s+8) `mappend`+          putWord64host (s+9) `mappend`+          putWord64host (s+10) `mappend`+          putWord64host (s+11) `mappend`+          putWord64host (s+12) `mappend`+          putWord64host (s+13) `mappend`+          putWord64host (s+14) `mappend`+          putWord64host (s+15)) `mappend`+          loop (s+16) (n-16)+

@@ -0,0 +1,118 @@+module Throughput.BinaryBuilderDeclarative (+  serialize+) where++import Data.Monoid+import Data.Word+import qualified Data.ByteString.Lazy as L++import Data.Binary.Builder++import Control.Monad++import Throughput.Utils++serialize :: Int -> Int -> Endian -> Int -> Maybe L.ByteString+serialize wordSize chunkSize end iters = fmap toLazyByteString $+  case (wordSize, chunkSize, end) of+    (1, 1,_)        -> return $ writeByteN1 iters++    (2, 1,  Big)    -> return $ writeWord16N1Big iters+    (2, 1,  Little) -> return $ writeWord16N1Little iters+    (2, 1,  Host)   -> return $ writeWord16N1Host iters++    (4, 1,  Big)    -> return $ writeWord32N1Big iters+    (4, 1,  Little) -> return $ writeWord32N1Little iters+    (4, 1,  Host)   -> return $ writeWord32N1Host iters++    (8, 1,  Host)   -> return $ writeWord64N1Host iters+    (8, 1,  Big)    -> return $ writeWord64N1Big iters+    (8, 1,  Little) -> return $ writeWord64N1Little iters++    _               -> mzero++------------------------------------------------------------------------+-- Word8+------------------------------------------------------------------------++word8List :: Int -> [Word8]+word8List n = take n $ cycle $ [0..]++------------------------------------------------------------------------++writeByteN1  = mconcat . map singleton . word8List+++------------------------------------------------------------------------+-- Word16+------------------------------------------------------------------------++word16List :: Int -> [Word16]+word16List n = take n $ cycle $ [0..]++------------------------------------------------------------------------+-- Big endian, word16 writes++writeWord16N1Big  = mconcat . map putWord16be . word16List+++------------------------------------------------------------------------+-- Little endian, word16 writes++writeWord16N1Little  = mconcat . map putWord16le . word16List+++------------------------------------------------------------------------+-- Host endian, unaligned, word16 writes++writeWord16N1Host  = mconcat . map putWord16host . word16List+++------------------------------------------------------------------------+-- Word32+------------------------------------------------------------------------++word32List :: Int -> [Word32]+word32List n = [0..fromIntegral (n-1)]++------------------------------------------------------------------------+-- Big endian, word16 writes++writeWord32N1Big  = mconcat . map putWord32be . word32List+++------------------------------------------------------------------------+-- Little endian, word32 writes++writeWord32N1Little  = mconcat . map putWord32le . word32List+++------------------------------------------------------------------------+-- Host endian, unaligned, word32 writes++writeWord32N1Host  = mconcat . map putWord32host . word32List+++------------------------------------------------------------------------+-- Word64+------------------------------------------------------------------------++word64List :: Int -> [Word64]+word64List n = [0..fromIntegral (n-1)]++------------------------------------------------------------------------+-- Big endian, word16 writes++writeWord64N1Big  = mconcat . map putWord64be . word64List+++------------------------------------------------------------------------+-- Little endian, word64 writes++writeWord64N1Little  = mconcat . map putWord64le . word64List++------------------------------------------------------------------------+-- Host endian, unaligned, word64 writes++writeWord64N1Host  = mconcat . map putWord64host . word64List+

@@ -0,0 +1,696 @@+{-# LANGUAGE BangPatterns #-}+module Throughput.BinaryPut (serialize) where++import qualified Data.ByteString.Lazy as L+import Data.Binary.Put++import Throughput.Utils++serialize :: Int -> Int -> Endian -> Int -> L.ByteString+serialize wordSize chunkSize end = runPut .+  case (wordSize, chunkSize, end) of+    (1, 1,_)   -> putWord8N1+    (1, 2,_)   -> putWord8N2+    (1, 4,_)   -> putWord8N4+    (1, 8,_)   -> putWord8N8+    (1, 16, _) -> putWord8N16++    (2, 1,  Big)    -> putWord16N1Big+    (2, 2,  Big)    -> putWord16N2Big+    (2, 4,  Big)    -> putWord16N4Big+    (2, 8,  Big)    -> putWord16N8Big+    (2, 16, Big)    -> putWord16N16Big+    (2, 1,  Little) -> putWord16N1Little+    (2, 2,  Little) -> putWord16N2Little+    (2, 4,  Little) -> putWord16N4Little+    (2, 8,  Little) -> putWord16N8Little+    (2, 16, Little) -> putWord16N16Little+    (2, 1,  Host)   -> putWord16N1Host+    (2, 2,  Host)   -> putWord16N2Host+    (2, 4,  Host)   -> putWord16N4Host+    (2, 8,  Host)   -> putWord16N8Host+    (2, 16, Host)   -> putWord16N16Host++    (4, 1,  Big)    -> putWord32N1Big+    (4, 2,  Big)    -> putWord32N2Big+    (4, 4,  Big)    -> putWord32N4Big+    (4, 8,  Big)    -> putWord32N8Big+    (4, 16, Big)    -> putWord32N16Big+    (4, 1,  Little) -> putWord32N1Little+    (4, 2,  Little) -> putWord32N2Little+    (4, 4,  Little) -> putWord32N4Little+    (4, 8,  Little) -> putWord32N8Little+    (4, 16, Little) -> putWord32N16Little+    (4, 1,  Host)   -> putWord32N1Host+    (4, 2,  Host)   -> putWord32N2Host+    (4, 4,  Host)   -> putWord32N4Host+    (4, 8,  Host)   -> putWord32N8Host+    (4, 16, Host)   -> putWord32N16Host++    (8, 1,  Host)        -> putWord64N1Host+    (8, 2,  Host)        -> putWord64N2Host+    (8, 4,  Host)        -> putWord64N4Host+    (8, 8,  Host)        -> putWord64N8Host+    (8, 16, Host)        -> putWord64N16Host+    (8, 1,  Big)         -> putWord64N1Big+    (8, 2,  Big)         -> putWord64N2Big+    (8, 4,  Big)         -> putWord64N4Big+    (8, 8,  Big)         -> putWord64N8Big+    (8, 16, Big)         -> putWord64N16Big+    (8, 1,  Little)      -> putWord64N1Little+    (8, 2,  Little)      -> putWord64N2Little+    (8, 4,  Little)      -> putWord64N4Little+    (8, 8,  Little)      -> putWord64N8Little+    (8, 16, Little)      -> putWord64N16Little++------------------------------------------------------------------------++putWord8N1 bytes = loop 0 0+  where loop !s !n | n == bytes = return ()+                   | otherwise  = do putWord8 s+                                     loop (s+1) (n+1)++putWord8N2 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord8 (s+0)+          putWord8 (s+1)+          loop (s+2) (n-2)++putWord8N4 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord8 (s+0)+          putWord8 (s+1)+          putWord8 (s+2)+          putWord8 (s+3)+          loop (s+4) (n-4)++putWord8N8 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord8 (s+0)+          putWord8 (s+1)+          putWord8 (s+2)+          putWord8 (s+3)+          putWord8 (s+4)+          putWord8 (s+5)+          putWord8 (s+6)+          putWord8 (s+7)+          loop (s+8) (n-8)++putWord8N16 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord8 (s+0)+          putWord8 (s+1)+          putWord8 (s+2)+          putWord8 (s+3)+          putWord8 (s+4)+          putWord8 (s+5)+          putWord8 (s+6)+          putWord8 (s+7)+          putWord8 (s+8)+          putWord8 (s+9)+          putWord8 (s+10)+          putWord8 (s+11)+          putWord8 (s+12)+          putWord8 (s+13)+          putWord8 (s+14)+          putWord8 (s+15)+          loop (s+16) (n-16)++------------------------------------------------------------------------+-- Big endian, word16 writes++putWord16N1Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16be (s+0)+          loop (s+1) (n-1)++putWord16N2Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16be (s+0)+          putWord16be (s+1)+          loop (s+2) (n-2)++putWord16N4Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16be (s+0)+          putWord16be (s+1)+          putWord16be (s+2)+          putWord16be (s+3)+          loop (s+4) (n-4)++putWord16N8Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16be (s+0)+          putWord16be (s+1)+          putWord16be (s+2)+          putWord16be (s+3)+          putWord16be (s+4)+          putWord16be (s+5)+          putWord16be (s+6)+          putWord16be (s+7)+          loop (s+8) (n-8)++putWord16N16Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16be (s+0)+          putWord16be (s+1)+          putWord16be (s+2)+          putWord16be (s+3)+          putWord16be (s+4)+          putWord16be (s+5)+          putWord16be (s+6)+          putWord16be (s+7)+          putWord16be (s+8)+          putWord16be (s+9)+          putWord16be (s+10)+          putWord16be (s+11)+          putWord16be (s+12)+          putWord16be (s+13)+          putWord16be (s+14)+          putWord16be (s+15)+          loop (s+16) (n-16)++------------------------------------------------------------------------+-- Little endian, word16 writes++putWord16N1Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16le (s+0)+          loop (s+1) (n-1)++putWord16N2Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16le (s+0)+          putWord16le (s+1)+          loop (s+2) (n-2)++putWord16N4Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16le (s+0)+          putWord16le (s+1)+          putWord16le (s+2)+          putWord16le (s+3)+          loop (s+4) (n-4)++putWord16N8Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16le (s+0)+          putWord16le (s+1)+          putWord16le (s+2)+          putWord16le (s+3)+          putWord16le (s+4)+          putWord16le (s+5)+          putWord16le (s+6)+          putWord16le (s+7)+          loop (s+8) (n-8)++putWord16N16Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16le (s+0)+          putWord16le (s+1)+          putWord16le (s+2)+          putWord16le (s+3)+          putWord16le (s+4)+          putWord16le (s+5)+          putWord16le (s+6)+          putWord16le (s+7)+          putWord16le (s+8)+          putWord16le (s+9)+          putWord16le (s+10)+          putWord16le (s+11)+          putWord16le (s+12)+          putWord16le (s+13)+          putWord16le (s+14)+          putWord16le (s+15)+          loop (s+16) (n-16)++------------------------------------------------------------------------+-- Host endian, unaligned, word16 writes++putWord16N1Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16host (s+0)+          loop (s+1) (n-1)++putWord16N2Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16host (s+0)+          putWord16host (s+1)+          loop (s+2) (n-2)++putWord16N4Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16host (s+0)+          putWord16host (s+1)+          putWord16host (s+2)+          putWord16host (s+3)+          loop (s+4) (n-4)++putWord16N8Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16host (s+0)+          putWord16host (s+1)+          putWord16host (s+2)+          putWord16host (s+3)+          putWord16host (s+4)+          putWord16host (s+5)+          putWord16host (s+6)+          putWord16host (s+7)+          loop (s+8) (n-8)++putWord16N16Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord16host (s+0)+          putWord16host (s+1)+          putWord16host (s+2)+          putWord16host (s+3)+          putWord16host (s+4)+          putWord16host (s+5)+          putWord16host (s+6)+          putWord16host (s+7)+          putWord16host (s+8)+          putWord16host (s+9)+          putWord16host (s+10)+          putWord16host (s+11)+          putWord16host (s+12)+          putWord16host (s+13)+          putWord16host (s+14)+          putWord16host (s+15)+          loop (s+16) (n-16)++------------------------------------------------------------------------++putWord32N1Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32be (s+0)+          loop (s+1) (n-1)++putWord32N2Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32be (s+0)+          putWord32be (s+1)+          loop (s+2) (n-2)++putWord32N4Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32be (s+0)+          putWord32be (s+1)+          putWord32be (s+2)+          putWord32be (s+3)+          loop (s+4) (n-4)++putWord32N8Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32be (s+0)+          putWord32be (s+1)+          putWord32be (s+2)+          putWord32be (s+3)+          putWord32be (s+4)+          putWord32be (s+5)+          putWord32be (s+6)+          putWord32be (s+7)+          loop (s+8) (n-8)++putWord32N16Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32be (s+0)+          putWord32be (s+1)+          putWord32be (s+2)+          putWord32be (s+3)+          putWord32be (s+4)+          putWord32be (s+5)+          putWord32be (s+6)+          putWord32be (s+7)+          putWord32be (s+8)+          putWord32be (s+9)+          putWord32be (s+10)+          putWord32be (s+11)+          putWord32be (s+12)+          putWord32be (s+13)+          putWord32be (s+14)+          putWord32be (s+15)+          loop (s+16) (n-16)++------------------------------------------------------------------------++putWord32N1Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32le (s+0)+          loop (s+1) (n-1)++putWord32N2Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32le (s+0)+          putWord32le (s+1)+          loop (s+2) (n-2)++putWord32N4Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32le (s+0)+          putWord32le (s+1)+          putWord32le (s+2)+          putWord32le (s+3)+          loop (s+4) (n-4)++putWord32N8Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32le (s+0)+          putWord32le (s+1)+          putWord32le (s+2)+          putWord32le (s+3)+          putWord32le (s+4)+          putWord32le (s+5)+          putWord32le (s+6)+          putWord32le (s+7)+          loop (s+8) (n-8)++putWord32N16Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32le (s+0)+          putWord32le (s+1)+          putWord32le (s+2)+          putWord32le (s+3)+          putWord32le (s+4)+          putWord32le (s+5)+          putWord32le (s+6)+          putWord32le (s+7)+          putWord32le (s+8)+          putWord32le (s+9)+          putWord32le (s+10)+          putWord32le (s+11)+          putWord32le (s+12)+          putWord32le (s+13)+          putWord32le (s+14)+          putWord32le (s+15)+          loop (s+16) (n-16)++------------------------------------------------------------------------++putWord32N1Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32host (s+0)+          loop (s+1) (n-1)++putWord32N2Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32host (s+0)+          putWord32host (s+1)+          loop (s+2) (n-2)++putWord32N4Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32host (s+0)+          putWord32host (s+1)+          putWord32host (s+2)+          putWord32host (s+3)+          loop (s+4) (n-4)++putWord32N8Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32host (s+0)+          putWord32host (s+1)+          putWord32host (s+2)+          putWord32host (s+3)+          putWord32host (s+4)+          putWord32host (s+5)+          putWord32host (s+6)+          putWord32host (s+7)+          loop (s+8) (n-8)++putWord32N16Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord32host (s+0)+          putWord32host (s+1)+          putWord32host (s+2)+          putWord32host (s+3)+          putWord32host (s+4)+          putWord32host (s+5)+          putWord32host (s+6)+          putWord32host (s+7)+          putWord32host (s+8)+          putWord32host (s+9)+          putWord32host (s+10)+          putWord32host (s+11)+          putWord32host (s+12)+          putWord32host (s+13)+          putWord32host (s+14)+          putWord32host (s+15)+          loop (s+16) (n-16)++------------------------------------------------------------------------++putWord64N1Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64be (s+0)+          loop (s+1) (n-1)++putWord64N2Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64be (s+0)+          putWord64be (s+1)+          loop (s+2) (n-2)++putWord64N4Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64be (s+0)+          putWord64be (s+1)+          putWord64be (s+2)+          putWord64be (s+3)+          loop (s+4) (n-4)++putWord64N8Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64be (s+0)+          putWord64be (s+1)+          putWord64be (s+2)+          putWord64be (s+3)+          putWord64be (s+4)+          putWord64be (s+5)+          putWord64be (s+6)+          putWord64be (s+7)+          loop (s+8) (n-8)++putWord64N16Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64be (s+0)+          putWord64be (s+1)+          putWord64be (s+2)+          putWord64be (s+3)+          putWord64be (s+4)+          putWord64be (s+5)+          putWord64be (s+6)+          putWord64be (s+7)+          putWord64be (s+8)+          putWord64be (s+9)+          putWord64be (s+10)+          putWord64be (s+11)+          putWord64be (s+12)+          putWord64be (s+13)+          putWord64be (s+14)+          putWord64be (s+15)+          loop (s+16) (n-16)++------------------------------------------------------------------------++putWord64N1Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64le (s+0)+          loop (s+1) (n-1)++putWord64N2Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64le (s+0)+          putWord64le (s+1)+          loop (s+2) (n-2)++putWord64N4Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64le (s+0)+          putWord64le (s+1)+          putWord64le (s+2)+          putWord64le (s+3)+          loop (s+4) (n-4)++putWord64N8Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64le (s+0)+          putWord64le (s+1)+          putWord64le (s+2)+          putWord64le (s+3)+          putWord64le (s+4)+          putWord64le (s+5)+          putWord64le (s+6)+          putWord64le (s+7)+          loop (s+8) (n-8)++putWord64N16Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64le (s+0)+          putWord64le (s+1)+          putWord64le (s+2)+          putWord64le (s+3)+          putWord64le (s+4)+          putWord64le (s+5)+          putWord64le (s+6)+          putWord64le (s+7)+          putWord64le (s+8)+          putWord64le (s+9)+          putWord64le (s+10)+          putWord64le (s+11)+          putWord64le (s+12)+          putWord64le (s+13)+          putWord64le (s+14)+          putWord64le (s+15)+          loop (s+16) (n-16)++------------------------------------------------------------------------++putWord64N1Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64host (s+0)+          loop (s+1) (n-1)++putWord64N2Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64host (s+0)+          putWord64host (s+1)+          loop (s+2) (n-2)++putWord64N4Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64host (s+0)+          putWord64host (s+1)+          putWord64host (s+2)+          putWord64host (s+3)+          loop (s+4) (n-4)++putWord64N8Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64host (s+0)+          putWord64host (s+1)+          putWord64host (s+2)+          putWord64host (s+3)+          putWord64host (s+4)+          putWord64host (s+5)+          putWord64host (s+6)+          putWord64host (s+7)+          loop (s+8) (n-8)++putWord64N16Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          putWord64host (s+0)+          putWord64host (s+1)+          putWord64host (s+2)+          putWord64host (s+3)+          putWord64host (s+4)+          putWord64host (s+5)+          putWord64host (s+6)+          putWord64host (s+7)+          putWord64host (s+8)+          putWord64host (s+9)+          putWord64host (s+10)+          putWord64host (s+11)+          putWord64host (s+12)+          putWord64host (s+13)+          putWord64host (s+14)+          putWord64host (s+15)+          loop (s+16) (n-16)+

@@ -0,0 +1,702 @@+{-# LANGUAGE BangPatterns #-}+module Throughput.BlazeBuilder (+  serialize+) where++import Data.Monoid+import qualified Data.ByteString.Lazy as L++import Blaze.ByteString.Builder++import Throughput.Utils++serialize :: Int -> Int -> Endian -> Int -> L.ByteString+serialize wordSize chunkSize end = toLazyByteString . +  case (wordSize, chunkSize, end) of+    (1, 1,_)   -> writeByteN1+    (1, 2,_)   -> writeByteN2+    (1, 4,_)   -> writeByteN4+    (1, 8,_)   -> writeByteN8+    (1, 16, _) -> writeByteN16++    (2, 1,  Big)    -> writeWord16N1Big+    (2, 2,  Big)    -> writeWord16N2Big+    (2, 4,  Big)    -> writeWord16N4Big+    (2, 8,  Big)    -> writeWord16N8Big+    (2, 16, Big)    -> writeWord16N16Big+    (2, 1,  Little) -> writeWord16N1Little+    (2, 2,  Little) -> writeWord16N2Little+    (2, 4,  Little) -> writeWord16N4Little+    (2, 8,  Little) -> writeWord16N8Little+    (2, 16, Little) -> writeWord16N16Little+    (2, 1,  Host)   -> writeWord16N1Host+    (2, 2,  Host)   -> writeWord16N2Host+    (2, 4,  Host)   -> writeWord16N4Host+    (2, 8,  Host)   -> writeWord16N8Host+    (2, 16, Host)   -> writeWord16N16Host++    (4, 1,  Big)    -> writeWord32N1Big+    (4, 2,  Big)    -> writeWord32N2Big+    (4, 4,  Big)    -> writeWord32N4Big+    (4, 8,  Big)    -> writeWord32N8Big+    (4, 16, Big)    -> writeWord32N16Big+    (4, 1,  Little) -> writeWord32N1Little+    (4, 2,  Little) -> writeWord32N2Little+    (4, 4,  Little) -> writeWord32N4Little+    (4, 8,  Little) -> writeWord32N8Little+    (4, 16, Little) -> writeWord32N16Little+    (4, 1,  Host)   -> writeWord32N1Host+    (4, 2,  Host)   -> writeWord32N2Host+    (4, 4,  Host)   -> writeWord32N4Host+    (4, 8,  Host)   -> writeWord32N8Host+    (4, 16, Host)   -> writeWord32N16Host++    (8, 1,  Host)        -> writeWord64N1Host+    (8, 2,  Host)        -> writeWord64N2Host+    (8, 4,  Host)        -> writeWord64N4Host+    (8, 8,  Host)        -> writeWord64N8Host+    (8, 16, Host)        -> writeWord64N16Host+    (8, 1,  Big)         -> writeWord64N1Big+    (8, 2,  Big)         -> writeWord64N2Big+    (8, 4,  Big)         -> writeWord64N4Big+    (8, 8,  Big)         -> writeWord64N8Big+    (8, 16, Big)         -> writeWord64N16Big+    (8, 1,  Little)      -> writeWord64N1Little+    (8, 2,  Little)      -> writeWord64N2Little+    (8, 4,  Little)      -> writeWord64N4Little+    (8, 8,  Little)      -> writeWord64N8Little+    (8, 16, Little)      -> writeWord64N16Little++------------------------------------------------------------------------+++------------------------------------------------------------------------++writeByteN1 bytes = loop 0 0+  where loop !s !n | n == bytes = mempty+                   | otherwise  = fromWord8 s `mappend`+                                  loop (s+1) (n+1)++writeByteN2 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord8 (s+0) `mappend`+          writeWord8 (s+1)) `mappend`+          loop (s+2) (n-2)++writeByteN4 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord8 (s+0) `mappend`+          writeWord8 (s+1) `mappend`+          writeWord8 (s+2) `mappend`+          writeWord8 (s+3)) `mappend`+          loop (s+4) (n-4)++writeByteN8 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord8 (s+0) `mappend`+          writeWord8 (s+1) `mappend`+          writeWord8 (s+2) `mappend`+          writeWord8 (s+3) `mappend`+          writeWord8 (s+4) `mappend`+          writeWord8 (s+5) `mappend`+          writeWord8 (s+6) `mappend`+          writeWord8 (s+7)) `mappend`+          loop (s+8) (n-8)++writeByteN16 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord8 (s+0) `mappend`+          writeWord8 (s+1) `mappend`+          writeWord8 (s+2) `mappend`+          writeWord8 (s+3) `mappend`+          writeWord8 (s+4) `mappend`+          writeWord8 (s+5) `mappend`+          writeWord8 (s+6) `mappend`+          writeWord8 (s+7) `mappend`+          writeWord8 (s+8) `mappend`+          writeWord8 (s+9) `mappend`+          writeWord8 (s+10) `mappend`+          writeWord8 (s+11) `mappend`+          writeWord8 (s+12) `mappend`+          writeWord8 (s+13) `mappend`+          writeWord8 (s+14) `mappend`+          writeWord8 (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------+-- Big endian, word16 writes++writeWord16N1Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16be (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord16N2Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16be (s+0) `mappend`+          writeWord16be (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord16N4Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16be (s+0) `mappend`+          writeWord16be (s+1) `mappend`+          writeWord16be (s+2) `mappend`+          writeWord16be (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord16N8Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16be (s+0) `mappend`+          writeWord16be (s+1) `mappend`+          writeWord16be (s+2) `mappend`+          writeWord16be (s+3) `mappend`+          writeWord16be (s+4) `mappend`+          writeWord16be (s+5) `mappend`+          writeWord16be (s+6) `mappend`+          writeWord16be (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord16N16Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16be (s+0) `mappend`+          writeWord16be (s+1) `mappend`+          writeWord16be (s+2) `mappend`+          writeWord16be (s+3) `mappend`+          writeWord16be (s+4) `mappend`+          writeWord16be (s+5) `mappend`+          writeWord16be (s+6) `mappend`+          writeWord16be (s+7) `mappend`+          writeWord16be (s+8) `mappend`+          writeWord16be (s+9) `mappend`+          writeWord16be (s+10) `mappend`+          writeWord16be (s+11) `mappend`+          writeWord16be (s+12) `mappend`+          writeWord16be (s+13) `mappend`+          writeWord16be (s+14) `mappend`+          writeWord16be (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------+-- Little endian, word16 writes++writeWord16N1Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = +          fromWrite (writeWord16le (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord16N2Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16le (s+0) `mappend`+          writeWord16le (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord16N4Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16le (s+0) `mappend`+          writeWord16le (s+1) `mappend`+          writeWord16le (s+2) `mappend`+          writeWord16le (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord16N8Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16le (s+0) `mappend`+          writeWord16le (s+1) `mappend`+          writeWord16le (s+2) `mappend`+          writeWord16le (s+3) `mappend`+          writeWord16le (s+4) `mappend`+          writeWord16le (s+5) `mappend`+          writeWord16le (s+6) `mappend`+          writeWord16le (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord16N16Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16le (s+0) `mappend`+          writeWord16le (s+1) `mappend`+          writeWord16le (s+2) `mappend`+          writeWord16le (s+3) `mappend`+          writeWord16le (s+4) `mappend`+          writeWord16le (s+5) `mappend`+          writeWord16le (s+6) `mappend`+          writeWord16le (s+7) `mappend`+          writeWord16le (s+8) `mappend`+          writeWord16le (s+9) `mappend`+          writeWord16le (s+10) `mappend`+          writeWord16le (s+11) `mappend`+          writeWord16le (s+12) `mappend`+          writeWord16le (s+13) `mappend`+          writeWord16le (s+14) `mappend`+          writeWord16le (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------+-- Host endian, unaligned, word16 writes++writeWord16N1Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16host (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord16N2Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16host (s+0) `mappend`+          writeWord16host (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord16N4Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16host (s+0) `mappend`+          writeWord16host (s+1) `mappend`+          writeWord16host (s+2) `mappend`+          writeWord16host (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord16N8Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16host (s+0) `mappend`+          writeWord16host (s+1) `mappend`+          writeWord16host (s+2) `mappend`+          writeWord16host (s+3) `mappend`+          writeWord16host (s+4) `mappend`+          writeWord16host (s+5) `mappend`+          writeWord16host (s+6) `mappend`+          writeWord16host (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord16N16Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord16host (s+0) `mappend`+          writeWord16host (s+1) `mappend`+          writeWord16host (s+2) `mappend`+          writeWord16host (s+3) `mappend`+          writeWord16host (s+4) `mappend`+          writeWord16host (s+5) `mappend`+          writeWord16host (s+6) `mappend`+          writeWord16host (s+7) `mappend`+          writeWord16host (s+8) `mappend`+          writeWord16host (s+9) `mappend`+          writeWord16host (s+10) `mappend`+          writeWord16host (s+11) `mappend`+          writeWord16host (s+12) `mappend`+          writeWord16host (s+13) `mappend`+          writeWord16host (s+14) `mappend`+          writeWord16host (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord32N1Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32be (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord32N2Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32be (s+0) `mappend`+          writeWord32be (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord32N4Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32be (s+0) `mappend`+          writeWord32be (s+1) `mappend`+          writeWord32be (s+2) `mappend`+          writeWord32be (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord32N8Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32be (s+0) `mappend`+          writeWord32be (s+1) `mappend`+          writeWord32be (s+2) `mappend`+          writeWord32be (s+3) `mappend`+          writeWord32be (s+4) `mappend`+          writeWord32be (s+5) `mappend`+          writeWord32be (s+6) `mappend`+          writeWord32be (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord32N16Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32be (s+0) `mappend`+          writeWord32be (s+1) `mappend`+          writeWord32be (s+2) `mappend`+          writeWord32be (s+3) `mappend`+          writeWord32be (s+4) `mappend`+          writeWord32be (s+5) `mappend`+          writeWord32be (s+6) `mappend`+          writeWord32be (s+7) `mappend`+          writeWord32be (s+8) `mappend`+          writeWord32be (s+9) `mappend`+          writeWord32be (s+10) `mappend`+          writeWord32be (s+11) `mappend`+          writeWord32be (s+12) `mappend`+          writeWord32be (s+13) `mappend`+          writeWord32be (s+14) `mappend`+          writeWord32be (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord32N1Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32le (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord32N2Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32le (s+0) `mappend`+          writeWord32le (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord32N4Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32le (s+0) `mappend`+          writeWord32le (s+1) `mappend`+          writeWord32le (s+2) `mappend`+          writeWord32le (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord32N8Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32le (s+0) `mappend`+          writeWord32le (s+1) `mappend`+          writeWord32le (s+2) `mappend`+          writeWord32le (s+3) `mappend`+          writeWord32le (s+4) `mappend`+          writeWord32le (s+5) `mappend`+          writeWord32le (s+6) `mappend`+          writeWord32le (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord32N16Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32le (s+0) `mappend`+          writeWord32le (s+1) `mappend`+          writeWord32le (s+2) `mappend`+          writeWord32le (s+3) `mappend`+          writeWord32le (s+4) `mappend`+          writeWord32le (s+5) `mappend`+          writeWord32le (s+6) `mappend`+          writeWord32le (s+7) `mappend`+          writeWord32le (s+8) `mappend`+          writeWord32le (s+9) `mappend`+          writeWord32le (s+10) `mappend`+          writeWord32le (s+11) `mappend`+          writeWord32le (s+12) `mappend`+          writeWord32le (s+13) `mappend`+          writeWord32le (s+14) `mappend`+          writeWord32le (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord32N1Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32host (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord32N2Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32host (s+0) `mappend`+          writeWord32host (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord32N4Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32host (s+0) `mappend`+          writeWord32host (s+1) `mappend`+          writeWord32host (s+2) `mappend`+          writeWord32host (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord32N8Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32host (s+0) `mappend`+          writeWord32host (s+1) `mappend`+          writeWord32host (s+2) `mappend`+          writeWord32host (s+3) `mappend`+          writeWord32host (s+4) `mappend`+          writeWord32host (s+5) `mappend`+          writeWord32host (s+6) `mappend`+          writeWord32host (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord32N16Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord32host (s+0) `mappend`+          writeWord32host (s+1) `mappend`+          writeWord32host (s+2) `mappend`+          writeWord32host (s+3) `mappend`+          writeWord32host (s+4) `mappend`+          writeWord32host (s+5) `mappend`+          writeWord32host (s+6) `mappend`+          writeWord32host (s+7) `mappend`+          writeWord32host (s+8) `mappend`+          writeWord32host (s+9) `mappend`+          writeWord32host (s+10) `mappend`+          writeWord32host (s+11) `mappend`+          writeWord32host (s+12) `mappend`+          writeWord32host (s+13) `mappend`+          writeWord32host (s+14) `mappend`+          writeWord32host (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord64N1Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64be (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord64N2Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64be (s+0) `mappend`+          writeWord64be (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord64N4Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64be (s+0) `mappend`+          writeWord64be (s+1) `mappend`+          writeWord64be (s+2) `mappend`+          writeWord64be (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord64N8Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64be (s+0) `mappend`+          writeWord64be (s+1) `mappend`+          writeWord64be (s+2) `mappend`+          writeWord64be (s+3) `mappend`+          writeWord64be (s+4) `mappend`+          writeWord64be (s+5) `mappend`+          writeWord64be (s+6) `mappend`+          writeWord64be (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord64N16Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64be (s+0) `mappend`+          writeWord64be (s+1) `mappend`+          writeWord64be (s+2) `mappend`+          writeWord64be (s+3) `mappend`+          writeWord64be (s+4) `mappend`+          writeWord64be (s+5) `mappend`+          writeWord64be (s+6) `mappend`+          writeWord64be (s+7) `mappend`+          writeWord64be (s+8) `mappend`+          writeWord64be (s+9) `mappend`+          writeWord64be (s+10) `mappend`+          writeWord64be (s+11) `mappend`+          writeWord64be (s+12) `mappend`+          writeWord64be (s+13) `mappend`+          writeWord64be (s+14) `mappend`+          writeWord64be (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord64N1Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64le (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord64N2Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64le (s+0) `mappend`+          writeWord64le (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord64N4Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64le (s+0) `mappend`+          writeWord64le (s+1) `mappend`+          writeWord64le (s+2) `mappend`+          writeWord64le (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord64N8Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64le (s+0) `mappend`+          writeWord64le (s+1) `mappend`+          writeWord64le (s+2) `mappend`+          writeWord64le (s+3) `mappend`+          writeWord64le (s+4) `mappend`+          writeWord64le (s+5) `mappend`+          writeWord64le (s+6) `mappend`+          writeWord64le (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord64N16Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64le (s+0) `mappend`+          writeWord64le (s+1) `mappend`+          writeWord64le (s+2) `mappend`+          writeWord64le (s+3) `mappend`+          writeWord64le (s+4) `mappend`+          writeWord64le (s+5) `mappend`+          writeWord64le (s+6) `mappend`+          writeWord64le (s+7) `mappend`+          writeWord64le (s+8) `mappend`+          writeWord64le (s+9) `mappend`+          writeWord64le (s+10) `mappend`+          writeWord64le (s+11) `mappend`+          writeWord64le (s+12) `mappend`+          writeWord64le (s+13) `mappend`+          writeWord64le (s+14) `mappend`+          writeWord64le (s+15)) `mappend`+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord64N1Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64host (s+0)) `mappend`+          loop (s+1) (n-1)++writeWord64N2Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64host (s+0) `mappend`+          writeWord64host (s+1)) `mappend`+          loop (s+2) (n-2)++writeWord64N4Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64host (s+0) `mappend`+          writeWord64host (s+1) `mappend`+          writeWord64host (s+2) `mappend`+          writeWord64host (s+3)) `mappend`+          loop (s+4) (n-4)++writeWord64N8Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64host (s+0) `mappend`+          writeWord64host (s+1) `mappend`+          writeWord64host (s+2) `mappend`+          writeWord64host (s+3) `mappend`+          writeWord64host (s+4) `mappend`+          writeWord64host (s+5) `mappend`+          writeWord64host (s+6) `mappend`+          writeWord64host (s+7)) `mappend`+          loop (s+8) (n-8)++writeWord64N16Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = mempty+        loop s n = fromWrite (+          writeWord64host (s+0) `mappend`+          writeWord64host (s+1) `mappend`+          writeWord64host (s+2) `mappend`+          writeWord64host (s+3) `mappend`+          writeWord64host (s+4) `mappend`+          writeWord64host (s+5) `mappend`+          writeWord64host (s+6) `mappend`+          writeWord64host (s+7) `mappend`+          writeWord64host (s+8) `mappend`+          writeWord64host (s+9) `mappend`+          writeWord64host (s+10) `mappend`+          writeWord64host (s+11) `mappend`+          writeWord64host (s+12) `mappend`+          writeWord64host (s+13) `mappend`+          writeWord64host (s+14) `mappend`+          writeWord64host (s+15)) `mappend`+          loop (s+16) (n-16)

@@ -0,0 +1,197 @@+{-# LANGUAGE BangPatterns #-}+module Throughput.BlazeBuilderDeclarative (+  serialize+) where++import Data.Monoid+import Data.Word+import qualified Data.ByteString.Lazy as L++import Blaze.ByteString.Builder++import Throughput.Utils++serialize :: Int -> Int -> Endian -> Int -> L.ByteString+serialize wordSize chunkSize end = toLazyByteString . +  case (wordSize, chunkSize, end) of+    (1, 1,_)   -> writeByteN1+    (1, 2,_)   -> writeByteN2+    (1, 4,_)   -> writeByteN4+    (1, 8,_)   -> writeByteN8+    (1, 16, _) -> writeByteN16++    (2, 1,  Big)    -> writeWord16N1Big+    (2, 2,  Big)    -> writeWord16N2Big+    (2, 4,  Big)    -> writeWord16N4Big+    (2, 8,  Big)    -> writeWord16N8Big+    (2, 16, Big)    -> writeWord16N16Big+    (2, 1,  Little) -> writeWord16N1Little+    (2, 2,  Little) -> writeWord16N2Little+    (2, 4,  Little) -> writeWord16N4Little+    (2, 8,  Little) -> writeWord16N8Little+    (2, 16, Little) -> writeWord16N16Little+    (2, 1,  Host)   -> writeWord16N1Host+    (2, 2,  Host)   -> writeWord16N2Host+    (2, 4,  Host)   -> writeWord16N4Host+    (2, 8,  Host)   -> writeWord16N8Host+    (2, 16, Host)   -> writeWord16N16Host++    (4, 1,  Big)    -> writeWord32N1Big+    (4, 2,  Big)    -> writeWord32N2Big+    (4, 4,  Big)    -> writeWord32N4Big+    (4, 8,  Big)    -> writeWord32N8Big+    (4, 16, Big)    -> writeWord32N16Big+    (4, 1,  Little) -> writeWord32N1Little+    (4, 2,  Little) -> writeWord32N2Little+    (4, 4,  Little) -> writeWord32N4Little+    (4, 8,  Little) -> writeWord32N8Little+    (4, 16, Little) -> writeWord32N16Little+    (4, 1,  Host)   -> writeWord32N1Host+    (4, 2,  Host)   -> writeWord32N2Host+    (4, 4,  Host)   -> writeWord32N4Host+    (4, 8,  Host)   -> writeWord32N8Host+    (4, 16, Host)   -> writeWord32N16Host++    (8, 1,  Host)        -> writeWord64N1Host+    (8, 2,  Host)        -> writeWord64N2Host+    (8, 4,  Host)        -> writeWord64N4Host+    (8, 8,  Host)        -> writeWord64N8Host+    (8, 16, Host)        -> writeWord64N16Host+    (8, 1,  Big)         -> writeWord64N1Big+    (8, 2,  Big)         -> writeWord64N2Big+    (8, 4,  Big)         -> writeWord64N4Big+    (8, 8,  Big)         -> writeWord64N8Big+    (8, 16, Big)         -> writeWord64N16Big+    (8, 1,  Little)      -> writeWord64N1Little+    (8, 2,  Little)      -> writeWord64N2Little+    (8, 4,  Little)      -> writeWord64N4Little+    (8, 8,  Little)      -> writeWord64N8Little+    (8, 16, Little)      -> writeWord64N16Little++------------------------------------------------------------------------+-- Word8+------------------------------------------------------------------------++word8List :: Int -> [Word8]+word8List n = take n $ cycle $ [0..]++------------------------------------------------------------------------++writeByteN1  = fromWrite1List  writeWord8 . word8List+writeByteN2  = fromWrite2List  writeWord8 . word8List+writeByteN4  = fromWrite4List  writeWord8 . word8List+writeByteN8  = fromWrite8List  writeWord8 . word8List+writeByteN16 = fromWrite16List writeWord8 . word8List+++------------------------------------------------------------------------+-- Word16+------------------------------------------------------------------------++word16List :: Int -> [Word16]+word16List n = take n $ cycle $ [0..]++------------------------------------------------------------------------+-- Big endian, word16 writes++writeWord16N1Big  = fromWrite1List  writeWord16be . word16List+writeWord16N2Big  = fromWrite2List  writeWord16be . word16List+writeWord16N4Big  = fromWrite4List  writeWord16be . word16List+writeWord16N8Big  = fromWrite8List  writeWord16be . word16List+writeWord16N16Big = fromWrite16List writeWord16be . word16List+++------------------------------------------------------------------------+-- Little endian, word16 writes++writeWord16N1Little  = fromWrite1List  writeWord16le . word16List+writeWord16N2Little  = fromWrite2List  writeWord16le . word16List+writeWord16N4Little  = fromWrite4List  writeWord16le . word16List+writeWord16N8Little  = fromWrite8List  writeWord16le . word16List+writeWord16N16Little = fromWrite16List writeWord16le . word16List+++------------------------------------------------------------------------+-- Host endian, unaligned, word16 writes++writeWord16N1Host  = fromWrite1List  writeWord16host . word16List+writeWord16N2Host  = fromWrite2List  writeWord16host . word16List+writeWord16N4Host  = fromWrite4List  writeWord16host . word16List+writeWord16N8Host  = fromWrite8List  writeWord16host . word16List+writeWord16N16Host = fromWrite16List writeWord16host . word16List+++------------------------------------------------------------------------+-- Word32+------------------------------------------------------------------------++word32List :: Int -> [Word32]+word32List n = [0..fromIntegral (n-1)]++------------------------------------------------------------------------+-- Big endian, word16 writes++writeWord32N1Big  = fromWrite1List  writeWord32be . word32List+writeWord32N2Big  = fromWrite2List  writeWord32be . word32List+writeWord32N4Big  = fromWrite4List  writeWord32be . word32List+writeWord32N8Big  = fromWrite8List  writeWord32be . word32List+writeWord32N16Big = fromWrite16List writeWord32be . word32List+++------------------------------------------------------------------------+-- Little endian, word32 writes++writeWord32N1Little  = fromWrite1List  writeWord32le . word32List+writeWord32N2Little  = fromWrite2List  writeWord32le . word32List+writeWord32N4Little  = fromWrite4List  writeWord32le . word32List+writeWord32N8Little  = fromWrite8List  writeWord32le . word32List+writeWord32N16Little = fromWrite16List writeWord32le . word32List+++------------------------------------------------------------------------+-- Host endian, unaligned, word32 writes++writeWord32N1Host  = fromWrite1List  writeWord32host . word32List+writeWord32N2Host  = fromWrite2List  writeWord32host . word32List+writeWord32N4Host  = fromWrite4List  writeWord32host . word32List+writeWord32N8Host  = fromWrite8List  writeWord32host . word32List+writeWord32N16Host = fromWrite16List writeWord32host . word32List+++------------------------------------------------------------------------+-- Word64+------------------------------------------------------------------------++word64List :: Int -> [Word64]+word64List n = [0..fromIntegral (n-1)]++------------------------------------------------------------------------+-- Big endian, word16 writes++writeWord64N1Big  = fromWrite1List  writeWord64be . word64List+writeWord64N2Big  = fromWrite2List  writeWord64be . word64List+writeWord64N4Big  = fromWrite4List  writeWord64be . word64List+writeWord64N8Big  = fromWrite8List  writeWord64be . word64List+writeWord64N16Big = fromWrite16List writeWord64be . word64List+++------------------------------------------------------------------------+-- Little endian, word64 writes++writeWord64N1Little  = fromWrite1List  writeWord64le . word64List+writeWord64N2Little  = fromWrite2List  writeWord64le . word64List+writeWord64N4Little  = fromWrite4List  writeWord64le . word64List+writeWord64N8Little  = fromWrite8List  writeWord64le . word64List+writeWord64N16Little = fromWrite16List writeWord64le . word64List+++------------------------------------------------------------------------+-- Host endian, unaligned, word64 writes++writeWord64N1Host  = fromWrite1List  writeWord64host . word64List+writeWord64N2Host  = fromWrite2List  writeWord64host . word64List+writeWord64N4Host  = fromWrite4List  writeWord64host . word64List+writeWord64N8Host  = fromWrite8List  writeWord64host . word64List+writeWord64N16Host = fromWrite16List writeWord64host . word64List++

@@ -0,0 +1,742 @@+{-# LANGUAGE BangPatterns #-}+module Throughput.BlazePut (serialize) where++import qualified Data.ByteString.Lazy as L+import Blaze.ByteString.Builder +import Throughput.BlazePutMonad as Put+import Data.Monoid++import Throughput.Utils+++------------------------------------------------------------------------++serialize :: Int -> Int -> Endian -> Int -> L.ByteString+serialize wordSize chunkSize end = runPut . +  case (wordSize, chunkSize, end) of+    (1, 1,_)   -> writeByteN1+    (1, 2,_)   -> writeByteN2+    (1, 4,_)   -> writeByteN4+    (1, 8,_)   -> writeByteN8+    (1, 16, _) -> writeByteN16++    (2, 1,  Big)    -> writeWord16N1Big+    (2, 2,  Big)    -> writeWord16N2Big+    (2, 4,  Big)    -> writeWord16N4Big+    (2, 8,  Big)    -> writeWord16N8Big+    (2, 16, Big)    -> writeWord16N16Big+    (2, 1,  Little) -> writeWord16N1Little+    (2, 2,  Little) -> writeWord16N2Little+    (2, 4,  Little) -> writeWord16N4Little+    (2, 8,  Little) -> writeWord16N8Little+    (2, 16, Little) -> writeWord16N16Little+    (2, 1,  Host)   -> writeWord16N1Host+    (2, 2,  Host)   -> writeWord16N2Host+    (2, 4,  Host)   -> writeWord16N4Host+    (2, 8,  Host)   -> writeWord16N8Host+    (2, 16, Host)   -> writeWord16N16Host++    (4, 1,  Big)    -> writeWord32N1Big+    (4, 2,  Big)    -> writeWord32N2Big+    (4, 4,  Big)    -> writeWord32N4Big+    (4, 8,  Big)    -> writeWord32N8Big+    (4, 16, Big)    -> writeWord32N16Big+    (4, 1,  Little) -> writeWord32N1Little+    (4, 2,  Little) -> writeWord32N2Little+    (4, 4,  Little) -> writeWord32N4Little+    (4, 8,  Little) -> writeWord32N8Little+    (4, 16, Little) -> writeWord32N16Little+    (4, 1,  Host)   -> writeWord32N1Host+    (4, 2,  Host)   -> writeWord32N2Host+    (4, 4,  Host)   -> writeWord32N4Host+    (4, 8,  Host)   -> writeWord32N8Host+    (4, 16, Host)   -> writeWord32N16Host++    (8, 1,  Host)        -> writeWord64N1Host+    (8, 2,  Host)        -> writeWord64N2Host+    (8, 4,  Host)        -> writeWord64N4Host+    (8, 8,  Host)        -> writeWord64N8Host+    (8, 16, Host)        -> writeWord64N16Host+    (8, 1,  Big)         -> writeWord64N1Big+    (8, 2,  Big)         -> writeWord64N2Big+    (8, 4,  Big)         -> writeWord64N4Big+    (8, 8,  Big)         -> writeWord64N8Big+    (8, 16, Big)         -> writeWord64N16Big+    (8, 1,  Little)      -> writeWord64N1Little+    (8, 2,  Little)      -> writeWord64N2Little+    (8, 4,  Little)      -> writeWord64N4Little+    (8, 8,  Little)      -> writeWord64N8Little+    (8, 16, Little)      -> writeWord64N16Little++------------------------------------------------------------------------++writeByteN1 bytes = loop 0 0+  where loop !s !n | n == bytes = return ()+                   | otherwise  = do +                       Put.putWrite ( writeWord8 s)+                       loop (s+1) (n+1)++writeByteN2 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do+          do Put.putWrite (+               writeWord8 (s+0) `mappend`+               writeWord8 (s+1))+             loop (s+2) (n-2)++writeByteN4 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord8 (s+0) `mappend`+            writeWord8 (s+1) `mappend`+            writeWord8 (s+2) `mappend`+            writeWord8 (s+3))+          loop (s+4) (n-4)++writeByteN8 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord8 (s+0) `mappend`+            writeWord8 (s+1) `mappend`+            writeWord8 (s+2) `mappend`+            writeWord8 (s+3) `mappend`+            writeWord8 (s+4) `mappend`+            writeWord8 (s+5) `mappend`+            writeWord8 (s+6) `mappend`+            writeWord8 (s+7))+          loop (s+8) (n-8)++writeByteN16 = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord8 (s+0) `mappend`+            writeWord8 (s+1) `mappend`+            writeWord8 (s+2) `mappend`+            writeWord8 (s+3) `mappend`+            writeWord8 (s+4) `mappend`+            writeWord8 (s+5) `mappend`+            writeWord8 (s+6) `mappend`+            writeWord8 (s+7) `mappend`+            writeWord8 (s+8) `mappend`+            writeWord8 (s+9) `mappend`+            writeWord8 (s+10) `mappend`+            writeWord8 (s+11) `mappend`+            writeWord8 (s+12) `mappend`+            writeWord8 (s+13) `mappend`+            writeWord8 (s+14) `mappend`+            writeWord8 (s+15))+          loop (s+16) (n-16)++------------------------------------------------------------------------+-- Big endian, word16 writes++writeWord16N1Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWord16be (s+0)+          loop (s+1) (n-1)++writeWord16N2Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord16be (s+0) `mappend`+            writeWord16be (s+1))+          loop (s+2) (n-2)++writeWord16N4Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord16be (s+0) `mappend`+            writeWord16be (s+1) `mappend`+            writeWord16be (s+2) `mappend`+            writeWord16be (s+3))+          loop (s+4) (n-4)++writeWord16N8Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord16be (s+0) `mappend`+            writeWord16be (s+1) `mappend`+            writeWord16be (s+2) `mappend`+            writeWord16be (s+3) `mappend`+            writeWord16be (s+4) `mappend`+            writeWord16be (s+5) `mappend`+            writeWord16be (s+6) `mappend`+            writeWord16be (s+7))+          loop (s+8) (n-8)++writeWord16N16Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord16be (s+0) `mappend`+            writeWord16be (s+1) `mappend`+            writeWord16be (s+2) `mappend`+            writeWord16be (s+3) `mappend`+            writeWord16be (s+4) `mappend`+            writeWord16be (s+5) `mappend`+            writeWord16be (s+6) `mappend`+            writeWord16be (s+7) `mappend`+            writeWord16be (s+8) `mappend`+            writeWord16be (s+9) `mappend`+            writeWord16be (s+10) `mappend`+            writeWord16be (s+11) `mappend`+            writeWord16be (s+12) `mappend`+            writeWord16be (s+13) `mappend`+            writeWord16be (s+14) `mappend`+            writeWord16be (s+15))+          loop (s+16) (n-16)++------------------------------------------------------------------------+-- Little endian, word16 writes++writeWord16N1Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = +          do Put.putWord16le (s+0)+             loop (s+1) (n-1)++writeWord16N2Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord16le (s+0) `mappend`+            writeWord16le (s+1))+          loop (s+2) (n-2)++writeWord16N4Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord16le (s+0) `mappend`+            writeWord16le (s+1) `mappend`+            writeWord16le (s+2) `mappend`+            writeWord16le (s+3))+          loop (s+4) (n-4)++writeWord16N8Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord16le (s+0) `mappend`+            writeWord16le (s+1) `mappend`+            writeWord16le (s+2) `mappend`+            writeWord16le (s+3) `mappend`+            writeWord16le (s+4) `mappend`+            writeWord16le (s+5) `mappend`+            writeWord16le (s+6) `mappend`+            writeWord16le (s+7))+          loop (s+8) (n-8)++writeWord16N16Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord16le (s+0) `mappend`+            writeWord16le (s+1) `mappend`+            writeWord16le (s+2) `mappend`+            writeWord16le (s+3) `mappend`+            writeWord16le (s+4) `mappend`+            writeWord16le (s+5) `mappend`+            writeWord16le (s+6) `mappend`+            writeWord16le (s+7) `mappend`+            writeWord16le (s+8) `mappend`+            writeWord16le (s+9) `mappend`+            writeWord16le (s+10) `mappend`+            writeWord16le (s+11) `mappend`+            writeWord16le (s+12) `mappend`+            writeWord16le (s+13) `mappend`+            writeWord16le (s+14) `mappend`+            writeWord16le (s+15))+          loop (s+16) (n-16)++------------------------------------------------------------------------+-- Host endian, unaligned, word16 writes++writeWord16N1Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWord16host (s+0)+          loop (s+1) (n-1)++writeWord16N2Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord16host (s+0) `mappend`+            writeWord16host (s+1))+          loop (s+2) (n-2)++writeWord16N4Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord16host (s+0) `mappend`+            writeWord16host (s+1) `mappend`+            writeWord16host (s+2) `mappend`+            writeWord16host (s+3))+          loop (s+4) (n-4)++writeWord16N8Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord16host (s+0) `mappend`+            writeWord16host (s+1) `mappend`+            writeWord16host (s+2) `mappend`+            writeWord16host (s+3) `mappend`+            writeWord16host (s+4) `mappend`+            writeWord16host (s+5) `mappend`+            writeWord16host (s+6) `mappend`+            writeWord16host (s+7))+          loop (s+8) (n-8)++writeWord16N16Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord16host (s+0) `mappend`+            writeWord16host (s+1) `mappend`+            writeWord16host (s+2) `mappend`+            writeWord16host (s+3) `mappend`+            writeWord16host (s+4) `mappend`+            writeWord16host (s+5) `mappend`+            writeWord16host (s+6) `mappend`+            writeWord16host (s+7) `mappend`+            writeWord16host (s+8) `mappend`+            writeWord16host (s+9) `mappend`+            writeWord16host (s+10) `mappend`+            writeWord16host (s+11) `mappend`+            writeWord16host (s+12) `mappend`+            writeWord16host (s+13) `mappend`+            writeWord16host (s+14) `mappend`+            writeWord16host (s+15))+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord32N1Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWord32be (s+0)+          loop (s+1) (n-1)++writeWord32N2Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord32be (s+0) `mappend`+            writeWord32be (s+1))+          loop (s+2) (n-2)++writeWord32N4Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord32be (s+0) `mappend`+            writeWord32be (s+1) `mappend`+            writeWord32be (s+2) `mappend`+            writeWord32be (s+3))+          loop (s+4) (n-4)++writeWord32N8Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord32be (s+0) `mappend`+            writeWord32be (s+1) `mappend`+            writeWord32be (s+2) `mappend`+            writeWord32be (s+3) `mappend`+            writeWord32be (s+4) `mappend`+            writeWord32be (s+5) `mappend`+            writeWord32be (s+6) `mappend`+            writeWord32be (s+7))+          loop (s+8) (n-8)++writeWord32N16Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord32be (s+0) `mappend`+            writeWord32be (s+1) `mappend`+            writeWord32be (s+2) `mappend`+            writeWord32be (s+3) `mappend`+            writeWord32be (s+4) `mappend`+            writeWord32be (s+5) `mappend`+            writeWord32be (s+6) `mappend`+            writeWord32be (s+7) `mappend`+            writeWord32be (s+8) `mappend`+            writeWord32be (s+9) `mappend`+            writeWord32be (s+10) `mappend`+            writeWord32be (s+11) `mappend`+            writeWord32be (s+12) `mappend`+            writeWord32be (s+13) `mappend`+            writeWord32be (s+14) `mappend`+            writeWord32be (s+15))+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord32N1Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWord32le (s+0)+          loop (s+1) (n-1)++writeWord32N2Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord32le (s+0) `mappend`+            writeWord32le (s+1))+          loop (s+2) (n-2)++writeWord32N4Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord32le (s+0) `mappend`+            writeWord32le (s+1) `mappend`+            writeWord32le (s+2) `mappend`+            writeWord32le (s+3))+          loop (s+4) (n-4)++writeWord32N8Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord32le (s+0) `mappend`+            writeWord32le (s+1) `mappend`+            writeWord32le (s+2) `mappend`+            writeWord32le (s+3) `mappend`+            writeWord32le (s+4) `mappend`+            writeWord32le (s+5) `mappend`+            writeWord32le (s+6) `mappend`+            writeWord32le (s+7))+          loop (s+8) (n-8)++writeWord32N16Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord32le (s+0) `mappend`+            writeWord32le (s+1) `mappend`+            writeWord32le (s+2) `mappend`+            writeWord32le (s+3) `mappend`+            writeWord32le (s+4) `mappend`+            writeWord32le (s+5) `mappend`+            writeWord32le (s+6) `mappend`+            writeWord32le (s+7) `mappend`+            writeWord32le (s+8) `mappend`+            writeWord32le (s+9) `mappend`+            writeWord32le (s+10) `mappend`+            writeWord32le (s+11) `mappend`+            writeWord32le (s+12) `mappend`+            writeWord32le (s+13) `mappend`+            writeWord32le (s+14) `mappend`+            writeWord32le (s+15))+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord32N1Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWord32host (s+0)+          loop (s+1) (n-1)++writeWord32N2Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord32host (s+0) `mappend`+            writeWord32host (s+1))+          loop (s+2) (n-2)++writeWord32N4Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord32host (s+0) `mappend`+            writeWord32host (s+1) `mappend`+            writeWord32host (s+2) `mappend`+            writeWord32host (s+3))+          loop (s+4) (n-4)++writeWord32N8Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord32host (s+0) `mappend`+            writeWord32host (s+1) `mappend`+            writeWord32host (s+2) `mappend`+            writeWord32host (s+3) `mappend`+            writeWord32host (s+4) `mappend`+            writeWord32host (s+5) `mappend`+            writeWord32host (s+6) `mappend`+            writeWord32host (s+7))+          loop (s+8) (n-8)++writeWord32N16Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord32host (s+0) `mappend`+            writeWord32host (s+1) `mappend`+            writeWord32host (s+2) `mappend`+            writeWord32host (s+3) `mappend`+            writeWord32host (s+4) `mappend`+            writeWord32host (s+5) `mappend`+            writeWord32host (s+6) `mappend`+            writeWord32host (s+7) `mappend`+            writeWord32host (s+8) `mappend`+            writeWord32host (s+9) `mappend`+            writeWord32host (s+10) `mappend`+            writeWord32host (s+11) `mappend`+            writeWord32host (s+12) `mappend`+            writeWord32host (s+13) `mappend`+            writeWord32host (s+14) `mappend`+            writeWord32host (s+15))+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord64N1Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWord64be (s+0)+          loop (s+1) (n-1)++writeWord64N2Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord64be (s+0) `mappend`+            writeWord64be (s+1))+          loop (s+2) (n-2)++writeWord64N4Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord64be (s+0) `mappend`+            writeWord64be (s+1) `mappend`+            writeWord64be (s+2) `mappend`+            writeWord64be (s+3))+          loop (s+4) (n-4)++writeWord64N8Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord64be (s+0) `mappend`+            writeWord64be (s+1) `mappend`+            writeWord64be (s+2) `mappend`+            writeWord64be (s+3) `mappend`+            writeWord64be (s+4) `mappend`+            writeWord64be (s+5) `mappend`+            writeWord64be (s+6) `mappend`+            writeWord64be (s+7))+          loop (s+8) (n-8)++writeWord64N16Big = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord64be (s+0) `mappend`+            writeWord64be (s+1) `mappend`+            writeWord64be (s+2) `mappend`+            writeWord64be (s+3) `mappend`+            writeWord64be (s+4) `mappend`+            writeWord64be (s+5) `mappend`+            writeWord64be (s+6) `mappend`+            writeWord64be (s+7) `mappend`+            writeWord64be (s+8) `mappend`+            writeWord64be (s+9) `mappend`+            writeWord64be (s+10) `mappend`+            writeWord64be (s+11) `mappend`+            writeWord64be (s+12) `mappend`+            writeWord64be (s+13) `mappend`+            writeWord64be (s+14) `mappend`+            writeWord64be (s+15))+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord64N1Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWord64le (s+0)+          loop (s+1) (n-1)++writeWord64N2Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord64le (s+0) `mappend`+            writeWord64le (s+1))+          loop (s+2) (n-2)++writeWord64N4Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord64le (s+0) `mappend`+            writeWord64le (s+1) `mappend`+            writeWord64le (s+2) `mappend`+            writeWord64le (s+3))+          loop (s+4) (n-4)++writeWord64N8Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord64le (s+0) `mappend`+            writeWord64le (s+1) `mappend`+            writeWord64le (s+2) `mappend`+            writeWord64le (s+3) `mappend`+            writeWord64le (s+4) `mappend`+            writeWord64le (s+5) `mappend`+            writeWord64le (s+6) `mappend`+            writeWord64le (s+7))+          loop (s+8) (n-8)++writeWord64N16Little = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord64le (s+0) `mappend`+            writeWord64le (s+1) `mappend`+            writeWord64le (s+2) `mappend`+            writeWord64le (s+3) `mappend`+            writeWord64le (s+4) `mappend`+            writeWord64le (s+5) `mappend`+            writeWord64le (s+6) `mappend`+            writeWord64le (s+7) `mappend`+            writeWord64le (s+8) `mappend`+            writeWord64le (s+9) `mappend`+            writeWord64le (s+10) `mappend`+            writeWord64le (s+11) `mappend`+            writeWord64le (s+12) `mappend`+            writeWord64le (s+13) `mappend`+            writeWord64le (s+14) `mappend`+            writeWord64le (s+15))+          loop (s+16) (n-16)++------------------------------------------------------------------------++writeWord64N1Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWord64host (s+0)+          loop (s+1) (n-1)++writeWord64N2Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord64host (s+0) `mappend`+            writeWord64host (s+1))+          loop (s+2) (n-2)++writeWord64N4Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord64host (s+0) `mappend`+            writeWord64host (s+1) `mappend`+            writeWord64host (s+2) `mappend`+            writeWord64host (s+3))+          loop (s+4) (n-4)++writeWord64N8Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord64host (s+0) `mappend`+            writeWord64host (s+1) `mappend`+            writeWord64host (s+2) `mappend`+            writeWord64host (s+3) `mappend`+            writeWord64host (s+4) `mappend`+            writeWord64host (s+5) `mappend`+            writeWord64host (s+6) `mappend`+            writeWord64host (s+7))+          loop (s+8) (n-8)++writeWord64N16Host = loop 0+  where loop s n | s `seq` n `seq` False = undefined+        loop _ 0 = return ()+        loop s n = do +          Put.putWrite (+            writeWord64host (s+0) `mappend`+            writeWord64host (s+1) `mappend`+            writeWord64host (s+2) `mappend`+            writeWord64host (s+3) `mappend`+            writeWord64host (s+4) `mappend`+            writeWord64host (s+5) `mappend`+            writeWord64host (s+6) `mappend`+            writeWord64host (s+7) `mappend`+            writeWord64host (s+8) `mappend`+            writeWord64host (s+9) `mappend`+            writeWord64host (s+10) `mappend`+            writeWord64host (s+11) `mappend`+            writeWord64host (s+12) `mappend`+            writeWord64host (s+13) `mappend`+            writeWord64host (s+14) `mappend`+            writeWord64host (s+15))+          loop (s+16) (n-16)+

@@ -0,0 +1,222 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Binary.Put+-- Copyright   : Lennart Kolmodin+-- License     : BSD3-style (see LICENSE)+-- +-- Maintainer  : Lennart Kolmodin <kolmodin@dtek.chalmers.se>+-- Stability   : stable+-- Portability : Portable to Hugs and GHC. Requires MPTCs+--+-- The Put monad. A monad for efficiently constructing lazy bytestrings using+-- the Builder developed for blaze-html.+--+-----------------------------------------------------------------------------++module Throughput.BlazePutMonad (++    -- * The Put type+      Put+    , PutM(..)+    , runPut+    , runPutM+    , putBuilder+    , execPut++    -- * Flushing the implicit parse state+    , flush++    -- * Primitives+    , putWrite+    , putWord8+    , putByteString+    , putLazyByteString++    -- * Big-endian primitives+    , putWord16be+    , putWord32be+    , putWord64be++    -- * Little-endian primitives+    , putWord16le+    , putWord32le+    , putWord64le++    -- * Host-endian, unaligned writes+    , putWordhost           -- :: Word   -> Put+    , putWord16host         -- :: Word16 -> Put+    , putWord32host         -- :: Word32 -> Put+    , putWord64host         -- :: Word64 -> Put++  ) where++import Data.Monoid+import Blaze.ByteString.Builder (Builder, toLazyByteString)+import qualified Blaze.ByteString.Builder as B++import Data.Word+import qualified Data.ByteString      as S+import qualified Data.ByteString.Lazy as L++#ifdef APPLICATIVE_IN_BASE+import Control.Applicative+#endif+++------------------------------------------------------------------------++-- XXX Strict in buffer only. +data PairS a = PairS a {-# UNPACK #-}!Builder++sndS :: PairS a -> Builder+sndS (PairS _ b) = b++-- | The PutM type. A Writer monad over the efficient Builder monoid.+newtype PutM a = Put { unPut :: PairS a }++-- | Put merely lifts Builder into a Writer monad, applied to ().+type Put = PutM ()++instance Functor PutM where+        fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w+        {-# INLINE fmap #-}++#ifdef APPLICATIVE_IN_BASE+instance Applicative PutM where+        pure    = return+        m <*> k = Put $+            let PairS f w  = unPut m+                PairS x w' = unPut k+            in PairS (f x) (w `mappend` w')+#endif++-- Standard Writer monad, with aggressive inlining+instance Monad PutM where+    return a = Put $ PairS a mempty+    {-# INLINE return #-}++    m >>= k  = Put $+        let PairS a w  = unPut m+            PairS b w' = unPut (k a)+        in PairS b (w `mappend` w')+    {-# INLINE (>>=) #-}++    m >> k  = Put $+        let PairS _ w  = unPut m+            PairS b w' = unPut k+        in PairS b (w `mappend` w')+    {-# INLINE (>>) #-}++tell :: Builder -> Put+tell b = Put $ PairS () b+{-# INLINE tell #-}++putBuilder :: Builder -> Put+putBuilder = tell+{-# INLINE putBuilder #-}++-- | Run the 'Put' monad+execPut :: PutM a -> Builder+execPut = sndS . unPut+{-# INLINE execPut #-}++-- | Run the 'Put' monad with a serialiser+runPut :: Put -> L.ByteString+runPut = toLazyByteString . sndS . unPut+{-# INLINE runPut #-}++-- | Run the 'Put' monad with a serialiser and get its result+runPutM :: PutM a -> (a, L.ByteString)+runPutM (Put (PairS f s)) = (f, toLazyByteString s)+{-# INLINE runPutM #-}++------------------------------------------------------------------------++-- | Pop the ByteString we have constructed so far, if any, yielding a+-- new chunk in the result ByteString.+flush               :: Put+flush               = tell B.flush+{-# INLINE flush #-}++-- | Efficiently write a byte into the output buffer+putWord8            :: Word8 -> Put+putWord8            = tell . B.fromWord8+{-# INLINE putWord8 #-}++-- | Execute a write on the output buffer.+putWrite            :: B.Write -> Put+putWrite            = tell . B.fromWrite++-- | An efficient primitive to write a strict ByteString into the output buffer.+-- It flushes the current buffer, and writes the argument into a new chunk.+putByteString       :: S.ByteString -> Put+putByteString       = tell . B.fromByteString+{-# INLINE putByteString #-}++-- | Write a lazy ByteString efficiently, simply appending the lazy+-- ByteString chunks to the output buffer+putLazyByteString   :: L.ByteString -> Put+putLazyByteString   = tell . B.fromLazyByteString+{-# INLINE putLazyByteString #-}++-- | Write a Word16 in big endian format+putWord16be         :: Word16 -> Put+putWord16be         = tell . B.fromWord16be+{-# INLINE putWord16be #-}++-- | Write a Word16 in little endian format+putWord16le         :: Word16 -> Put+putWord16le         = tell . B.fromWord16le+{-# INLINE putWord16le #-}++-- | Write a Word32 in big endian format+putWord32be         :: Word32 -> Put+putWord32be         = tell . B.fromWord32be+{-# INLINE putWord32be #-}++-- | Write a Word32 in little endian format+putWord32le         :: Word32 -> Put+putWord32le         = tell . B.fromWord32le+{-# INLINE putWord32le #-}++-- | Write a Word64 in big endian format+putWord64be         :: Word64 -> Put+putWord64be         = tell . B.fromWord64be+{-# INLINE putWord64be #-}++-- | Write a Word64 in little endian format+putWord64le         :: Word64 -> Put+putWord64le         = tell . B.fromWord64le+{-# INLINE putWord64le #-}++------------------------------------------------------------------------++-- | /O(1)./ Write a single native machine word. The word is+-- written in host order, host endian form, for the machine you're on.+-- On a 64 bit machine the Word is an 8 byte value, on a 32 bit machine,+-- 4 bytes. Values written this way are not portable to+-- different endian or word sized machines, without conversion.+--+putWordhost         :: Word -> Put+putWordhost         = tell . B.fromWordhost+{-# INLINE putWordhost #-}++-- | /O(1)./ Write a Word16 in native host order and host endianness.+-- For portability issues see @putWordhost@.+putWord16host       :: Word16 -> Put+putWord16host       = tell . B.fromWord16host+{-# INLINE putWord16host #-}++-- | /O(1)./ Write a Word32 in native host order and host endianness.+-- For portability issues see @putWordhost@.+putWord32host       :: Word32 -> Put+putWord32host       = tell . B.fromWord32host+{-# INLINE putWord32host #-}++-- | /O(1)./ Write a Word64 in native host order+-- On a 32 bit machine we write two host order Word32s, in big endian form.+-- For portability issues see @putWordhost@.+putWord64host       :: Word64 -> Put+putWord64host       = tell . B.fromWord64host+{-# INLINE putWord64host #-}

@@ -0,0 +1,39 @@+#include "CBenchmark.h"++void bytewrite(unsigned char *a, int bytes) {+  unsigned char n = 0;+  int i = 0;+  int iterations = bytes;+  while (i < iterations) {+    a[i++] = n++;+  }+}++unsigned char byteread(unsigned char *a, int bytes) {+  unsigned char n = 0;+  int i = 0;+  int iterations = bytes;+  while (i < iterations) {+    n += a[i++];+  }+  return n;+}++void wordwrite(unsigned long *a, int bytes) {+  unsigned long n = 0;+  int i = 0;+  int iterations = bytes / sizeof(unsigned long) ;+  while (i < iterations) {+    a[i++] = n++;+  }+}++unsigned int wordread(unsigned long *a, int bytes) {+  unsigned long n = 0;+  int i = 0;+  int iterations = bytes / sizeof(unsigned long);+  while (i < iterations) {+    n += a[i++];+  }+  return n;+}

@@ -0,0 +1,4 @@+void bytewrite(unsigned char *a, int bytes);+unsigned char byteread(unsigned char *a, int bytes);+void wordwrite(unsigned long *a, int bytes);+unsigned int wordread(unsigned long *a, int bytes);

@@ -0,0 +1,98 @@+{-# LANGUAGE ForeignFunctionInterface, BangPatterns #-}+module Throughput.Memory (memBench) where++import Foreign+import Foreign.C++import Control.Exception+import System.CPUTime+import Numeric++memBench :: Int -> IO ()+memBench mb = do+  let bytes = mb * 2^20+  allocaBytes bytes $ \ptr -> do+    let bench label test = do+          seconds <- time $ test (castPtr ptr) (fromIntegral bytes)+          let throughput = fromIntegral mb / seconds+          putStrLn $ show mb ++ "MB of " ++ label+                  ++ " in " ++ showFFloat (Just 3) seconds "s, at: "+                  ++ showFFloat (Just 1) throughput "MB/s"+    bench "setup        " c_wordwrite+    putStrLn ""+    putStrLn "C memory throughput benchmarks:"+    bench "bytes written                     " c_bytewrite+    bench "bytes read                        " c_byteread+    bench "words written                     " c_wordwrite+    bench "words read                        " c_wordread+    putStrLn ""+    putStrLn "Haskell memory throughput benchmarks:"+    bench "bytes written                     " hs_bytewrite+    bench "bytes written (loop unrolled once)" hs_bytewrite2+    bench "bytes read                        " hs_byteread+    bench "words written                     " hs_wordwrite+    bench "words read                        " hs_wordread++hs_bytewrite  :: Ptr CUChar -> Int -> IO ()+hs_bytewrite !ptr bytes = loop 0 0+  where iterations = bytes+        loop :: Int -> CUChar -> IO ()+        loop !i !n | i == iterations = return ()+                   | otherwise = do pokeByteOff ptr i n+                                    loop (i+1) (n+1)++hs_bytewrite2  :: Ptr CUChar -> Int -> IO ()+hs_bytewrite2 !start bytes = loop start 0+  where end = start `plusPtr` bytes+        loop :: Ptr CUChar -> CUChar -> IO ()+        loop !ptr !n | ptr `plusPtr` 2 < end = do+                         poke ptr               n+                         poke (ptr `plusPtr` 1) (n+1)+                         loop (ptr `plusPtr` 2) (n+2)+                     | ptr `plusPtr` 1 < end =+                         poke ptr               n+                     | otherwise             = return ()++hs_byteread  :: Ptr CUChar -> Int -> IO CUChar+hs_byteread !ptr bytes = loop 0 0+  where iterations = bytes+        loop :: Int -> CUChar -> IO CUChar+        loop !i !n | i == iterations = return n+                   | otherwise = do x <- peekByteOff ptr i+                                    loop (i+1) (n+x)++hs_wordwrite :: Ptr CULong -> Int -> IO ()+hs_wordwrite !ptr bytes = loop 0 0+  where iterations = bytes `div` sizeOf (undefined :: CULong)+        loop :: Int -> CULong -> IO ()+        loop !i !n | i == iterations = return ()+                   | otherwise = do pokeByteOff ptr i n+                                    loop (i+1) (n+1)++hs_wordread  :: Ptr CULong -> Int -> IO CULong+hs_wordread !ptr bytes = loop 0 0+  where iterations = bytes `div` sizeOf (undefined :: CULong)+        loop :: Int -> CULong -> IO CULong+        loop !i !n | i == iterations = return n+                   | otherwise = do x <- peekByteOff ptr i+                                    loop (i+1) (n+x)+++foreign import ccall unsafe "CBenchmark.h byteread"+  c_byteread :: Ptr CUChar -> CInt -> IO ()++foreign import ccall unsafe "CBenchmark.h bytewrite"+  c_bytewrite :: Ptr CUChar -> CInt -> IO ()++foreign import ccall unsafe "CBenchmark.h wordread"+  c_wordread :: Ptr CUInt -> CInt -> IO ()++foreign import ccall unsafe "CBenchmark.h wordwrite"+  c_wordwrite :: Ptr CUInt -> CInt -> IO ()++time :: IO a -> IO Double+time action = do+    start <- getCPUTime+    action+    end   <- getCPUTime+    return $! (fromIntegral (end - start)) / (10^12)

@@ -0,0 +1,12 @@+module Throughput.Utils (+  Endian(..)  +) where+++data Endian+    = Big+    | Little+    | Host+    deriving (Eq,Ord,Show)++

@@ -1,29 +1,56 @@ Name:                blaze-builder-Version:             0.1-Synopsis:            Builder to efficiently append text.-Description:         Builder to efficiently append text, optimized for-                     HTML generation. There is a small usage example in the-                     Text.Blaze.Builder.Core module, you should begin by-                     reading that.-Homepage:            http://jaspervdj.be/blaze-Bug-Reports:         http://github.com/jaspervdj/BlazeHtml/issues+Version:             0.2.0.0+Synopsis:            Efficient construction of bytestrings.++Description:         +                     This library provides an abstraction of buffered output of+                     byte streams and several convenience functions to exploit+                     it. For example, it allows to efficiently serialize+                     Haskell values to lazy bytestrings with a large average+                     chunk size. The large average chunk size allows to make+                     good use of cache prefetching in later processing steps+                     (e.g. compression) and reduces the sytem call overhead+                     when writing the resulting lazy bytestring to a file or+                     sending it over the network.++Homepage:            http://github.com/jaspervdj/blaze-builder+Bug-Reports:         http://github.com/jaspervdj/blaze-builder/issues License:             BSD3 License-file:        LICENSE Author:              Jasper Van der Jeugt, Simon Meier-Maintainer:          jaspervdj@gmail.com, simon.meier@inf.ethz.ch+Maintainer:          jaspervdj@gmail.com, iridcode@gmail.com Stability:           Experimental-Category:            Text+Category:            Data Build-type:          Simple-Cabal-version:       >=1.2+Cabal-version:       >= 1.6++Extra-source-files:  +                     Makefile+                     README.markdown+                     TODO+                     CHANGES++                     benchmarks/*.hs+                     benchmarks/Throughput/*.hs+                     benchmarks/Throughput/*.h+                     benchmarks/Throughput/*.c++                     tests/*.hs+ Library-  Ghc-Options:       -Wall+  ghc-options:       -Wall -  -- Modules exported by the library.-  Exposed-modules:   Text.Blaze.Builder.Core-                     Text.Blaze.Builder.Utf8-                     Text.Blaze.Builder.Html+  exposed-modules:   Blaze.ByteString.Builder+                     Blaze.ByteString.Builder.Write+                     Blaze.ByteString.Builder.Int+                     Blaze.ByteString.Builder.Word+                     Blaze.ByteString.Builder.ByteString+                     Blaze.ByteString.Builder.Char.Utf8+                     Blaze.ByteString.Builder.Html.Utf8++                     Blaze.ByteString.Builder.Internal   -  -- Packages needed in order to build this package.-  Build-depends:     base >= 4 && < 5,-                     text >= 0.7,-                     bytestring >= 0.9+  -- FIXME: Ensure dependencies are strict enough+  build-depends:     base == 4.* ,+                     bytestring == 0.9.* ,+                     text == 0.10.*

@@ -0,0 +1,35 @@+-- Author: Simon Meier <iridcode@gmail.com>, 10/06/2010+--+-- Attempt to find a small test-case for the segfaults that happen when+-- compiling the benchmarks with LLVM and GHC-7.0.1+--+module LlvmSegfault where++import Data.Word+import Data.Monoid+import qualified Data.ByteString.Lazy as L++import Foreign++import Blaze.ByteString.Builder.Internal++++fromWord8 :: Word8 -> Builder+fromWord8 w =+    Builder step+  where+    step k pf pe+      | pf < pe = do+          poke pf w+          let pf' = pf `plusPtr` 1+          pf' `seq` k pf' pe+      | otherwise               = return $ BufferFull 1 pf (step k)+++word8s :: Builder+word8s = map (fromWord8 . fromIntegral) $ [(1::Int)..1000]++main :: IO ()+main = +    print $ toLazyByteStringWith 10 10 (mconcat word8s) L.empty

@@ -0,0 +1,96 @@+-- | Tests for the Blaze builder+--+{-# LANGUAGE OverloadedStrings #-}+module Tests where++import Control.Applicative ((<$>))+import Data.Monoid (mempty, mappend, mconcat)++import qualified Data.Text as T+import qualified Data.ByteString.Lazy as LB+import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.Framework.Providers.HUnit+import Test.QuickCheck+import Test.HUnit hiding (Test)+import Codec.Binary.UTF8.String (decode)++import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char.Utf8+import Blaze.ByteString.Builder.Html.Utf8++main :: IO ()+main = defaultMain $ return $ testGroup "Tests" tests++tests :: [Test]+tests =+    [ testProperty "left identity Monoid law"  monoidLeftIdentity+    , testProperty "right identity Monoid law" monoidRightIdentity+    , testProperty "associativity Monoid law"  monoidAssociativity+    , testProperty "mconcat Monoid law"        monoidConcat+    , testProperty "string → builder → string" fromStringToString+    , testProperty "string and text"           stringAndText+    , testProperty "lazy bytestring identity"  identityLazyByteString+    , testProperty "flushing identity"         identityFlushing+    , testCase     "escaping case 1"           escaping1+    , testCase     "escaping case 2"           escaping2+    , testCase     "escaping case 3"           escaping3+    ]++monoidLeftIdentity :: Builder -> Bool+monoidLeftIdentity b = mappend mempty b == b++monoidRightIdentity :: Builder -> Bool+monoidRightIdentity b = mappend b mempty == b++monoidAssociativity :: Builder -> Builder -> Builder -> Bool+monoidAssociativity x y z = mappend x (mappend y z) == mappend (mappend x y) z++monoidConcat :: [Builder] -> Bool+monoidConcat xs = mconcat xs == foldr mappend mempty xs++fromStringToString :: String -> Bool+fromStringToString string = string == convert string+  where+    convert = decode . LB.unpack . toLazyByteString . fromString++stringAndText :: String -> Bool+stringAndText string = fromString string == fromText (T.pack string)++identityLazyByteString :: LB.ByteString -> Bool+identityLazyByteString lbs = lbs == toLazyByteString (fromLazyByteString lbs)++identityFlushing :: String -> String -> Bool+identityFlushing s1 s2 =+    let b1 = fromString s1+        b2 = fromString s2+    in b1 `mappend` b2 == b1 `mappend` flush `mappend` b2++escaping1 :: Assertion+escaping1 = fromString "&lt;hello&gt;" @?= fromHtmlEscapedString "<hello>"++escaping2 :: Assertion+escaping2 = fromString "f &amp;&amp;&amp; g" @?= fromHtmlEscapedString "f &&& g"++escaping3 :: Assertion+escaping3 = fromString "&quot;&apos;" @?= fromHtmlEscapedString "\"'"++instance Show Builder where+    show = show . toLazyByteString++instance Eq Builder where+    b1 == b2 = +        -- different and small buffer sizses for testing wrapping behaviour+        toLazyByteStringWith  1024     1024 256 b1 mempty ==+        toLazyByteStringWith  2001     511  256 b2 mempty++-- | Artificially scale up size to ensures that buffer wrapping behaviour is+-- also tested.+numRepetitions :: Int+numRepetitions = 250++instance Arbitrary Builder where+    arbitrary = (mconcat . replicate numRepetitions . fromString) <$> arbitrary++instance Arbitrary LB.ByteString where+    arbitrary = (LB.concat . replicate numRepetitions . LB.pack) <$> arbitrary