buffer-builder 0.2.0.3 → 0.2.1.0

raw patch · 17 files changed

+1829/−1353 lines, 17 filesdep +http-typesdep +json-builderdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: http-types, json-builder

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/BufferBuilder.hs +0/−267
• Data/BufferBuilder/Json.hs +0/−324
• Data/BufferBuilder/Utf8.hs +0/−174
• bench/JsonBench.hs +61/−9
• bench/UrlBench.hs +224/−0
• branchlut.cpp +0/−275
• branchlut.h +0/−11
• buffer-builder.cabal +21/−4
• buffer.cpp +0/−289
• cbits/branchlut.cpp +271/−0
• cbits/branchlut.h +11/−0
• cbits/buffer.cpp +395/−0
• changelog.md +3/−0
• src/Data/BufferBuilder.hs +331/−0
• src/Data/BufferBuilder/Json.hs +324/−0
• src/Data/BufferBuilder/Utf8.hs +174/−0
• test/BufferTest.hs +14/−0

@@ -1,267 +0,0 @@-{-# LANGUAGE OverloadedStrings, MagicHash, UnboxedTuples, BangPatterns, GeneralizedNewtypeDeriving #-}--{-|-A library for efficiently building up a buffer of data.  When given data-known to be strict, use of BufferBuilder compiles directly into a series-of efficient C function calls.--}-module Data.BufferBuilder (--    -- * The BufferBuilder Monad-      BufferBuilder-    , runBufferBuilder--    -- * Appending bytes and byte strings-    , appendByte-    , appendChar8-    , appendBS-    , appendLBS-    , appendLiteral-    , unsafeAppendLiteralN--    -- * Appending bytes and byte strings, truncated to 7 bits-    , appendByte7-    , appendChar7-    , appendBS7-    , appendLiteral7-    , unsafeAppendLiteralN7--    -- * UTF-8 encoding-    , appendCharUtf8-    , appendStringUtf8--    -- * Printing numbers-    , appendDecimalSignedInt-    , appendDecimalDouble--    -- * JSON escaping-    , appendEscapedJson-    , appendEscapedJsonLiteral-    , appendEscapedJsonText-    ) where--import GHC.Base-import GHC.Word-import GHC.Ptr-import GHC.IO-import GHC.ForeignPtr-import Foreign.ForeignPtr-import Foreign.Marshal.Alloc-import qualified Data.ByteString as BS-import qualified Data.ByteString.Internal as BS-import qualified Data.ByteString.Lazy as BSL-import Control.Monad.Reader-import Control.Applicative (Applicative)--import Data.Text () -- Show-import Data.Text.Internal (Text (..))-import Data.Text.Array (Array (..))--data Handle'-type Handle = Ptr Handle'--foreign import ccall unsafe "strlen" c_strlen :: Ptr Word8 -> IO Int-foreign import ccall unsafe "bw_new" bw_new :: Int -> IO Handle-foreign import ccall unsafe "&bw_free" bw_free :: FunPtr (Handle -> IO ())-foreign import ccall unsafe "bw_get_size" bw_get_size :: Handle -> IO Int-foreign import ccall unsafe "bw_trim_and_release_address" bw_trim_and_release_address :: Handle -> IO (Ptr Word8)--foreign import ccall unsafe "bw_append_byte" bw_append_byte :: Handle -> Word8 -> IO ()-foreign import ccall unsafe "bw_append_char_utf8" bw_append_char_utf8 :: Handle -> Char -> IO ()-foreign import ccall unsafe "bw_append_bs" bw_append_bs :: Handle -> Int -> Ptr Word8 -> IO ()-foreign import ccall unsafe "bw_append_bsz" bw_append_bsz :: Handle -> Ptr Word8 -> IO ()--foreign import ccall unsafe "bw_append_byte7" bw_append_byte7 :: Handle -> Word8 -> IO ()-foreign import ccall unsafe "bw_append_bs7" bw_append_bs7 :: Handle -> Int -> Ptr Word8 -> IO ()-foreign import ccall unsafe "bw_append_bsz7" bw_append_bsz7 :: Handle -> Ptr Word8 -> IO ()--foreign import ccall unsafe "bw_append_decimal_signed_int" bw_append_decimal_signed_int :: Handle -> Int -> IO ()-foreign import ccall unsafe "bw_append_decimal_double" bw_append_decimal_double :: Handle -> Double -> IO ()--foreign import ccall unsafe "bw_append_json_escaped" bw_append_json_escaped :: Handle -> Int -> Ptr Word8 -> IO ()-foreign import ccall unsafe "bw_append_json_escaped_utf16" bw_append_json_escaped_utf16 :: Handle -> Int -> Ptr Word16 -> IO ()---- | BufferBuilder is the type of a monadic action that appends to an implicit,--- growable buffer.  Use 'runBufferBuilder' to extract the resulting--- buffer as a 'BS.ByteString'.  -newtype BufferBuilder a = BB (ReaderT Handle IO a)-    deriving (Functor, Applicative, Monad, MonadReader Handle)--inBW :: IO a -> BufferBuilder a-inBW = BB . lift-{-# INLINE inBW #-}--withHandle :: (Handle -> IO ()) -> BufferBuilder ()-withHandle action = do-    h <- ask-    inBW $ action h-{-# INLINE withHandle #-}--initialCapacity :: Int-initialCapacity = 20480--- why 48? it's only 6 64-bit words...  yet many small strings should fit.--- some quantitative analysis would be good.--- an option to set the initial capacity would be better. :)---- | Run a sequence of 'BufferBuilder' actions and extract the resulting--- buffer as a 'BS.ByteString'.-runBufferBuilder :: BufferBuilder () -> BS.ByteString-runBufferBuilder = unsafeDupablePerformIO . runBufferBuilderIO initialCapacity--runBufferBuilderIO :: Int -> BufferBuilder () -> IO BS.ByteString-runBufferBuilderIO !capacity !(BB bw) = do-    handle <- bw_new capacity-    handleFP <- newForeignPtr bw_free handle-    () <- runReaderT bw handle-    size <- bw_get_size handle-    src <- bw_trim_and_release_address handle--    borrowed <- newForeignPtr finalizerFree src-    let bs = BS.fromForeignPtr borrowed 0 size-    touchForeignPtr handleFP-    return bs---- | Append a single byte to the output buffer.  To append multiple bytes in sequence and--- avoid redundant bounds checks, consider using 'appendBS', 'appendLiteral', or 'unsafeAppendLiteralN'.-appendByte :: Word8 -> BufferBuilder ()-appendByte b = withHandle $ \h -> bw_append_byte h b-{-# INLINE appendByte #-}--c2w :: Char -> Word8-c2w = fromIntegral . ord-{-# INLINE c2w #-}---- | Appends a character to the buffer, truncating it to the bottom 8 bits.-appendChar8 :: Char -> BufferBuilder ()-appendChar8 = appendByte . c2w-{-# INLINE appendChar8 #-}---- | Appends a 'BS.ByteString' to the buffer.  When appending constant, hardcoded strings, to--- avoid a CAF and the costs of its associated tag check and indirect jump, use--- 'appendLiteral' or 'unsafeAppendLiteralN' instead.-appendBS :: BS.ByteString -> BufferBuilder ()-appendBS !(BS.PS fp offset len) =-    withHandle $ \h ->-        withForeignPtr fp $ \addr ->-            bw_append_bs h len (plusPtr addr offset)-{-# INLINE appendBS #-}---- | Appends a lazy 'BSL.ByteString' to the buffer.  This function operates by traversing--- the lazy 'BSL.ByteString' chunks, appending each in turn.-appendLBS :: BSL.ByteString -> BufferBuilder ()-appendLBS lbs = mapM_ appendBS $ BSL.toChunks lbs-{-# INLINABLE appendLBS #-}---- | Appends a zero-terminated MagicHash string literal.  Use this function instead of--- 'appendBS' for string constants.  For example:------ > appendLiteral "true"#------ If the length of the string literal is known, calling--- 'unsafeAppendLiteralN' is faster, as 'unsafeAppendLiteralN' avoids a strlen--- operation which has nontrivial cost in some benchmarks.-appendLiteral :: Addr# -> BufferBuilder ()-appendLiteral addr =-    withHandle $ \h ->-        bw_append_bsz h (Ptr addr)-{-# INLINE appendLiteral #-}---- | Appends a MagicHash string literal with a known length.  Use this when the--- string literal's length is known.  For example:------ > unsafeAppendLiteralN 4 "true"#------ Per byte, this is the fastest append function.  It amounts to a C function call--- with two constant arguments.  The C function checks to see if it needs to grow--- the buffer and then it simply calls memcpy.--- --- __WARNING__: passing an incorrect length value is likely to cause an access--- violation or worse.-unsafeAppendLiteralN :: Int -> Addr# -> BufferBuilder ()-unsafeAppendLiteralN len addr =-    withHandle $ \h ->-        bw_append_bs h len (Ptr addr)-{-# INLINE unsafeAppendLiteralN #-}----- 7-bit truncation--appendByte7 :: Word8 -> BufferBuilder ()-appendByte7 b = withHandle $ \h -> bw_append_byte7 h b-{-# INLINE appendByte7 #-}--appendChar7 :: Char -> BufferBuilder ()-appendChar7 = appendByte7 . c2w-{-# INLINE appendChar7 #-}--appendBS7 :: BS.ByteString -> BufferBuilder ()-appendBS7 !(BS.PS fp offset len) =-    withHandle $ \h ->-        withForeignPtr fp $ \addr ->-            bw_append_bs7 h len (plusPtr addr offset)-{-# INLINE appendBS7 #-}--appendLiteral7 :: Addr# -> BufferBuilder ()-appendLiteral7 addr =-    withHandle $ \h ->-        bw_append_bsz7 h (Ptr addr)-{-# INLINE appendLiteral7 #-}--unsafeAppendLiteralN7 :: Int -> Addr# -> BufferBuilder ()-unsafeAppendLiteralN7 len addr =-    withHandle $ \h ->-        bw_append_bs7 h len (Ptr addr)-{-# INLINE unsafeAppendLiteralN7 #-}---- Encoding UTF-8---- | Appends a UTF-8-encoded 'Char' to the buffer.-appendCharUtf8 :: Char -> BufferBuilder ()-appendCharUtf8 c = withHandle $ \h -> bw_append_char_utf8 h c-{-# INLINE appendCharUtf8 #-}---- | Appends a UTF-8-encoded 'String' to the buffer.  The best way to improve performance here--- is to use 'BS.ByteString' or 'Text' instead of 'String'.-appendStringUtf8 :: String -> BufferBuilder ()-appendStringUtf8 = mapM_ appendCharUtf8-{-# INLINABLE appendStringUtf8 #-}----- Printing Numbers---- | Appends a decimal integer, just like calling printf("%d", ...)-appendDecimalSignedInt :: Int -> BufferBuilder ()-appendDecimalSignedInt i =-    withHandle $ \h ->-        bw_append_decimal_signed_int h i-{-# INLINE appendDecimalSignedInt #-}---- | Appends a decimal double, just like calling printf("%f", ...)-appendDecimalDouble :: Double -> BufferBuilder ()-appendDecimalDouble d =-    withHandle $ \h ->-        bw_append_decimal_double h d-{-# INLINE appendDecimalDouble #-}----- Encoding JSON--appendEscapedJson :: BS.ByteString -> BufferBuilder ()-appendEscapedJson !(BS.PS (ForeignPtr addr _) offset len) =-    withHandle $ \h ->-        bw_append_json_escaped h len (plusPtr (Ptr addr) offset)-{-# INLINE appendEscapedJson #-}--appendEscapedJsonLiteral :: Addr# -> BufferBuilder ()-appendEscapedJsonLiteral addr =-    withHandle $ \h -> do-        len <- c_strlen (Ptr addr)-        bw_append_json_escaped h len (Ptr addr)-{-# INLINE appendEscapedJsonLiteral #-}--appendEscapedJsonText :: Text -> BufferBuilder ()-appendEscapedJsonText !(Text arr ofs len) =-    let byteArray = aBA arr-    in withHandle $ \h ->-        bw_append_json_escaped_utf16 h len (Ptr (byteArrayContents# byteArray) `plusPtr` ofs)-{-# INLINE appendEscapedJsonText #-}

@@ -1,324 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns, UndecidableInstances #-}--{-|-A library for efficiently building up a valid JSON document.--The difference between "Data.BufferBuilder.Json" and the excellent-"Data.Aeson" is that Aeson represents the JSON document as an-in-memory tree structure before encoding it into bytes.  This module,-on the other hand, represents each value as an action that writes its-representation directly into the output buffer.  At the cost of-reduced flexibility, this results in significantly improved encoding-performance.  At the time of this writing, encoding a custom record-type into JSON using this module was almost 5x faster than using-Aeson.--This module is built on top of "Data.Utf8Builder".--}-module Data.BufferBuilder.Json-    (-    -- * Encoding Values-      Value-    , ToJson (..)-    , encodeJson--    -- * Objects-    , ObjectBuilder-    , emptyObject-    , (.=)-    , (.=#)--    -- * Arrays-    , array--    -- * Null-    , nullValue--    -- * Unsafe-    , unsafeAppendBS-    , unsafeAppendUtf8Builder-    ) where--import GHC.Base-import Foreign.Storable-import Control.Monad (when, forM_)-import Data.BufferBuilder.Utf8 (Utf8Builder)-import qualified Data.BufferBuilder.Utf8 as UB-import Data.ByteString (ByteString)-import Data.Monoid-import Data.Text (Text)-import Data.Foldable (Foldable, foldMap)-import qualified Data.Vector as Vector-import qualified Data.Vector.Generic as GVector-import qualified Data.Vector.Primitive as VP-import qualified Data.Vector.Storable as VS-import qualified Data.Vector.Unboxed as VU-import qualified Data.HashMap.Strict as HashMap---- | Represents a JSON value.------ 'Value's are built up from either 'ToJson' instances or--- from primitives like 'emptyObject', 'array', and 'null'.------ In special cases, or when performance is of utmost importance, the--- unsafe functions 'unsafeAppendBS' and 'unsafeAppendUtf8Builder' are--- available.------ Internally, Value encodes an action or sequence of actions that append--- JSON-encoded text to the underlying 'Utf8Builder'.-newtype Value = Value { utf8Builder :: Utf8Builder () }---- | The class of types that can be converted to JSON values.  See--- 'ObjectBuilder' for an example of writing a 'ToJson' instance for a--- custom data type.------ 'ToJson' instances are provided for many common types.  For--- example, to create a JSON array, call 'toJson' on a list or 'Vector.Vector'.--- To create a JSON object, call 'toJson' on a 'HashMap.HashMap'.-class ToJson a where-    toJson :: a -> Value------ General JSON value support---- | Encode a value into a 'ByteString' containing valid UTF-8-encoded JSON.--- The argument value must have a corresponding 'ToJson' instance.------ __WARNING__: There are three cases where the resulting 'ByteString' may not contain--- legal JSON:------ * An unsafe function was used to encode a JSON value.--- * The root value is not an object or array, as the JSON specification requires.--- * An object has multiple keys with the same value.  For maximum efficiency,---   'ObjectBuilder' does not check key names for uniqueness, so it's possible to---   construct objects with duplicate keys.-encodeJson :: ToJson a => a -> ByteString-encodeJson = UB.runUtf8Builder . utf8Builder . toJson-{-# INLINE encodeJson #-}------ Objects---- | Builds a JSON object.------ An 'ObjectBuilder' builds one or more key-value pairs of a JSON object.  They are constructed with the '.=' operator and--- combined with 'Data.Monoid.<>'.------ To turn an 'ObjectBuilder' into a 'Value', use its 'ToJson' class instance.------ @---     data Friend = Friend---         { fId :: !Int---         , fName :: !Text---         } deriving (Eq, Show)------     instance ToJson Friend where---         toJson friend = toJson $---                    "id"   .= fId friend---                 <> "name" .= fName friend--- @------ __WARNING__: 'ObjectBuilder' does not check uniqueness of object--- keys.  If two keys with the same value are inserted, then the--- resulting JSON document will be illegal.-data ObjectBuilder = NoPair | Pair !(Utf8Builder ())--instance Monoid ObjectBuilder where-    {-# INLINE mempty #-}-    mempty = NoPair--    {-# INLINE mappend #-}-    mappend NoPair a = a-    mappend a NoPair = a-    mappend (Pair a) (Pair b) = Pair $ do -        a-        UB.appendChar7 ','-        b--instance ToJson ObjectBuilder where-    {-# INLINE toJson #-}-    toJson NoPair = Value $ do-        UB.appendChar7 '{'-        UB.appendChar7 '}'--    toJson (Pair a) = Value $ do-        UB.appendChar7 '{'-        a-        UB.appendChar7 '}'---- | A 'Value' that produces the empty object.-emptyObject :: Value-emptyObject = toJson NoPair-{-# INLINE emptyObject #-}---- | Create an 'ObjectBuilder' from a key and a value.-(.=) :: ToJson a => Text -> a -> ObjectBuilder-a .= b = Pair $ do-    UB.appendEscapedJsonText a-    UB.appendChar7 ':'-    utf8Builder $ toJson b-infixr 8 .=-{-# INLINE (.=) #-}---- | Create an 'ObjectBuilder' from a key and a value.  The key is an--- ASCII-7, unescaped, zero-terminated 'Addr#'.------ __WARNING__: This function is unsafe.  If the key is NOT--- zero-terminated, then an access violation might result.  If the key--- is not a sequence of unescaped ASCII characters, the resulting JSON--- document will be illegal.------ This function is provided for maximum performance in the common--- case that object keys are ASCII-7.  It achieves performance by--- avoiding the CAF for a Text literal and avoiding the need to--- transcode UTF-16 to UTF-8 and escape.------ To use this function, the calling source file must have the--- MagicHash extension enabled.------ @---     data Friend = Friend---         { fId :: !Int---         , fName :: !Text---         } deriving (Eq, Show)------     instance ToJson Friend where---         toJson friend = toJson $---                    "id"\#   .=\# fId friend---                 <> "name"\# .=\# fName friend--- @-(.=#) :: ToJson a => Addr# -> a -> ObjectBuilder-a .=# b = Pair $ do-    UB.appendEscapedJsonLiteral a-    UB.appendChar7 ':'-    utf8Builder $ toJson b-infixr 8 .=#-{-# INLINE (.=#) #-}---{-# INLINE writePair #-}-writePair :: ToJson a => (Text, a) -> Utf8Builder ()-writePair (key, value) = do-    UB.appendEscapedJsonText key-    UB.appendChar7 ':'-    utf8Builder $ toJson value--instance ToJson a => ToJson (HashMap.HashMap Text a) where-    {-# INLINABLE toJson #-}-    toJson hm = Value $ do-        UB.appendChar7 '{'-        case HashMap.toList hm of-            [] -> UB.appendChar7 '}'-            (x:xs) -> do-                writePair x-                forM_ xs $ \p -> do-                    UB.appendChar7 ','-                    writePair p-                UB.appendChar7 '}'------ Arrays---- | Serialize any 'Foldable' as a JSON array.  This is generally--- slower than directly calling 'toJson' on a list or 'Vector.Vector',--- but it will convert any 'Foldable' type into an array.-array :: (Foldable t, ToJson a) => t a -> Value-array collection = Value $ do-    UB.appendChar7 '['-    -- HACK: ObjectBuilder is not "type correct" but it has exactly the behaviour we want for this function.-    case foldMap (Pair . utf8Builder . toJson) collection of-        NoPair -> return ()-        (Pair b) -> b-    UB.appendChar7 ']'-{-# INLINABLE array #-}--instance ToJson a => ToJson [a] where-    {-# INLINABLE toJson #-}-    toJson !ls = Value $ do-        UB.appendChar7 '['-        case ls of-            [] -> UB.appendChar7 ']'-            x:xs -> do-                utf8Builder $ toJson x-                forM_ xs $ \(!e) -> do-                    UB.appendChar7 ','-                    utf8Builder $ toJson e-                UB.appendChar7 ']'--instance ToJson a => ToJson (Vector.Vector a) where-    {-# INLINABLE toJson #-}-    toJson = vector--instance (Storable a, ToJson a) => ToJson (VS.Vector a) where-    {-# INLINABLE toJson #-}-    toJson = vector--instance (VP.Prim a, ToJson a) => ToJson (VP.Vector a) where-    {-# INLINABLE toJson #-}-    toJson = vector--instance (GVector.Vector VU.Vector a, ToJson a) => ToJson (VU.Vector a) where-    {-# INLINABLE toJson #-}-    toJson = vector--{-# INLINABLE vector #-}-vector :: (GVector.Vector v a, ToJson a) => v a -> Value-vector !vec = Value $ do-    UB.appendChar7 '['-    let len = GVector.length vec-    when (len /= 0) $ do-        utf8Builder $ toJson (vec `GVector.unsafeIndex` 0)-        GVector.forM_ (GVector.tail vec) $ \e -> do-            UB.appendChar7 ','-            utf8Builder $ toJson e-    UB.appendChar7 ']'----------- | Represents a JSON "null".-nullValue :: Value-nullValue = Value $ UB.unsafeAppendLiteralN 4 "null"#-{-# INLINE nullValue #-}------ Common JSON instances--instance ToJson Value where-    {-# INLINE toJson #-}-    toJson = id--instance ToJson Bool where-    {-# INLINE toJson #-}-    toJson True = Value $ UB.unsafeAppendLiteralN 4 "true"#-    toJson False = Value $ UB.unsafeAppendLiteralN 5 "false"#--instance ToJson a => ToJson (Maybe a) where-    {-# INLINE toJson #-}-    toJson m = case m of-        Nothing -> Value $ UB.unsafeAppendLiteralN 4 "null"#-        Just a -> toJson a--instance ToJson Text where-    {-# INLINE toJson #-}-    toJson txt = Value $ UB.appendEscapedJsonText txt--instance ToJson Double where-    {-# INLINE toJson #-}-    toJson a = Value $ UB.appendDecimalDouble a--instance ToJson Int where-    {-# INLINE toJson #-}-    toJson a = Value $ UB.appendDecimalSignedInt a------- Unsafe functions---- | Unsafely append a string into a JSON document.--- This function does /not/ escape, quote, or otherwise decorate the string in any way.--- This function is /unsafe/ because you can trivially use it to generate illegal JSON.-unsafeAppendBS :: ByteString -> Value-unsafeAppendBS bs = Value $ UB.unsafeAppendBS bs---- | Unsafely append a 'Utf8Builder' into a JSON document.--- This function does not escape, quote, or decorate the string in any way.--- This function is /unsafe/ because you can trivially use it to generate illegal JSON.-unsafeAppendUtf8Builder :: Utf8Builder () -> Value-unsafeAppendUtf8Builder utf8b = Value utf8b

@@ -1,174 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, MagicHash, BangPatterns #-}--{-|-A library for efficiently building up a buffer of UTF-8-encoded text.  If only-safe functions are used, the resulting 'ByteString' is guaranteed to be valid-UTF-8.--To run a sequence of Utf8Builder actions and retrieve the resulting buffer, use-'runUtf8Builder'.--In special situations, for maximum performance, unsafe functions are-also provided.  The unsafe functions do not guarantee the buffer is-correct UTF-8.--This module is built on top of "Data.BufferBuilder".--}-module Data.BufferBuilder.Utf8 (--    -- * The Utf8Builder Monad-      Utf8Builder-    , runUtf8Builder--    -- * Text encoding-    , appendText-    , appendString-    , appendChar--    -- * ASCII-7-    , appendByte7-    , appendChar7-    , appendBS7-    , appendLiteral7--    -- * Printing numbers-    , appendDecimalSignedInt-    , appendDecimalDouble--    -- * Escaped JSON-    , appendEscapedJson-    , appendEscapedJsonLiteral-    , appendEscapedJsonText--    -- * Unsafe append operations-    , unsafeAppendByte-    , unsafeAppendChar8-    , unsafeAppendLiteral-    , unsafeAppendLiteralN-    , unsafeAppendBS-    ) where--import GHC.Base-import GHC.Word-import Control.Applicative-import Data.ByteString (ByteString)-import Data.BufferBuilder (BufferBuilder)-import qualified Data.BufferBuilder as BB-import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8)--newtype Utf8Builder a = Utf8Builder { unBuilder :: BufferBuilder a }-    deriving (Functor, Applicative, Monad)---- | Run a sequence of 'Utf8Builder' actions and extracting the resulting--- buffer as a 'ByteString'.-runUtf8Builder :: Utf8Builder () -> ByteString-runUtf8Builder a = BB.runBufferBuilder $ unBuilder a-{-# INLINE runUtf8Builder #-}----- Text encoding---- TODO: optimize appendText with custom UTF-16 -> UTF-8 encoder in C---- | Encodes the given 'Text' in UTF-8, appending it to the buffer.-appendText :: Text -> Utf8Builder ()-appendText a = Utf8Builder $ BB.appendBS $ encodeUtf8 a-{-# INLINE appendText #-}---- | Encodes the given 'String' in UTF-8, appending it to the buffer.-appendString :: String -> Utf8Builder ()-appendString s = mapM_ appendChar s-{-# INLINABLE appendString #-}---- | Encodes a single 'Char' in UTF-8, appending it to the buffer.-appendChar :: Char -> Utf8Builder ()-appendChar c = Utf8Builder $ BB.appendCharUtf8 c-{-# INLINE appendChar #-}----- ASCII-7---- | Appends the bottom 7 bits of a byte to the buffer.-appendByte7 :: Word8 -> Utf8Builder ()-appendByte7 = Utf8Builder . BB.appendByte7-{-# INLINE appendByte7 #-}---- | Appends the bottom 7 bits of a 'Char' to the buffer.-appendChar7 :: Char -> Utf8Builder ()-appendChar7 = Utf8Builder . BB.appendChar7-{-# INLINE appendChar7 #-}---- | Appends the given ByteString to the buffer, taking the bottom--- 7 bits of each byte.-appendBS7 :: ByteString -> Utf8Builder ()-appendBS7 = Utf8Builder . BB.appendBS7-{-# INLINE appendBS7 #-}---- | Appends the zero-terminated byte string at the given address--- to the buffer, taking the bottom 7 bits of each byte.-appendLiteral7 :: Addr# -> Utf8Builder ()-appendLiteral7 addr = Utf8Builder $ BB.appendLiteral7 addr-{-# INLINE appendLiteral7 #-}----- Printing numbers--appendDecimalSignedInt :: Int -> Utf8Builder ()-appendDecimalSignedInt a = Utf8Builder $ BB.appendDecimalSignedInt a-{-# INLINE appendDecimalSignedInt #-}--appendDecimalDouble :: Double -> Utf8Builder ()-appendDecimalDouble d = Utf8Builder $ BB.appendDecimalDouble d-{-# INLINE appendDecimalDouble #-}----- Escaped JSON--appendEscapedJsonLiteral :: Addr# -> Utf8Builder ()-appendEscapedJsonLiteral addr = Utf8Builder $ BB.appendEscapedJsonLiteral addr--appendEscapedJson :: ByteString -> Utf8Builder ()-appendEscapedJson a = Utf8Builder $ BB.appendEscapedJson a-{-# INLINE appendEscapedJson #-}--appendEscapedJsonText :: Text -> Utf8Builder ()-appendEscapedJsonText txt = Utf8Builder $ BB.appendEscapedJsonText txt-{-# INLINE appendEscapedJsonText #-}----- Unsafe---- | Directly append a byte into the UTF-8 code stream.  Incorrect use of--- this function can result in invalid UTF-8.-unsafeAppendByte :: Word8 -> Utf8Builder ()-unsafeAppendByte = Utf8Builder . BB.appendByte-{-# INLINE unsafeAppendByte #-}---- | Directly append the bottom 8 bits of the given character to the UTF-8--- code stream.  Incorrect use of this function can result in invalid UTF-8.-unsafeAppendChar8 :: Char -> Utf8Builder ()-unsafeAppendChar8 = Utf8Builder . BB.appendChar8-{-# INLINE unsafeAppendChar8 #-}---- | Directly append the zero-terminated byte sequence pointed to by--- the given address.  Be careful that the referenced byte sequence--- contains valid UTF-8.-unsafeAppendLiteral :: Addr# -> Utf8Builder ()-unsafeAppendLiteral addr = Utf8Builder $ BB.appendLiteral addr-{-# INLINE unsafeAppendLiteral #-}---- | Directly append the given byte sequence pointed to by the given address.--- Be careful that the referenced byte sequence contains valid UTF-8.------ __WARNING__: passing an incorrect length value is likely to cause an access--- violation or worse.-unsafeAppendLiteralN :: Int -> Addr# -> Utf8Builder ()-unsafeAppendLiteralN !len addr = Utf8Builder $ BB.unsafeAppendLiteralN len addr-{-# INLINE unsafeAppendLiteralN #-}---- | Directly append the given 'ByteString' to the output buffer.--- Be careful that the referenced 'ByteString' contains valid UTF-8.-unsafeAppendBS :: ByteString -> Utf8Builder ()-unsafeAppendBS a = Utf8Builder $ BB.appendBS a-{-# INLINE unsafeAppendBS #-}

@@ -4,21 +4,18 @@  module Main (main) where +import Control.DeepSeq (NFData (..), force) import Criterion- import Criterion.Main-+import Data.Aeson ((.:)) import Data.Monoid ((<>))-+import Data.Text (Text)+import qualified Data.Aeson as Aeson+import qualified Data.BufferBuilder.Json as Json import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL--import qualified Data.BufferBuilder.Json as Json-import           Data.Text (Text)-import qualified Data.Aeson as Aeson-import           Data.Aeson ((.:))+import qualified Data.Json.Builder as JB import qualified Data.Vector as Vector-import           Control.DeepSeq (NFData (..), force) import qualified Data.Vector.Unboxed as UnboxedVector  data EyeColor = Green | Blue | Brown@@ -224,6 +221,60 @@             <> "greeting"# Json..=# uGreeting             <> "favoriteFruit"# Json..=# uFavouriteFruit +---- json-builder instances ----++instance JB.Value EyeColor where+    toJson ec = JB.toJson $ case ec of+        Green -> "green" :: Text+        Blue -> "blue"+        Brown -> "brown"++instance JB.Value Gender where+    toJson g = JB.toJson $ case g of+        Male -> "male" :: Text+        Female -> "female"++instance JB.Value Fruit where+    toJson f = JB.toJson $ case f of+        Apple -> "apple" :: Text+        Strawberry -> "strawberry"+        Banana -> "banana"++instance JB.Value Friend where+    toJson Friend{..} = JB.toJson $+            ("_id" :: Text) `JB.row` fId+            <> ("name" :: Text) `JB.row` fName++instance JB.Value User where+    toJson User{..} =+        let t :: Text -> Text+            t = id+        in JB.toJson $+               t "_id" `JB.row` uId+            <> t "index" `JB.row` uIndex+            <> t "guid" `JB.row` uGuid+            <> t "isActive" `JB.row` uIsActive+            <> t "balance" `JB.row` uBalance+            <> t "picture" `JB.row` uPicture+            <> t "age" `JB.row` uAge+            <> t "eyeColor" `JB.row` uEyeColor+            <> t "name" `JB.row` uName+            <> t "gender" `JB.row` uGender+            <> t "company" `JB.row` uCompany+            <> t "email" `JB.row` uEmail+            <> t "phone" `JB.row` uPhone+            <> t "address" `JB.row` uAddress+            <> t "about" `JB.row` uAbout+            <> t "registered" `JB.row` uRegistered+            <> t "latitude" `JB.row` uLatitude+            <> t "longitude" `JB.row` uLongitude+            <> t "tags" `JB.row` uTags+            <> t "friends" `JB.row` uFriends+            <> t "greeting" `JB.row` uGreeting+            <> t "favoriteFruit" `JB.row` uFavouriteFruit++----+ encodeUserNaively :: User -> Json.Value encodeUserNaively User{..} =     Json.toJson $@@ -277,6 +328,7 @@                 , bgroup "render"                     [ bench "bufferbuilder" $ nf Json.encodeJson parsedUserList                     , bench "aeson" $ nf Aeson.encode parsedUserList+                    , bench "json-builder" $ nf JB.toJsonLBS parsedUserList                     ]                 , bgroup "addr vs text keys"                     [ bench "addr" $ nf Json.encodeJson parsedUserList

@@ -0,0 +1,224 @@+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}++module Main (main) where++import qualified Data.BufferBuilder as BB+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Builder as BSB+import qualified Data.ByteString.Char8 as BSC+import Criterion+import Criterion.Main+import Data.Word (Word16)+import Data.Monoid+import Control.Monad+import Network.HTTP.Types (urlEncode)++type Protocol = BS.ByteString+type PathPiece = BS.ByteString++type Hash = BS.ByteString++data SMaybe a = SNothing | SJust !a+    deriving (Eq, Show, Ord) ++data UrlHost = UrlHost+    { uhHostName :: !BS.ByteString+    , uhPort     :: {-# UNPACK #-} !Word16         -- 0 = no port+    , uhUserName :: !BS.ByteString  -- empty = no username+    , uhPasswd   :: !BS.ByteString  -- empty = no password+    } deriving (Show, Ord, Eq)++{- | The type of a URL's query arguments.+   The RFC does not specify any particular format for this section of a URL, but, since+   it is so common to use form encoding, we include a representation which is a list of+   parsed key=value&key=value pairs.++   When parsing a URL, we first assume that the query is form encoded.  If this parse fails,+   the 'UnparsedQuery' constructor is instead used to encode a URL whose query encoding is+   unknown.+-}+data QueryPair = QueryPair !BS.ByteString !BS.ByteString+     deriving (Show, Ord, Eq)+data Query+    = UnparsedQuery !BS.ByteString+    | ParsedQuery [QueryPair]+      deriving (Show, Ord, Eq)+               +{- | Symbolic URL type.+   It is intended that this type can capture all \"conventional\" URLs losslessly and symbolically.++   In short, if you ever find yourself resorting to direct string parsing or generation, you are+   either doing it wrong, or this library is missing something you need.+ -}++data UrlHead = FullyQualified !Protocol !UrlHost+             | ProtocolRelative !UrlHost+             | Absolute+             | Relative+             deriving (Eq, Ord, Show)++data Url = Url+    { urlHead     :: !UrlHead+    , urlPath     :: ![PathPiece]+    , urlQuery    :: !(SMaybe Query)+    , urlHash     :: !(SMaybe Hash)+    } deriving (Eq, Ord, Show)+++builderToBS :: BSB.Builder -> BS.ByteString+builderToBS = BSL.toStrict . BSB.toLazyByteString++escapeString :: BS.ByteString -> BSB.Builder+escapeString = BSB.byteString . urlEncode False++toByteString :: Url -> BS.ByteString+toByteString = builderToBS . toBuilder++toBuilder :: Url -> BSB.Builder+toBuilder Url{..} =+    renderHead urlHead+    <> renderPath urlPath+    <> renderQuery urlQuery+    <> renderHash urlHash+  where+    toBB = BSB.byteString+    char = BSB.char7++    renderHead :: UrlHead -> BSB.Builder+    renderHead (FullyQualified protocol host) = toBB protocol <> char ':' <> renderHost host <> char '/'+    renderHead (ProtocolRelative host) = renderHost host <> char '/'+    renderHead Absolute = char '/'+    renderHead Relative = mempty++    renderHost :: UrlHost -> BSB.Builder+    renderHost UrlHost{..} = char '/' <> char '/' <> renderUser uhUserName uhPasswd <> renderHostName uhHostName uhPort++    renderPath :: [PathPiece] -> BSB.Builder+    renderPath [] = mempty+    renderPath path = interc (char '/') (map escapeString path)++    renderQuery :: SMaybe Query -> BSB.Builder+    renderQuery SNothing = mempty+    renderQuery (SJust (UnparsedQuery q)) = char '?' <> toBB q+    renderQuery (SJust (ParsedQuery pairs)) = char '?' <> interc (char '&') (map renderPair pairs)++    renderPair (QueryPair k v) = escapeString k <> char '=' <> escapeString v++    renderHash h = case h of+        SNothing -> mempty+        SJust hash -> char '#' <> toBB hash++    renderHostName hostName hnPort+        | 0 /= hnPort = toBB hostName <> char ':' <> BSB.intDec (fromIntegral hnPort)+        | otherwise   = toBB hostName++    renderUser uhName uhPasswd+        | BS.null uhName = mempty+        | BS.null uhPasswd = escapeString uhName <> char '@'+        | otherwise = escapeString uhName <> char ':' <> escapeString uhPasswd <> char '@'++    interc _ [] = mempty+    interc _ [x] = x+    interc sep (x:y:xs) = x <> sep <> interc sep (y:xs)++renderHost' :: UrlHost -> BB.BufferBuilder ()+renderHost' UrlHost{..} = do+    BB.appendChar8 '/'+    BB.appendChar8 '/'++    when (not $ BS.null uhUserName) $ do+        BB.appendUrlEncoded uhUserName+        when (not $ BS.null uhPasswd) $ do+            BB.appendChar8 ':'+            BB.appendUrlEncoded uhPasswd+        BB.appendChar8 '@'++    BB.appendBS uhHostName+    if (uhPort /= 0) then do+        BB.appendChar8 ':'+        BB.appendDecimalSignedInt (fromIntegral uhPort)+    else+        return ()+        +    BB.appendChar8 '/'++renderPair' :: QueryPair -> BB.BufferBuilder ()+renderPair' (QueryPair key value) = do+    BB.appendUrlEncoded key+    BB.appendChar8 '='+    BB.appendUrlEncoded value+    +render :: Url -> BB.BufferBuilder ()+render Url{..} = do+    case urlHead of+        (FullyQualified protocol host) -> do+            BB.appendBS protocol+            BB.appendChar8 ':'+            renderHost' host+        (ProtocolRelative host) -> renderHost' host+        Absolute -> BB.appendChar8 '/'+        Relative -> return ()++    case urlPath of+        [] -> return ()+        (x:xs) -> do+            BB.appendUrlEncoded x+            forM_ xs $ \ps -> do+                BB.appendChar8 '/'+                BB.appendUrlEncoded ps++    case urlQuery of+        SNothing -> return ()+        (SJust (UnparsedQuery q)) -> do+            BB.appendChar8 '?'+            BB.appendBS q+        (SJust (ParsedQuery pairs)) -> do+            BB.appendChar8 '?'+            case pairs of+                [] -> return ()+                (x:xs) -> do+                    renderPair' x+                    forM_ xs $ \pair -> do+                        BB.appendChar8 '&'+                        renderPair' pair+++    case urlHash of+        SNothing -> return ()+        (SJust h) -> do+            BB.appendChar8 '#'+            BB.appendBS h++viaBufferBuilder :: Url -> BS.ByteString+viaBufferBuilder = BB.runBufferBuilder . render++main :: IO ()+main = do+    let host = UrlHost+            { uhHostName = "example.com"+            , uhPort = 80+            , uhUserName = ""+            , uhPasswd = ""+            }++    let url = Url+            { urlHead = FullyQualified "http" host+            , urlPath = ["service", "one", "two", "three"]+            , urlQuery = SJust (ParsedQuery+                                  [ QueryPair "limit" "30"+                                  , QueryPair "next" "123456"+                                  , QueryPair "previous" "987654"+                                  ])+            , urlHash = SJust "anchor"+            }++    BSC.putStrLn $ "bytestring builder: " <> toByteString url+    BSC.putStrLn $ "bufferbuilder: " <> viaBufferBuilder url++    defaultMain [ bgroup "render url"+                    [ bench "bufferbuilder" $ nf viaBufferBuilder url+                    , bench "bytestring builder" $ nf toByteString url+                    --, bench "vector text" $ nf Json.encodeJson (Vector.replicate 100000 ("hello world" :: Text))+                    ]+                ]

@@ -1,275 +0,0 @@-/** <https://github.com/miloyip/itoa-benchmark/blob/940542a7770155ee3e9f2777ebc178dc899b43e0/src/branchlut.cpp>- */--#include <string.h>-#include <stdint.h>--static const char gDigitsLut[200] = {-    '0','0','0','1','0','2','0','3','0','4','0','5','0','6','0','7','0','8','0','9',-    '1','0','1','1','1','2','1','3','1','4','1','5','1','6','1','7','1','8','1','9',-    '2','0','2','1','2','2','2','3','2','4','2','5','2','6','2','7','2','8','2','9',-    '3','0','3','1','3','2','3','3','3','4','3','5','3','6','3','7','3','8','3','9',-    '4','0','4','1','4','2','4','3','4','4','4','5','4','6','4','7','4','8','4','9',-    '5','0','5','1','5','2','5','3','5','4','5','5','5','6','5','7','5','8','5','9',-    '6','0','6','1','6','2','6','3','6','4','6','5','6','6','6','7','6','8','6','9',-    '7','0','7','1','7','2','7','3','7','4','7','5','7','6','7','7','7','8','7','9',-    '8','0','8','1','8','2','8','3','8','4','8','5','8','6','8','7','8','8','8','9',-    '9','0','9','1','9','2','9','3','9','4','9','5','9','6','9','7','9','8','9','9'-};--// Branching for different cases (forward)-// Use lookup table of two digits--size_t u32toa_branchlut(uint32_t value, char* buffer) {-    char* start = buffer;--    if (value < 10000) {-        const uint32_t d1 = (value / 100) << 1;-        const uint32_t d2 = (value % 100) << 1;-        -        if (value >= 1000)-            *buffer++ = gDigitsLut[d1];-        if (value >= 100)-            *buffer++ = gDigitsLut[d1 + 1];-        if (value >= 10)-            *buffer++ = gDigitsLut[d2];-        *buffer++ = gDigitsLut[d2 + 1];-    }-    else if (value < 100000000) {-        // value = bbbbcccc-        const uint32_t b = value / 10000;-        const uint32_t c = value % 10000;-        -        const uint32_t d1 = (b / 100) << 1;-        const uint32_t d2 = (b % 100) << 1;-        -        const uint32_t d3 = (c / 100) << 1;-        const uint32_t d4 = (c % 100) << 1;-        -        if (value >= 10000000)-            *buffer++ = gDigitsLut[d1];-        if (value >= 1000000)-            *buffer++ = gDigitsLut[d1 + 1];-        if (value >= 100000)-            *buffer++ = gDigitsLut[d2];-        *buffer++ = gDigitsLut[d2 + 1];-        -        *buffer++ = gDigitsLut[d3];-        *buffer++ = gDigitsLut[d3 + 1];-        *buffer++ = gDigitsLut[d4];-        *buffer++ = gDigitsLut[d4 + 1];-    }-    else {-        // value = aabbbbcccc in decimal-        -        const uint32_t a = value / 100000000; // 1 to 42-        value %= 100000000;-        -        if (a >= 10) {-            const unsigned i = a << 1;-            *buffer++ = gDigitsLut[i];-            *buffer++ = gDigitsLut[i + 1];-        }-        else-            *buffer++ = '0' + static_cast<char>(a);--        const uint32_t b = value / 10000; // 0 to 9999-        const uint32_t c = value % 10000; // 0 to 9999-        -        const uint32_t d1 = (b / 100) << 1;-        const uint32_t d2 = (b % 100) << 1;-        -        const uint32_t d3 = (c / 100) << 1;-        const uint32_t d4 = (c % 100) << 1;-        -        *buffer++ = gDigitsLut[d1];-        *buffer++ = gDigitsLut[d1 + 1];-        *buffer++ = gDigitsLut[d2];-        *buffer++ = gDigitsLut[d2 + 1];-        *buffer++ = gDigitsLut[d3];-        *buffer++ = gDigitsLut[d3 + 1];-        *buffer++ = gDigitsLut[d4];-        *buffer++ = gDigitsLut[d4 + 1];-    }-    return buffer - start;-}--size_t i32toa_branchlut(int32_t value, char* buffer) {-    size_t length = 0;-    if (value < 0) {-        ++length;-        *buffer++ = '-';-        value = -value;-    }--    return length + u32toa_branchlut(static_cast<uint32_t>(value), buffer);-}--size_t u64toa_branchlut(uint64_t value, char* buffer) {-    char* start = buffer;-    if (value < 100000000) {-        uint32_t v = static_cast<uint32_t>(value);-        if (v < 10000) {-            const uint32_t d1 = (v / 100) << 1;-            const uint32_t d2 = (v % 100) << 1;-            -            if (v >= 1000)-                *buffer++ = gDigitsLut[d1];-            if (v >= 100)-                *buffer++ = gDigitsLut[d1 + 1];-            if (v >= 10)-                *buffer++ = gDigitsLut[d2];-            *buffer++ = gDigitsLut[d2 + 1];-        }-        else {-            // value = bbbbcccc-            const uint32_t b = v / 10000;-            const uint32_t c = v % 10000;-            -            const uint32_t d1 = (b / 100) << 1;-            const uint32_t d2 = (b % 100) << 1;-            -            const uint32_t d3 = (c / 100) << 1;-            const uint32_t d4 = (c % 100) << 1;-            -            if (value >= 10000000)-                *buffer++ = gDigitsLut[d1];-            if (value >= 1000000)-                *buffer++ = gDigitsLut[d1 + 1];-            if (value >= 100000)-                *buffer++ = gDigitsLut[d2];-            *buffer++ = gDigitsLut[d2 + 1];-            -            *buffer++ = gDigitsLut[d3];-            *buffer++ = gDigitsLut[d3 + 1];-            *buffer++ = gDigitsLut[d4];-            *buffer++ = gDigitsLut[d4 + 1];-        }-    }-    else if (value < 10000000000000000) {-        const uint32_t v0 = static_cast<uint32_t>(value / 100000000);-        const uint32_t v1 = static_cast<uint32_t>(value % 100000000);-        -        const uint32_t b0 = v0 / 10000;-        const uint32_t c0 = v0 % 10000;-        -        const uint32_t d1 = (b0 / 100) << 1;-        const uint32_t d2 = (b0 % 100) << 1;-        -        const uint32_t d3 = (c0 / 100) << 1;-        const uint32_t d4 = (c0 % 100) << 1;--        const uint32_t b1 = v1 / 10000;-        const uint32_t c1 = v1 % 10000;-        -        const uint32_t d5 = (b1 / 100) << 1;-        const uint32_t d6 = (b1 % 100) << 1;-        -        const uint32_t d7 = (c1 / 100) << 1;-        const uint32_t d8 = (c1 % 100) << 1;--        if (value >= 1000000000000000)-            *buffer++ = gDigitsLut[d1];-        if (value >= 100000000000000)-            *buffer++ = gDigitsLut[d1 + 1];-        if (value >= 10000000000000)-            *buffer++ = gDigitsLut[d2];-        if (value >= 1000000000000)-            *buffer++ = gDigitsLut[d2 + 1];-        if (value >= 100000000000)-            *buffer++ = gDigitsLut[d3];-        if (value >= 10000000000)-            *buffer++ = gDigitsLut[d3 + 1];-        if (value >= 1000000000)-            *buffer++ = gDigitsLut[d4];-        if (value >= 100000000)-            *buffer++ = gDigitsLut[d4 + 1];-        -        *buffer++ = gDigitsLut[d5];-        *buffer++ = gDigitsLut[d5 + 1];-        *buffer++ = gDigitsLut[d6];-        *buffer++ = gDigitsLut[d6 + 1];-        *buffer++ = gDigitsLut[d7];-        *buffer++ = gDigitsLut[d7 + 1];-        *buffer++ = gDigitsLut[d8];-        *buffer++ = gDigitsLut[d8 + 1];-    }-    else {-        const uint32_t a = static_cast<uint32_t>(value / 10000000000000000); // 1 to 1844-        value %= 10000000000000000;-        -        if (a < 10)-            *buffer++ = '0' + static_cast<char>(a);-        else if (a < 100) {-            const uint32_t i = a << 1;-            *buffer++ = gDigitsLut[i];-            *buffer++ = gDigitsLut[i + 1];-        }-        else if (a < 1000) {-            *buffer++ = '0' + static_cast<char>(a / 100);-            -            const uint32_t i = (a % 100) << 1;-            *buffer++ = gDigitsLut[i];-            *buffer++ = gDigitsLut[i + 1];-        }-        else {-            const uint32_t i = (a / 100) << 1;-            const uint32_t j = (a % 100) << 1;-            *buffer++ = gDigitsLut[i];-            *buffer++ = gDigitsLut[i + 1];-            *buffer++ = gDigitsLut[j];-            *buffer++ = gDigitsLut[j + 1];-        }-        -        const uint32_t v0 = static_cast<uint32_t>(value / 100000000);-        const uint32_t v1 = static_cast<uint32_t>(value % 100000000);-        -        const uint32_t b0 = v0 / 10000;-        const uint32_t c0 = v0 % 10000;-        -        const uint32_t d1 = (b0 / 100) << 1;-        const uint32_t d2 = (b0 % 100) << 1;-        -        const uint32_t d3 = (c0 / 100) << 1;-        const uint32_t d4 = (c0 % 100) << 1;-        -        const uint32_t b1 = v1 / 10000;-        const uint32_t c1 = v1 % 10000;-        -        const uint32_t d5 = (b1 / 100) << 1;-        const uint32_t d6 = (b1 % 100) << 1;-        -        const uint32_t d7 = (c1 / 100) << 1;-        const uint32_t d8 = (c1 % 100) << 1;-        -        *buffer++ = gDigitsLut[d1];-        *buffer++ = gDigitsLut[d1 + 1];-        *buffer++ = gDigitsLut[d2];-        *buffer++ = gDigitsLut[d2 + 1];-        *buffer++ = gDigitsLut[d3];-        *buffer++ = gDigitsLut[d3 + 1];-        *buffer++ = gDigitsLut[d4];-        *buffer++ = gDigitsLut[d4 + 1];-        *buffer++ = gDigitsLut[d5];-        *buffer++ = gDigitsLut[d5 + 1];-        *buffer++ = gDigitsLut[d6];-        *buffer++ = gDigitsLut[d6 + 1];-        *buffer++ = gDigitsLut[d7];-        *buffer++ = gDigitsLut[d7 + 1];-        *buffer++ = gDigitsLut[d8];-        *buffer++ = gDigitsLut[d8 + 1];-    }-    -    return buffer - start;-}--size_t i64toa_branchlut(int64_t value, char* buffer) {-    size_t length = 0;-    if (value < 0) {-        ++length;-        *buffer++ = '-';-        value = -value;-    }--    return length + u64toa_branchlut(static_cast<uint64_t>(value), buffer);-}

@@ -1,11 +0,0 @@-/** <https://github.com/miloyip/itoa-benchmark/blob/940542a7770155ee3e9f2777ebc178dc899b43e0/src/branchlut.cpp>- */--#pragma once--#include <stdint.h>--size_t u32toa_branchlut(uint32_t value, char* buffer);-size_t i32toa_branchlut(int32_t value, char* buffer);-size_t u64toa_branchlut(uint64_t value, char* buffer);-size_t i64toa_branchlut(int64_t value, char* buffer);

@@ -1,5 +1,5 @@ name:                buffer-builder-version:             0.2.0.3+version:             0.2.1.0 synopsis:            Library for efficiently building up buffers, one piece at a time description: @@ -47,7 +47,7 @@ stability:           experimental homepage:            https://github.com/chadaustin/buffer-builder cabal-version:       >=1.10-extra-source-files:  test/*.hs+extra-source-files:  test/*.hs changelog.md  library   exposed-modules:@@ -64,9 +64,11 @@    default-language: Haskell2010   ghc-options: -O2 -Wall+  --ghc-options: -ddump-ds -ddump-simpl -ddump-stg -ddump-opt-cmm -ddump-asm -ddump-to-file -  c-sources: buffer.cpp branchlut.cpp-  install-includes: branchlut.h+  hs-source-dirs: src+  c-sources: cbits/buffer.cpp cbits/branchlut.cpp+  install-includes: cbits/branchlut.h   cc-options: -O2 -Wall  test-suite tests@@ -119,6 +121,21 @@                , vector                , criterion                , vector+               , json-builder++benchmark url+  type: exitcode-stdio-1.0+  main-is: UrlBench.hs+  hs-source-dirs: bench+  default-language: Haskell2010+  ghc-options: -O2 -Wall+  --ghc-options: -ddump-ds -ddump-simpl -ddump-stg -ddump-opt-cmm -ddump-asm -ddump-to-file+  build-depends: base+               , buffer-builder+               , bytestring+               , http-types+               , text+               , criterion  test-suite tinyjson   type: exitcode-stdio-1.0

@@ -1,289 +0,0 @@-#include <assert.h>-#include <stdio.h>-#include <stdlib.h>-#include <string.h>-#include <stdint.h>--#include "branchlut.h"--const size_t TRIM_THRESHOLD = 8192; // minimum number of bytes saved to trim--/*- * Append utf8, ASCII7, raw bytes, utf16- * JSON encode utf8, ascii7, utf16- */--#if defined(__clang__)-  #define BW_NOINLINE __attribute__((noinline))-#elif defined(__GNUC__)-  #define BW_NOINLINE __attribute__((noinline))-#else-  #define BW_NOINLINE-#endif--namespace {-    struct BufferWriter {-        unsigned char* data;-        size_t size;-        size_t capacity;-    };--    BW_NOINLINE void actuallyGrow(BufferWriter* bw, size_t amount) {-        size_t newCapacity = bw->capacity;-        do {-            newCapacity *= 2;-        } while (newCapacity < bw->size + amount);-        -        unsigned char* newData = reinterpret_cast<unsigned char*>(realloc(bw->data, newCapacity));-        assert(newData);-        bw->data = newData;-        bw->capacity = newCapacity;-    }--    inline void grow(BufferWriter* bw, size_t amount) {-        if (bw->size + amount > bw->capacity) {-            actuallyGrow(bw, amount);-        }-    }-}--// assumes malloc will not fail-// TODO: replace assert with some other error mechanism--extern "C" BufferWriter* bw_new(size_t initialCapacity) {-    assert(initialCapacity >= 1);-    BufferWriter* bw = reinterpret_cast<BufferWriter*>(malloc(sizeof(BufferWriter)));-    assert(bw);-    bw->data = reinterpret_cast<unsigned char*>(malloc(initialCapacity));-    assert(bw->data);-    bw->size = 0;-    bw->capacity = initialCapacity;-    return bw;-}--extern "C" void bw_free(BufferWriter* bw) {-    free(bw->data);-    free(bw);-}--extern "C" size_t bw_get_size(BufferWriter* bw) {-    return bw->size;-}--extern "C" unsigned char* bw_trim_and_release_address(BufferWriter* bw) {-    unsigned char* data = bw->data;-    -    if (bw->size + TRIM_THRESHOLD < bw->capacity) {-        // try to shrink-        data = reinterpret_cast<unsigned char*>(realloc(data, bw->size));-        if (!data) {-            // no problem-            data = bw->data;-        }-    }--    bw->data = 0;-    return data;-}--extern "C" void bw_append_byte(BufferWriter* bw, unsigned char byte) {-    assert(bw->data);-    grow(bw, 1);-    bw->data[bw->size] = byte;-    bw->size += 1;-}--extern "C" void bw_append_char_utf8(BufferWriter* bw, uint32_t c) {-    assert(bw->data);-    grow(bw, 4);--    size_t size = bw->size;-    unsigned char* data = bw->data + size;--    if (c <= 0x7F) {-        data[0] = static_cast<unsigned char>(c);-        size += 1;-    } else if (c <= 0x7FF) {-        data[0] = static_cast<unsigned char>(0xC0 | (c >> 6));-        data[1] = static_cast<unsigned char>(0x80 | (c & 0x3F));-        size += 2;-    } else if (c <= 0xFFFF) {-        data[0] = static_cast<unsigned char>(0xE0 | (c >> 12));-        data[1] = static_cast<unsigned char>(0x80 | ((c >> 6) & 0x3F));-        data[2] = static_cast<unsigned char>(0x80 | (c & 0x3F));-        size += 3;-    } else if (c <= 0x1FFFFF) {-        data[0] = static_cast<unsigned char>(0xF0 | (c >> 18));-        data[1] = static_cast<unsigned char>(0x80 | ((c >> 12) & 0x3F));-        data[2] = static_cast<unsigned char>(0x80 | ((c >> 6) & 0x3F));-        data[3] = static_cast<unsigned char>(0x80 | (c & 0x3F));-        size += 4;-    } else {-        // Unicode characters out of this range are illegal...-        // should we assert?  or just ignore...-    }-    bw->size = size;-}--extern "C" void bw_append_bs(BufferWriter* bw, size_t size, const unsigned char* data) {-    assert(bw->data);-    grow(bw, size);--    memcpy(bw->data + bw->size, data, size);-    bw->size += size;-}--extern "C" void bw_append_bsz(BufferWriter* bw, const unsigned char* data) {-    bw_append_bs(bw, strlen(reinterpret_cast<const char*>(data)), data);-}--extern "C" void bw_append_byte7(BufferWriter* bw, unsigned char byte) {-    assert(bw->data);-    grow(bw, 1);-    bw->data[bw->size] = byte & 0x7F;-    bw->size += 1;-}--extern "C" void bw_append_bs7(BufferWriter* bw, size_t size, const unsigned char* data) {-    assert(bw->data);-    grow(bw, size);--    unsigned char* out = bw->data + bw->size;-    for (size_t i = 0; i < size; ++i) {-        out[i] = data[i] & 0x7F;-    }-    bw->size += size;-}--extern "C" void bw_append_bsz7(BufferWriter* bw, const unsigned char* data) {-    bw_append_bs7(bw, strlen(reinterpret_cast<const char*>(data)), data);-}--extern "C" void bw_append_json_escaped(BufferWriter* bw, size_t size, const unsigned char* data) {-    assert(bw->data);-    grow(bw, 2 + size * 2);--    unsigned char* dest = bw->data + bw->size;-    *dest++ = '\"';--    size_t i = 0;-    while (i < size) {-        switch (data[i]) {-            case '\n': *dest++ = '\\'; *dest++ = 'n';  break;-            case '\r': *dest++ = '\\'; *dest++ = 'r';  break;-            case '\t': *dest++ = '\\'; *dest++ = 't';  break;-            case '\\': *dest++ = '\\'; *dest++ = '\\'; break;-            case '\"': *dest++ = '\\'; *dest++ = '\"'; break;-            default:   *dest++ = data[i];-        }-        ++i;-    }--    *dest++ = '\"';-    bw->size = dest - bw->data;-}--extern "C" void bw_append_decimal_signed_int(BufferWriter* bw, int64_t i) {-    assert(bw->data);-    grow(bw, 32); // enough--    unsigned used = i64toa_branchlut(i, reinterpret_cast<char*>(bw->data + bw->size));-    bw->size += used;-}--extern "C" void bw_append_decimal_double(BufferWriter* bw, double d) {-    assert(bw->data);-    grow(bw, 30); // ???--    size_t used = sprintf(reinterpret_cast<char*>(bw->data + bw->size), "%f", d);-    bw->size += used;-}--// From <https://github.com/bos/text/blob/f74427c954fb4479f9db5025f27775e29ace125f/cbits/cbits.c#L234>-extern "C" void bw_encode_utf8(uint8_t **destp, const uint16_t *src, size_t srcoff, size_t srclen) {-  const uint16_t *srcend;-  uint8_t *dest = *destp;--  src += srcoff;-  srcend = src + srclen;-- ascii:-#if defined(__x86_64__)-  while (srcend - src >= 4) {-    uint64_t w = *((uint64_t *) src);--    if (w & 0xFF80FF80FF80FF80ULL) {-      if (!(w & 0x000000000000FF80ULL)) {-        *dest++ = w & 0xFFFF;-        src++;-        if (!(w & 0x00000000FF800000ULL)) {-          *dest++ = (w >> 16) & 0xFFFF;-          src++;-          if (!(w & 0x0000FF8000000000ULL)) {-            *dest++ = (w >> 32) & 0xFFFF;-            src++;-          }-        }-      }-      break;-    }-    *dest++ = w & 0xFFFF;-    *dest++ = (w >> 16) & 0xFFFF;-    *dest++ = (w >> 32) & 0xFFFF;-    *dest++ = w >> 48;-    src += 4;-  }-#endif--#if defined(__i386__)-  while (srcend - src >= 2) {-    uint32_t w = *((uint32_t *) src);--    if (w & 0xFF80FF80)-      break;-    *dest++ = w & 0xFFFF;-    *dest++ = w >> 16;-    src += 2;-  }-#endif--  while (src < srcend) {-    uint16_t w = *src++;--    if (w <= 0x7F) {-      *dest++ = w;-      /* An ASCII byte is likely to begin a run of ASCII bytes.-     Falling back into the fast path really helps performance. */-      goto ascii;-    }-    else if (w <= 0x7FF) {-      *dest++ = (w >> 6) | 0xC0;-      *dest++ = (w & 0x3f) | 0x80;-    }-    else if (w < 0xD800 || w > 0xDBFF) {-      *dest++ = (w >> 12) | 0xE0;-      *dest++ = ((w >> 6) & 0x3F) | 0x80;-      *dest++ = (w & 0x3F) | 0x80;-    } else {-      uint32_t c = ((((uint32_t) w) - 0xD800) << 10) +-    (((uint32_t) *src++) - 0xDC00) + 0x10000;-      *dest++ = (c >> 18) | 0xF0;-      *dest++ = ((c >> 12) & 0x3F) | 0x80;-      *dest++ = ((c >> 6) & 0x3F) | 0x80;-      *dest++ = (c & 0x3F) | 0x80;-    }-  }--  *destp = dest;-}--extern "C" void bw_append_json_escaped_utf16(BufferWriter* bw, size_t size, unsigned short* words) {-    unsigned char* utf8 = reinterpret_cast<unsigned char*>(malloc(size * 4));-    unsigned char* utf8end = utf8;--    bw_encode_utf8(&utf8end, words, 0, size);--    bw_append_json_escaped(bw, utf8end - utf8, utf8);--    free(utf8);-}

@@ -0,0 +1,271 @@+/** <https://github.com/miloyip/itoa-benchmark/blob/940542a7770155ee3e9f2777ebc178dc899b43e0/src/branchlut.cpp>+ */++#include <string.h>+#include <stdint.h>++static const char gDigitsLut[200] = {+    '0','0','0','1','0','2','0','3','0','4','0','5','0','6','0','7','0','8','0','9',+    '1','0','1','1','1','2','1','3','1','4','1','5','1','6','1','7','1','8','1','9',+    '2','0','2','1','2','2','2','3','2','4','2','5','2','6','2','7','2','8','2','9',+    '3','0','3','1','3','2','3','3','3','4','3','5','3','6','3','7','3','8','3','9',+    '4','0','4','1','4','2','4','3','4','4','4','5','4','6','4','7','4','8','4','9',+    '5','0','5','1','5','2','5','3','5','4','5','5','5','6','5','7','5','8','5','9',+    '6','0','6','1','6','2','6','3','6','4','6','5','6','6','6','7','6','8','6','9',+    '7','0','7','1','7','2','7','3','7','4','7','5','7','6','7','7','7','8','7','9',+    '8','0','8','1','8','2','8','3','8','4','8','5','8','6','8','7','8','8','8','9',+    '9','0','9','1','9','2','9','3','9','4','9','5','9','6','9','7','9','8','9','9'+};++// Branching for different cases (forward)+// Use lookup table of two digits++size_t u32toa_branchlut(uint32_t value, char* buffer) {+    char* start = buffer;++    if (value < 10000) {+        const uint32_t d1 = (value / 100) << 1;+        const uint32_t d2 = (value % 100) << 1;+        +        if (value >= 1000)+            *buffer++ = gDigitsLut[d1];+        if (value >= 100)+            *buffer++ = gDigitsLut[d1 + 1];+        if (value >= 10)+            *buffer++ = gDigitsLut[d2];+        *buffer++ = gDigitsLut[d2 + 1];+    }+    else if (value < 100000000) {+        // value = bbbbcccc+        const uint32_t b = value / 10000;+        const uint32_t c = value % 10000;+        +        const uint32_t d1 = (b / 100) << 1;+        const uint32_t d2 = (b % 100) << 1;+        +        const uint32_t d3 = (c / 100) << 1;+        const uint32_t d4 = (c % 100) << 1;+        +        if (value >= 10000000)+            *buffer++ = gDigitsLut[d1];+        if (value >= 1000000)+            *buffer++ = gDigitsLut[d1 + 1];+        if (value >= 100000)+            *buffer++ = gDigitsLut[d2];+        *buffer++ = gDigitsLut[d2 + 1];+        +        *buffer++ = gDigitsLut[d3];+        *buffer++ = gDigitsLut[d3 + 1];+        *buffer++ = gDigitsLut[d4];+        *buffer++ = gDigitsLut[d4 + 1];+    }+    else {+        // value = aabbbbcccc in decimal+        +        const uint32_t a = value / 100000000; // 1 to 42+        value %= 100000000;+        +        if (a >= 10) {+            const unsigned i = a << 1;+            *buffer++ = gDigitsLut[i];+            *buffer++ = gDigitsLut[i + 1];+        }+        else+            *buffer++ = '0' + static_cast<char>(a);++        const uint32_t b = value / 10000; // 0 to 9999+        const uint32_t c = value % 10000; // 0 to 9999+        +        const uint32_t d1 = (b / 100) << 1;+        const uint32_t d2 = (b % 100) << 1;+        +        const uint32_t d3 = (c / 100) << 1;+        const uint32_t d4 = (c % 100) << 1;+        +        *buffer++ = gDigitsLut[d1];+        *buffer++ = gDigitsLut[d1 + 1];+        *buffer++ = gDigitsLut[d2];+        *buffer++ = gDigitsLut[d2 + 1];+        *buffer++ = gDigitsLut[d3];+        *buffer++ = gDigitsLut[d3 + 1];+        *buffer++ = gDigitsLut[d4];+        *buffer++ = gDigitsLut[d4 + 1];+    }+    return buffer - start;+}++size_t i32toa_branchlut(int32_t value, char* buffer) {+    if (value < 0) {+        *buffer++ = '-';+        return 1 + u32toa_branchlut(~static_cast<uint32_t>(value) + 1u, buffer);+    } else {+        return u32toa_branchlut(static_cast<uint32_t>(value), buffer);+    }+}++size_t u64toa_branchlut(uint64_t value, char* buffer) {+    char* start = buffer;+    if (value < 100000000) {+        uint32_t v = static_cast<uint32_t>(value);+        if (v < 10000) {+            const uint32_t d1 = (v / 100) << 1;+            const uint32_t d2 = (v % 100) << 1;+            +            if (v >= 1000)+                *buffer++ = gDigitsLut[d1];+            if (v >= 100)+                *buffer++ = gDigitsLut[d1 + 1];+            if (v >= 10)+                *buffer++ = gDigitsLut[d2];+            *buffer++ = gDigitsLut[d2 + 1];+        }+        else {+            // value = bbbbcccc+            const uint32_t b = v / 10000;+            const uint32_t c = v % 10000;+            +            const uint32_t d1 = (b / 100) << 1;+            const uint32_t d2 = (b % 100) << 1;+            +            const uint32_t d3 = (c / 100) << 1;+            const uint32_t d4 = (c % 100) << 1;+            +            if (value >= 10000000)+                *buffer++ = gDigitsLut[d1];+            if (value >= 1000000)+                *buffer++ = gDigitsLut[d1 + 1];+            if (value >= 100000)+                *buffer++ = gDigitsLut[d2];+            *buffer++ = gDigitsLut[d2 + 1];+            +            *buffer++ = gDigitsLut[d3];+            *buffer++ = gDigitsLut[d3 + 1];+            *buffer++ = gDigitsLut[d4];+            *buffer++ = gDigitsLut[d4 + 1];+        }+    }+    else if (value < 10000000000000000) {+        const uint32_t v0 = static_cast<uint32_t>(value / 100000000);+        const uint32_t v1 = static_cast<uint32_t>(value % 100000000);+        +        const uint32_t b0 = v0 / 10000;+        const uint32_t c0 = v0 % 10000;+        +        const uint32_t d1 = (b0 / 100) << 1;+        const uint32_t d2 = (b0 % 100) << 1;+        +        const uint32_t d3 = (c0 / 100) << 1;+        const uint32_t d4 = (c0 % 100) << 1;++        const uint32_t b1 = v1 / 10000;+        const uint32_t c1 = v1 % 10000;+        +        const uint32_t d5 = (b1 / 100) << 1;+        const uint32_t d6 = (b1 % 100) << 1;+        +        const uint32_t d7 = (c1 / 100) << 1;+        const uint32_t d8 = (c1 % 100) << 1;++        if (value >= 1000000000000000)+            *buffer++ = gDigitsLut[d1];+        if (value >= 100000000000000)+            *buffer++ = gDigitsLut[d1 + 1];+        if (value >= 10000000000000)+            *buffer++ = gDigitsLut[d2];+        if (value >= 1000000000000)+            *buffer++ = gDigitsLut[d2 + 1];+        if (value >= 100000000000)+            *buffer++ = gDigitsLut[d3];+        if (value >= 10000000000)+            *buffer++ = gDigitsLut[d3 + 1];+        if (value >= 1000000000)+            *buffer++ = gDigitsLut[d4];+        if (value >= 100000000)+            *buffer++ = gDigitsLut[d4 + 1];+        +        *buffer++ = gDigitsLut[d5];+        *buffer++ = gDigitsLut[d5 + 1];+        *buffer++ = gDigitsLut[d6];+        *buffer++ = gDigitsLut[d6 + 1];+        *buffer++ = gDigitsLut[d7];+        *buffer++ = gDigitsLut[d7 + 1];+        *buffer++ = gDigitsLut[d8];+        *buffer++ = gDigitsLut[d8 + 1];+    }+    else {+        const uint32_t a = static_cast<uint32_t>(value / 10000000000000000); // 1 to 1844+        value %= 10000000000000000;+        +        if (a < 10)+            *buffer++ = '0' + static_cast<char>(a);+        else if (a < 100) {+            const uint32_t i = a << 1;+            *buffer++ = gDigitsLut[i];+            *buffer++ = gDigitsLut[i + 1];+        }+        else if (a < 1000) {+            *buffer++ = '0' + static_cast<char>(a / 100);+            +            const uint32_t i = (a % 100) << 1;+            *buffer++ = gDigitsLut[i];+            *buffer++ = gDigitsLut[i + 1];+        }+        else {+            const uint32_t i = (a / 100) << 1;+            const uint32_t j = (a % 100) << 1;+            *buffer++ = gDigitsLut[i];+            *buffer++ = gDigitsLut[i + 1];+            *buffer++ = gDigitsLut[j];+            *buffer++ = gDigitsLut[j + 1];+        }+        +        const uint32_t v0 = static_cast<uint32_t>(value / 100000000);+        const uint32_t v1 = static_cast<uint32_t>(value % 100000000);+        +        const uint32_t b0 = v0 / 10000;+        const uint32_t c0 = v0 % 10000;+        +        const uint32_t d1 = (b0 / 100) << 1;+        const uint32_t d2 = (b0 % 100) << 1;+        +        const uint32_t d3 = (c0 / 100) << 1;+        const uint32_t d4 = (c0 % 100) << 1;+        +        const uint32_t b1 = v1 / 10000;+        const uint32_t c1 = v1 % 10000;+        +        const uint32_t d5 = (b1 / 100) << 1;+        const uint32_t d6 = (b1 % 100) << 1;+        +        const uint32_t d7 = (c1 / 100) << 1;+        const uint32_t d8 = (c1 % 100) << 1;+        +        *buffer++ = gDigitsLut[d1];+        *buffer++ = gDigitsLut[d1 + 1];+        *buffer++ = gDigitsLut[d2];+        *buffer++ = gDigitsLut[d2 + 1];+        *buffer++ = gDigitsLut[d3];+        *buffer++ = gDigitsLut[d3 + 1];+        *buffer++ = gDigitsLut[d4];+        *buffer++ = gDigitsLut[d4 + 1];+        *buffer++ = gDigitsLut[d5];+        *buffer++ = gDigitsLut[d5 + 1];+        *buffer++ = gDigitsLut[d6];+        *buffer++ = gDigitsLut[d6 + 1];+        *buffer++ = gDigitsLut[d7];+        *buffer++ = gDigitsLut[d7 + 1];+        *buffer++ = gDigitsLut[d8];+        *buffer++ = gDigitsLut[d8 + 1];+    }+    +    return buffer - start;+}++size_t i64toa_branchlut(int64_t value, char* buffer) {+    if (value < 0) {+        *buffer++ = '-';+        return 1 + u64toa_branchlut(~static_cast<uint64_t>(value) + 1u, buffer);+    } else {+        return u64toa_branchlut(static_cast<uint64_t>(value), buffer);+    }+}

@@ -0,0 +1,11 @@+/** <https://github.com/miloyip/itoa-benchmark/blob/940542a7770155ee3e9f2777ebc178dc899b43e0/src/branchlut.cpp>+ */++#pragma once++#include <stdint.h>++size_t u32toa_branchlut(uint32_t value, char* buffer);+size_t i32toa_branchlut(int32_t value, char* buffer);+size_t u64toa_branchlut(uint64_t value, char* buffer);+size_t i64toa_branchlut(int64_t value, char* buffer);

@@ -0,0 +1,395 @@+#include <stdio.h>+#include <stdlib.h>+#include <string.h>+#include <stdint.h>+#include <assert.h>++#include "branchlut.h"++/*+ * Append utf8, ASCII7, raw bytes, utf16+ * JSON encode utf8, ascii7, utf16+ */++#if defined(__clang__) || defined(__GNUC__)+  #define BW_NOINLINE __attribute__((noinline))+#else+  #define BW_NOINLINE+#endif++#if defined(__clang__) || defined(__GNUC__)+  #define BW_LIKELY(x) __builtin_expect(!!(x), 1)+  #define BW_UNLIKELY(x) __builtin_expect(!!(x), 0)+#else+  #define BW_LIKELY(x) x+  #define BW_UNLIKELY(x) x+#endif++#define BW_ENSURE_CAPACITY(bw, cap)                 \+    do {                                            \+        if (!ensureCapacity((bw), (cap))) {         \+            return;                                 \+        }                                           \+    } while (0)+++namespace {+    struct BufferWriter {+        unsigned char* end; // the most commonly-accessed field+        unsigned char* capacity;+        unsigned char* data;++        // invariants:+        // if (end <= capacity), then data is non-null and end >= data+        // if (capacity == 0), then data and end are null, and object is dead++        // Note: We mark the object dead upon growth failure in order+        // to avoid the need to check for errors after every single+        // append function.  The error can be raised upon the final+        // pointer release.+    };++    BW_NOINLINE bool actuallyGrow(BufferWriter* bw, size_t amount) {+        if (bw->capacity == 0) {+            // object is dead, ignore append request+            return false;+        }++        size_t size = bw->end - bw->data;+        size_t newCapacity = bw->capacity - bw->data;+        do {+            // TODO: detect overflow?+            newCapacity *= 2;+        } while (newCapacity < size + amount);+        +        unsigned char* newData = reinterpret_cast<unsigned char*>(realloc(bw->data, newCapacity));+        if (newData) {+            bw->data = newData;+            bw->end = newData + size;+            bw->capacity = newData + newCapacity;+            return true;+        } else {+            // TODO: try smaller growth?+            free(bw->data);+            bw->data = 0;+            bw->end = 0;+            bw->capacity = 0;+            return false;+        }+    }++    inline bool ensureCapacity(BufferWriter* bw, size_t amount) {+        if (BW_LIKELY(bw->end + amount <= bw->capacity)) {+            return true;+        } else {+            return actuallyGrow(bw, amount);+        }+    }+}++// assumes malloc will not fail+// TODO: replace assert with some other error mechanism++extern "C" BufferWriter* bw_new(size_t initialCapacity) {+    if (!initialCapacity) {+        initialCapacity = 1;+    }++    BufferWriter* bw = reinterpret_cast<BufferWriter*>(malloc(sizeof(BufferWriter)));+    if (!bw) {+        return 0;+    }++    bw->data = reinterpret_cast<unsigned char*>(malloc(initialCapacity));+    if (!bw->data) {+        free(bw);+        return 0;+    }++    bw->end = bw->data;+    bw->capacity = bw->data + initialCapacity;+    return bw;+}++extern "C" void bw_free(BufferWriter* bw) {+    free(bw->data);+    free(bw);+}++extern "C" void bw_trim(BufferWriter* bw) {+    if (bw->data == 0) {+        return;+    }++    if (bw->end < bw->capacity) {+        // try to shrink+        size_t size = bw->end - bw->data;+        unsigned char* data = reinterpret_cast<unsigned char*>(realloc(bw->data, size));+        if (data) {+            bw->data = data;+            bw->end = data + size;+            bw->capacity = data + size;+        } else {+            // no problem+        }+    }++}++extern "C" size_t bw_get_size(BufferWriter* bw) {+    return bw->end - bw->data;+}++extern "C" unsigned char* bw_release_address(BufferWriter* bw) {+    unsigned char* data = bw->data;++    bw->end = 0;+    bw->capacity = 0;+    bw->data = 0;+    return data; // null if dead+}++extern "C" void bw_append_byte(BufferWriter* bw, unsigned char byte) {+    BW_ENSURE_CAPACITY(bw, 1);++    bw->end[0] = byte;+    bw->end += 1;+}++extern "C" void bw_append_char_utf8(BufferWriter* bw, uint32_t c) {+    BW_ENSURE_CAPACITY(bw, 4);++    unsigned char* data = bw->end;++    if (c <= 0x7F) {+        data[0] = static_cast<unsigned char>(c);+        data += 1;+    } else if (c <= 0x7FF) {+        data[0] = static_cast<unsigned char>(0xC0 | (c >> 6));+        data[1] = static_cast<unsigned char>(0x80 | (c & 0x3F));+        data += 2;+    } else if (c <= 0xFFFF) {+        data[0] = static_cast<unsigned char>(0xE0 | (c >> 12));+        data[1] = static_cast<unsigned char>(0x80 | ((c >> 6) & 0x3F));+        data[2] = static_cast<unsigned char>(0x80 | (c & 0x3F));+        data += 3;+    } else if (c <= 0x1FFFFF) {+        data[0] = static_cast<unsigned char>(0xF0 | (c >> 18));+        data[1] = static_cast<unsigned char>(0x80 | ((c >> 12) & 0x3F));+        data[2] = static_cast<unsigned char>(0x80 | ((c >> 6) & 0x3F));+        data[3] = static_cast<unsigned char>(0x80 | (c & 0x3F));+        data += 4;+    } else {+        // Unicode characters out of this range are illegal...+        // should we assert?  or just ignore...+    }+    bw->end = data;+}++extern "C" void bw_append_bs(BufferWriter* bw, size_t size, const unsigned char* data) {+    BW_ENSURE_CAPACITY(bw, size);++    memcpy(bw->end, data, size);+    bw->end += size;+}++extern "C" void bw_append_bsz(BufferWriter* bw, const unsigned char* data) {+    bw_append_bs(bw, strlen(reinterpret_cast<const char*>(data)), data);+}++extern "C" void bw_append_byte7(BufferWriter* bw, unsigned char byte) {+    BW_ENSURE_CAPACITY(bw, 1);++    bw->end[0] = byte & 0x7F;+    bw->end += 1;+}++extern "C" void bw_append_bs7(BufferWriter* bw, size_t size, const unsigned char* data) {+    BW_ENSURE_CAPACITY(bw, size);++    unsigned char* out = bw->end;+    for (size_t i = 0; i < size; ++i) {+        out[i] = data[i] & 0x7F;+    }+    bw->end += size;+}++extern "C" void bw_append_bsz7(BufferWriter* bw, const unsigned char* data) {+    bw_append_bs7(bw, strlen(reinterpret_cast<const char*>(data)), data);+}++extern "C" void bw_append_json_escaped(BufferWriter* bw, size_t size, const unsigned char* data) {+    BW_ENSURE_CAPACITY(bw, 2 + size * 2);++    unsigned char* dest = bw->end;+    *dest++ = '\"';++    size_t i = 0;+    while (i < size) {+        switch (data[i]) {+            case '\n': *dest++ = '\\'; *dest++ = 'n';  break;+            case '\r': *dest++ = '\\'; *dest++ = 'r';  break;+            case '\t': *dest++ = '\\'; *dest++ = 't';  break;+            case '\\': *dest++ = '\\'; *dest++ = '\\'; break;+            case '\"': *dest++ = '\\'; *dest++ = '\"'; break;+            default:   *dest++ = data[i];+        }+        ++i;+    }++    *dest++ = '\"';+    bw->end = dest;+}++extern "C" void bw_append_decimal_signed_int(BufferWriter* bw, int64_t i) {+    BW_ENSURE_CAPACITY(bw, 32); // enough++    unsigned used = i64toa_branchlut(i, reinterpret_cast<char*>(bw->end));+    bw->end += used;+}++extern "C" void bw_append_decimal_double(BufferWriter* bw, double d) {+    BW_ENSURE_CAPACITY(bw, 318); // sprintf("%f", -DBL_MAX);++    size_t used = sprintf(reinterpret_cast<char*>(bw->end), "%f", d);+    bw->end += used;+}++// From <https://github.com/bos/text/blob/f74427c954fb4479f9db5025f27775e29ace125f/cbits/cbits.c#L234>+extern "C" void bw_encode_utf8(uint8_t **destp, const uint16_t *src, size_t srcoff, size_t srclen) {+  const uint16_t *srcend;+  uint8_t *dest = *destp;++  src += srcoff;+  srcend = src + srclen;++ ascii:+#if defined(__x86_64__)+  while (srcend - src >= 4) {+    uint64_t w = *((uint64_t *) src);++    if (w & 0xFF80FF80FF80FF80ULL) {+      if (!(w & 0x000000000000FF80ULL)) {+        *dest++ = w & 0xFFFF;+        src++;+        if (!(w & 0x00000000FF800000ULL)) {+          *dest++ = (w >> 16) & 0xFFFF;+          src++;+          if (!(w & 0x0000FF8000000000ULL)) {+            *dest++ = (w >> 32) & 0xFFFF;+            src++;+          }+        }+      }+      break;+    }+    *dest++ = w & 0xFFFF;+    *dest++ = (w >> 16) & 0xFFFF;+    *dest++ = (w >> 32) & 0xFFFF;+    *dest++ = w >> 48;+    src += 4;+  }+#endif++#if defined(__i386__)+  while (srcend - src >= 2) {+    uint32_t w = *((uint32_t *) src);++    if (w & 0xFF80FF80)+      break;+    *dest++ = w & 0xFFFF;+    *dest++ = w >> 16;+    src += 2;+  }+#endif++  while (src < srcend) {+    uint16_t w = *src++;++    if (w <= 0x7F) {+      *dest++ = w;+      /* An ASCII byte is likely to begin a run of ASCII bytes.+     Falling back into the fast path really helps performance. */+      goto ascii;+    }+    else if (w <= 0x7FF) {+      *dest++ = (w >> 6) | 0xC0;+      *dest++ = (w & 0x3f) | 0x80;+    }+    else if (w < 0xD800 || w > 0xDBFF) {+      *dest++ = (w >> 12) | 0xE0;+      *dest++ = ((w >> 6) & 0x3F) | 0x80;+      *dest++ = (w & 0x3F) | 0x80;+    } else {+      uint32_t c = ((((uint32_t) w) - 0xD800) << 10) ++    (((uint32_t) *src++) - 0xDC00) + 0x10000;+      *dest++ = (c >> 18) | 0xF0;+      *dest++ = ((c >> 12) & 0x3F) | 0x80;+      *dest++ = ((c >> 6) & 0x3F) | 0x80;+      *dest++ = (c & 0x3F) | 0x80;+    }+  }++  *destp = dest;+}++extern "C" void bw_append_json_escaped_utf16(BufferWriter* bw, size_t size, unsigned short* words) {+    // TODO: handle malloc failure+    // ideally no temp buffer would be required here.+    unsigned char* utf8 = reinterpret_cast<unsigned char*>(malloc(size * 4));+    assert(utf8);+    unsigned char* utf8end = utf8;++    bw_encode_utf8(&utf8end, words, 0, size);++    bw_append_json_escaped(bw, utf8end - utf8, utf8);++    free(utf8);+}++static const unsigned char UNRESERVED[256] = {+    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,+    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,+    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,1,1,0,+    1,1,1,1, 1,1,1,1, 1,1,0,0, 0,0,0,0,+    +    0,1,1,1, 1,1,1,1, 1,1,1,1, 1,1,1,1,+    1,1,1,1, 1,1,1,1, 1,1,1,0, 0,0,0,1,+    0,1,1,1, 1,1,1,1, 1,1,1,1, 1,1,1,1,+    1,1,1,1, 1,1,1,1, 1,1,1,0, 0,0,1,0,+    +    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,+    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,+    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,+    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,+    +    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,+    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,+    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,+    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0+};++static const unsigned char DEC2HEX[16] = {+    '0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f'+};++extern "C" void bw_append_url_encoded(BufferWriter* bw, size_t size, const unsigned char* data) {+    // worst case+    BW_ENSURE_CAPACITY(bw, size * 3);++    const unsigned char* src = data;+    unsigned char* dst = bw->end;+    while (size--) {+        unsigned char c = *src++;+        if (UNRESERVED[c]) {+            *dst++ = c;+        } else {+            dst[0] = '%';+            dst[1] = DEC2HEX[c >> 4];+            dst[2] = DEC2HEX[c & 0xF];+            dst += 3;+        }+    }++    bw->end = dst;+}

@@ -0,0 +1,3 @@+0.2.0.4++* Fix a buffer overrun in the double serializer

@@ -0,0 +1,331 @@+{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns, RecordWildCards, DeriveDataTypeable #-}++{-|+A library for efficiently building up a buffer of data.  When given data+known to be strict, use of BufferBuilder compiles directly into a series+of efficient C function calls.+-}+module Data.BufferBuilder (++    -- * The BufferBuilder Monad+      BufferBuilder+    , runBufferBuilder++    -- * Optional configuration+    , Options(..)+    , runBufferBuilderWithOptions++    -- * Appending bytes and byte strings+    , appendByte+    , appendChar8+    , appendBS+    , appendLBS+    , appendLiteral+    , unsafeAppendLiteralN++    -- * Appending bytes and byte strings, truncated to 7 bits+    , appendByte7+    , appendChar7+    , appendBS7+    , appendLiteral7+    , unsafeAppendLiteralN7++    -- * UTF-8 encoding+    , appendCharUtf8+    , appendStringUtf8++    -- * Printing numbers+    , appendDecimalSignedInt+    , appendDecimalDouble++    -- * JSON escaping+    , appendEscapedJson+    , appendEscapedJsonLiteral+    , appendEscapedJsonText++    -- * URL percent-encoding+    , appendUrlEncoded+    ) where++import GHC.Base+import GHC.Word+import GHC.Ptr+import GHC.IO+import GHC.ForeignPtr+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Lazy as BSL+import Control.Applicative (Applicative(..), pure)+import Control.Exception (Exception, throw)+import Control.Monad (when)+import Data.Typeable (Typeable)++import Data.Text () -- Show+import Data.Text.Internal (Text (..))+import Data.Text.Array (Array (..))++data Handle'+type Handle = Ptr Handle'++foreign import ccall unsafe "strlen" c_strlen :: Ptr Word8 -> IO Int+foreign import ccall unsafe "bw_new" bw_new :: Int -> IO Handle+foreign import ccall unsafe "&bw_free" bw_free :: FunPtr (Handle -> IO ())+foreign import ccall unsafe "bw_trim" bw_trim :: Handle -> IO ()+foreign import ccall unsafe "bw_get_size" bw_get_size :: Handle -> IO Int+foreign import ccall unsafe "bw_release_address" bw_release_address :: Handle -> IO (Ptr Word8)++foreign import ccall unsafe "bw_append_byte" bw_append_byte :: Handle -> Word8 -> IO ()+foreign import ccall unsafe "bw_append_char_utf8" bw_append_char_utf8 :: Handle -> Char -> IO ()+foreign import ccall unsafe "bw_append_bs" bw_append_bs :: Handle -> Int -> Ptr Word8 -> IO ()+foreign import ccall unsafe "bw_append_bsz" bw_append_bsz :: Handle -> Ptr Word8 -> IO ()++foreign import ccall unsafe "bw_append_byte7" bw_append_byte7 :: Handle -> Word8 -> IO ()+foreign import ccall unsafe "bw_append_bs7" bw_append_bs7 :: Handle -> Int -> Ptr Word8 -> IO ()+foreign import ccall unsafe "bw_append_bsz7" bw_append_bsz7 :: Handle -> Ptr Word8 -> IO ()++foreign import ccall unsafe "bw_append_decimal_signed_int" bw_append_decimal_signed_int :: Handle -> Int -> IO ()+foreign import ccall unsafe "bw_append_decimal_double" bw_append_decimal_double :: Handle -> Double -> IO ()++foreign import ccall unsafe "bw_append_json_escaped" bw_append_json_escaped :: Handle -> Int -> Ptr Word8 -> IO ()+foreign import ccall unsafe "bw_append_json_escaped_utf16" bw_append_json_escaped_utf16 :: Handle -> Int -> Ptr Word16 -> IO ()++foreign import ccall unsafe "bw_append_url_encoded" bw_append_url_encoded :: Handle -> Int -> Ptr Word8 -> IO ()++-- | BufferBuilder is the type of a monadic action that appends to an implicit,+-- growable buffer.  Use 'runBufferBuilder' to extract the resulting+-- buffer as a 'BS.ByteString'.  +newtype BufferBuilder a = BB (Handle -> IO a)+    --deriving (Applicative, Monad, MonadReader Handle)++unBB :: BufferBuilder a -> (Handle -> IO a)+unBB (BB a) = a++instance Functor BufferBuilder where+    {-# INLINE fmap #-}+    fmap f (BB a) = BB $ \h -> fmap f (a h)++instance Applicative BufferBuilder where+    {-# INLINE pure #-}+    pure = BB . const . pure++    {-# INLINE (<*>) #-}+    (BB f) <*> (BB a) = BB $ \h -> (f h) <*> (a h)++instance Monad BufferBuilder where+    {-# INLINE return #-}+    return = BB . const . return++    {-# INLINE (>>=) #-}+    (BB lhs) >>= next = BB $ \h -> do+        a <- lhs h+        unBB (next a) h++withHandle :: (Handle -> IO ()) -> BufferBuilder ()+withHandle = BB+{-# INLINE withHandle #-}++data BufferOutOfMemoryError = BufferOutOfMemoryError+    deriving (Show, Typeable)+instance Exception BufferOutOfMemoryError++data Options = Options+    { initialCapacity :: !Int+    , trimFinalBuffer :: !Bool+    }++defaultOptions :: Options+defaultOptions = Options+    { initialCapacity = 128 -- some quantitative data would be great+    , trimFinalBuffer = False+    }++-- | Run a sequence of 'BufferBuilder' actions and extract the resulting+-- buffer as a 'BS.ByteString'.+runBufferBuilder :: BufferBuilder () -> BS.ByteString+runBufferBuilder = runBufferBuilderWithOptions defaultOptions++runBufferBuilderWithOptions :: Options -> BufferBuilder () -> BS.ByteString+runBufferBuilderWithOptions options = unsafeDupablePerformIO . runBufferBuilderIO options++runBufferBuilderIO :: Options-> BufferBuilder () -> IO BS.ByteString+runBufferBuilderIO !Options{..} !(BB bw) = do+    handle <- bw_new initialCapacity+    when (handle == nullPtr) $ do+        throw BufferOutOfMemoryError+    +    handleFP <- newForeignPtr bw_free handle+    () <- bw handle++    when trimFinalBuffer $ do+        bw_trim handle++    -- FFI doesn't support returning multiple arguments, so we need+    -- two calls: one for the size and the other to release the+    -- pointer.+    size <- bw_get_size handle+    src <- bw_release_address handle++    when (src == nullPtr) $ do+        throw BufferOutOfMemoryError++    borrowed <- newForeignPtr finalizerFree src+    let bs = BS.fromForeignPtr borrowed 0 size+    touchForeignPtr handleFP+    return bs++-- | Append a single byte to the output buffer.  To append multiple bytes in sequence and+-- avoid redundant bounds checks, consider using 'appendBS', 'appendLiteral', or 'unsafeAppendLiteralN'.+appendByte :: Word8 -> BufferBuilder ()+appendByte b = withHandle $ \h -> bw_append_byte h b+{-# INLINE appendByte #-}++c2w :: Char -> Word8+c2w = fromIntegral . ord+{-# INLINE c2w #-}++-- | Appends a character to the buffer, truncating it to the bottom 8 bits.+appendChar8 :: Char -> BufferBuilder ()+appendChar8 = appendByte . c2w+{-# INLINE appendChar8 #-}++-- | Appends a 'BS.ByteString' to the buffer.  When appending constant, hardcoded strings, to+-- avoid a CAF and the costs of its associated tag check and indirect jump, use+-- 'appendLiteral' or 'unsafeAppendLiteralN' instead.+appendBS :: BS.ByteString -> BufferBuilder ()+appendBS !(BS.PS fp offset len) =+    withHandle $ \h ->+        withForeignPtr fp $ \addr ->+            bw_append_bs h len (plusPtr addr offset)+{-# INLINE appendBS #-}++-- | Appends a lazy 'BSL.ByteString' to the buffer.  This function operates by traversing+-- the lazy 'BSL.ByteString' chunks, appending each in turn.+appendLBS :: BSL.ByteString -> BufferBuilder ()+appendLBS lbs = mapM_ appendBS $ BSL.toChunks lbs+{-# INLINABLE appendLBS #-}++-- | Appends a zero-terminated MagicHash string literal.  Use this function instead of+-- 'appendBS' for string constants.  For example:+--+-- > appendLiteral "true"#+--+-- If the length of the string literal is known, calling+-- 'unsafeAppendLiteralN' is faster, as 'unsafeAppendLiteralN' avoids a strlen+-- operation which has nontrivial cost in some benchmarks.+appendLiteral :: Addr# -> BufferBuilder ()+appendLiteral addr =+    withHandle $ \h ->+        bw_append_bsz h (Ptr addr)+{-# INLINE appendLiteral #-}++-- | Appends a MagicHash string literal with a known length.  Use this when the+-- string literal's length is known.  For example:+--+-- > unsafeAppendLiteralN 4 "true"#+--+-- Per byte, this is the fastest append function.  It amounts to a C function call+-- with two constant arguments.  The C function checks to see if it needs to grow+-- the buffer and then it simply calls memcpy.+-- +-- __WARNING__: passing an incorrect length value is likely to cause an access+-- violation or worse.+unsafeAppendLiteralN :: Int -> Addr# -> BufferBuilder ()+unsafeAppendLiteralN len addr =+    withHandle $ \h ->+        bw_append_bs h len (Ptr addr)+{-# INLINE unsafeAppendLiteralN #-}+++-- 7-bit truncation++appendByte7 :: Word8 -> BufferBuilder ()+appendByte7 b = withHandle $ \h -> bw_append_byte7 h b+{-# INLINE appendByte7 #-}++appendChar7 :: Char -> BufferBuilder ()+appendChar7 = appendByte7 . c2w+{-# INLINE appendChar7 #-}++appendBS7 :: BS.ByteString -> BufferBuilder ()+appendBS7 !(BS.PS fp offset len) =+    withHandle $ \h ->+        withForeignPtr fp $ \addr ->+            bw_append_bs7 h len (plusPtr addr offset)+{-# INLINE appendBS7 #-}++appendLiteral7 :: Addr# -> BufferBuilder ()+appendLiteral7 addr =+    withHandle $ \h ->+        bw_append_bsz7 h (Ptr addr)+{-# INLINE appendLiteral7 #-}++unsafeAppendLiteralN7 :: Int -> Addr# -> BufferBuilder ()+unsafeAppendLiteralN7 len addr =+    withHandle $ \h ->+        bw_append_bs7 h len (Ptr addr)+{-# INLINE unsafeAppendLiteralN7 #-}++-- Encoding UTF-8++-- | Appends a UTF-8-encoded 'Char' to the buffer.+appendCharUtf8 :: Char -> BufferBuilder ()+appendCharUtf8 c = withHandle $ \h -> bw_append_char_utf8 h c+{-# INLINE appendCharUtf8 #-}++-- | Appends a UTF-8-encoded 'String' to the buffer.  The best way to improve performance here+-- is to use 'BS.ByteString' or 'Text' instead of 'String'.+appendStringUtf8 :: String -> BufferBuilder ()+appendStringUtf8 = mapM_ appendCharUtf8+{-# INLINABLE appendStringUtf8 #-}+++-- Printing Numbers++-- | Appends a decimal integer, just like calling printf("%d", ...)+appendDecimalSignedInt :: Int -> BufferBuilder ()+appendDecimalSignedInt i =+    withHandle $ \h ->+        bw_append_decimal_signed_int h i+{-# INLINE appendDecimalSignedInt #-}++-- | Appends a decimal double, just like calling printf("%f", ...)+appendDecimalDouble :: Double -> BufferBuilder ()+appendDecimalDouble d =+    withHandle $ \h ->+        bw_append_decimal_double h d+{-# INLINE appendDecimalDouble #-}+++-- Encoding JSON++appendEscapedJson :: BS.ByteString -> BufferBuilder ()+appendEscapedJson !(BS.PS (ForeignPtr addr _) offset len) =+    withHandle $ \h ->+        bw_append_json_escaped h len (plusPtr (Ptr addr) offset)+{-# INLINE appendEscapedJson #-}++appendEscapedJsonLiteral :: Addr# -> BufferBuilder ()+appendEscapedJsonLiteral addr =+    withHandle $ \h -> do+        len <- c_strlen (Ptr addr)+        bw_append_json_escaped h len (Ptr addr)+{-# INLINE appendEscapedJsonLiteral #-}++appendEscapedJsonText :: Text -> BufferBuilder ()+appendEscapedJsonText !(Text arr ofs len) =+    let byteArray = aBA arr+    in withHandle $ \h ->+        bw_append_json_escaped_utf16 h len (Ptr (byteArrayContents# byteArray) `plusPtr` ofs)+{-# INLINE appendEscapedJsonText #-}++-- | Append a percent-encoded ByteString.  All characters except for+-- alphanumerics, -, ., _, and ~ will be encoded.  The string produced+-- by URL encoding is guaranteed ASCII-7 and thus valid UTF-8.+-- Moreover, it is not required to be JSON-escaped.+appendUrlEncoded :: BS.ByteString -> BufferBuilder ()+appendUrlEncoded !(BS.PS (ForeignPtr addr _) offset len) =+    withHandle $ \h ->+        bw_append_url_encoded h len (plusPtr (Ptr addr) offset)+{-# INLINE appendUrlEncoded #-}

@@ -0,0 +1,324 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns, UndecidableInstances #-}++{-|+A library for efficiently building up a valid JSON document.++The difference between "Data.BufferBuilder.Json" and the excellent+"Data.Aeson" is that Aeson represents the JSON document as an+in-memory tree structure before encoding it into bytes.  This module,+on the other hand, represents each value as an action that writes its+representation directly into the output buffer.  At the cost of+reduced flexibility, this results in significantly improved encoding+performance.  At the time of this writing, encoding a custom record+type into JSON using this module was almost 5x faster than using+Aeson.++This module is built on top of "Data.Utf8Builder".+-}+module Data.BufferBuilder.Json+    (+    -- * Encoding Values+      Value+    , ToJson (..)+    , encodeJson++    -- * Objects+    , ObjectBuilder+    , emptyObject+    , (.=)+    , (.=#)++    -- * Arrays+    , array++    -- * Null+    , nullValue++    -- * Unsafe+    , unsafeAppendBS+    , unsafeAppendUtf8Builder+    ) where++import GHC.Base+import Foreign.Storable+import Control.Monad (when, forM_)+import Data.BufferBuilder.Utf8 (Utf8Builder)+import qualified Data.BufferBuilder.Utf8 as UB+import Data.ByteString (ByteString)+import Data.Monoid+import Data.Text (Text)+import Data.Foldable (Foldable, foldMap)+import qualified Data.Vector as Vector+import qualified Data.Vector.Generic as GVector+import qualified Data.Vector.Primitive as VP+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU+import qualified Data.HashMap.Strict as HashMap++-- | Represents a JSON value.+--+-- 'Value's are built up from either 'ToJson' instances or+-- from primitives like 'emptyObject', 'array', and 'null'.+--+-- In special cases, or when performance is of utmost importance, the+-- unsafe functions 'unsafeAppendBS' and 'unsafeAppendUtf8Builder' are+-- available.+--+-- Internally, Value encodes an action or sequence of actions that append+-- JSON-encoded text to the underlying 'Utf8Builder'.+newtype Value = Value { utf8Builder :: Utf8Builder () }++-- | The class of types that can be converted to JSON values.  See+-- 'ObjectBuilder' for an example of writing a 'ToJson' instance for a+-- custom data type.+--+-- 'ToJson' instances are provided for many common types.  For+-- example, to create a JSON array, call 'toJson' on a list or 'Vector.Vector'.+-- To create a JSON object, call 'toJson' on a 'HashMap.HashMap'.+class ToJson a where+    toJson :: a -> Value++---- General JSON value support++-- | Encode a value into a 'ByteString' containing valid UTF-8-encoded JSON.+-- The argument value must have a corresponding 'ToJson' instance.+--+-- __WARNING__: There are three cases where the resulting 'ByteString' may not contain+-- legal JSON:+--+-- * An unsafe function was used to encode a JSON value.+-- * The root value is not an object or array, as the JSON specification requires.+-- * An object has multiple keys with the same value.  For maximum efficiency,+--   'ObjectBuilder' does not check key names for uniqueness, so it's possible to+--   construct objects with duplicate keys.+encodeJson :: ToJson a => a -> ByteString+encodeJson = UB.runUtf8Builder . utf8Builder . toJson+{-# INLINE encodeJson #-}++---- Objects++-- | Builds a JSON object.+--+-- An 'ObjectBuilder' builds one or more key-value pairs of a JSON object.  They are constructed with the '.=' operator and+-- combined with 'Data.Monoid.<>'.+--+-- To turn an 'ObjectBuilder' into a 'Value', use its 'ToJson' class instance.+--+-- @+--     data Friend = Friend+--         { fId :: !Int+--         , fName :: !Text+--         } deriving (Eq, Show)+--+--     instance ToJson Friend where+--         toJson friend = toJson $+--                    "id"   .= fId friend+--                 <> "name" .= fName friend+-- @+--+-- __WARNING__: 'ObjectBuilder' does not check uniqueness of object+-- keys.  If two keys with the same value are inserted, then the+-- resulting JSON document will be illegal.+data ObjectBuilder = NoPair | Pair !(Utf8Builder ())++instance Monoid ObjectBuilder where+    {-# INLINE mempty #-}+    mempty = NoPair++    {-# INLINE mappend #-}+    mappend NoPair a = a+    mappend a NoPair = a+    mappend (Pair a) (Pair b) = Pair $ do +        a+        UB.appendChar7 ','+        b++instance ToJson ObjectBuilder where+    {-# INLINE toJson #-}+    toJson NoPair = Value $ do+        UB.appendChar7 '{'+        UB.appendChar7 '}'++    toJson (Pair a) = Value $ do+        UB.appendChar7 '{'+        a+        UB.appendChar7 '}'++-- | A 'Value' that produces the empty object.+emptyObject :: Value+emptyObject = toJson NoPair+{-# INLINE emptyObject #-}++-- | Create an 'ObjectBuilder' from a key and a value.+(.=) :: ToJson a => Text -> a -> ObjectBuilder+a .= b = Pair $ do+    UB.appendEscapedJsonText a+    UB.appendChar7 ':'+    utf8Builder $ toJson b+infixr 8 .=+{-# INLINE (.=) #-}++-- | Create an 'ObjectBuilder' from a key and a value.  The key is an+-- ASCII-7, unescaped, zero-terminated 'Addr#'.+--+-- __WARNING__: This function is unsafe.  If the key is NOT+-- zero-terminated, then an access violation might result.  If the key+-- is not a sequence of unescaped ASCII characters, the resulting JSON+-- document will be illegal.+--+-- This function is provided for maximum performance in the common+-- case that object keys are ASCII-7.  It achieves performance by+-- avoiding the CAF for a Text literal and avoiding the need to+-- transcode UTF-16 to UTF-8 and escape.+--+-- To use this function, the calling source file must have the+-- MagicHash extension enabled.+--+-- @+--     data Friend = Friend+--         { fId :: !Int+--         , fName :: !Text+--         } deriving (Eq, Show)+--+--     instance ToJson Friend where+--         toJson friend = toJson $+--                    "id"\#   .=\# fId friend+--                 <> "name"\# .=\# fName friend+-- @+(.=#) :: ToJson a => Addr# -> a -> ObjectBuilder+a .=# b = Pair $ do+    UB.appendEscapedJsonLiteral a+    UB.appendChar7 ':'+    utf8Builder $ toJson b+infixr 8 .=#+{-# INLINE (.=#) #-}+++{-# INLINE writePair #-}+writePair :: ToJson a => (Text, a) -> Utf8Builder ()+writePair (key, value) = do+    UB.appendEscapedJsonText key+    UB.appendChar7 ':'+    utf8Builder $ toJson value++instance ToJson a => ToJson (HashMap.HashMap Text a) where+    {-# INLINABLE toJson #-}+    toJson hm = Value $ do+        UB.appendChar7 '{'+        case HashMap.toList hm of+            [] -> UB.appendChar7 '}'+            (x:xs) -> do+                writePair x+                forM_ xs $ \p -> do+                    UB.appendChar7 ','+                    writePair p+                UB.appendChar7 '}'++---- Arrays++-- | Serialize any 'Foldable' as a JSON array.  This is generally+-- slower than directly calling 'toJson' on a list or 'Vector.Vector',+-- but it will convert any 'Foldable' type into an array.+array :: (Foldable t, ToJson a) => t a -> Value+array collection = Value $ do+    UB.appendChar7 '['+    -- HACK: ObjectBuilder is not "type correct" but it has exactly the behaviour we want for this function.+    case foldMap (Pair . utf8Builder . toJson) collection of+        NoPair -> return ()+        (Pair b) -> b+    UB.appendChar7 ']'+{-# INLINABLE array #-}++instance ToJson a => ToJson [a] where+    {-# INLINABLE toJson #-}+    toJson !ls = Value $ do+        UB.appendChar7 '['+        case ls of+            [] -> UB.appendChar7 ']'+            x:xs -> do+                utf8Builder $ toJson x+                forM_ xs $ \(!e) -> do+                    UB.appendChar7 ','+                    utf8Builder $ toJson e+                UB.appendChar7 ']'++instance ToJson a => ToJson (Vector.Vector a) where+    {-# INLINABLE toJson #-}+    toJson = vector++instance (Storable a, ToJson a) => ToJson (VS.Vector a) where+    {-# INLINABLE toJson #-}+    toJson = vector++instance (VP.Prim a, ToJson a) => ToJson (VP.Vector a) where+    {-# INLINABLE toJson #-}+    toJson = vector++instance (GVector.Vector VU.Vector a, ToJson a) => ToJson (VU.Vector a) where+    {-# INLINABLE toJson #-}+    toJson = vector++{-# INLINABLE vector #-}+vector :: (GVector.Vector v a, ToJson a) => v a -> Value+vector !vec = Value $ do+    UB.appendChar7 '['+    let len = GVector.length vec+    when (len /= 0) $ do+        utf8Builder $ toJson (vec `GVector.unsafeIndex` 0)+        GVector.forM_ (GVector.tail vec) $ \e -> do+            UB.appendChar7 ','+            utf8Builder $ toJson e+    UB.appendChar7 ']'+++----++-- | Represents a JSON "null".+nullValue :: Value+nullValue = Value $ UB.unsafeAppendLiteralN 4 "null"#+{-# INLINE nullValue #-}++---- Common JSON instances++instance ToJson Value where+    {-# INLINE toJson #-}+    toJson = id++instance ToJson Bool where+    {-# INLINE toJson #-}+    toJson True = Value $ UB.unsafeAppendLiteralN 4 "true"#+    toJson False = Value $ UB.unsafeAppendLiteralN 5 "false"#++instance ToJson a => ToJson (Maybe a) where+    {-# INLINE toJson #-}+    toJson m = case m of+        Nothing -> Value $ UB.unsafeAppendLiteralN 4 "null"#+        Just a -> toJson a++instance ToJson Text where+    {-# INLINE toJson #-}+    toJson txt = Value $ UB.appendEscapedJsonText txt++instance ToJson Double where+    {-# INLINE toJson #-}+    toJson a = Value $ UB.appendDecimalDouble a++instance ToJson Int where+    {-# INLINE toJson #-}+    toJson a = Value $ UB.appendDecimalSignedInt a+++---- Unsafe functions++-- | Unsafely append a string into a JSON document.+-- This function does /not/ escape, quote, or otherwise decorate the string in any way.+-- This function is /unsafe/ because you can trivially use it to generate illegal JSON.+unsafeAppendBS :: ByteString -> Value+unsafeAppendBS bs = Value $ UB.unsafeAppendBS bs++-- | Unsafely append a 'Utf8Builder' into a JSON document.+-- This function does not escape, quote, or decorate the string in any way.+-- This function is /unsafe/ because you can trivially use it to generate illegal JSON.+unsafeAppendUtf8Builder :: Utf8Builder () -> Value+unsafeAppendUtf8Builder utf8b = Value utf8b

@@ -0,0 +1,174 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, MagicHash, BangPatterns #-}++{-|+A library for efficiently building up a buffer of UTF-8-encoded text.  If only+safe functions are used, the resulting 'ByteString' is guaranteed to be valid+UTF-8.++To run a sequence of Utf8Builder actions and retrieve the resulting buffer, use+'runUtf8Builder'.++In special situations, for maximum performance, unsafe functions are+also provided.  The unsafe functions do not guarantee the buffer is+correct UTF-8.++This module is built on top of "Data.BufferBuilder".+-}+module Data.BufferBuilder.Utf8 (++    -- * The Utf8Builder Monad+      Utf8Builder+    , runUtf8Builder++    -- * Text encoding+    , appendText+    , appendString+    , appendChar++    -- * ASCII-7+    , appendByte7+    , appendChar7+    , appendBS7+    , appendLiteral7++    -- * Printing numbers+    , appendDecimalSignedInt+    , appendDecimalDouble++    -- * Escaped JSON+    , appendEscapedJson+    , appendEscapedJsonLiteral+    , appendEscapedJsonText++    -- * Unsafe append operations+    , unsafeAppendByte+    , unsafeAppendChar8+    , unsafeAppendLiteral+    , unsafeAppendLiteralN+    , unsafeAppendBS+    ) where++import GHC.Base+import GHC.Word+import Control.Applicative+import Data.ByteString (ByteString)+import Data.BufferBuilder (BufferBuilder)+import qualified Data.BufferBuilder as BB+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)++newtype Utf8Builder a = Utf8Builder { unBuilder :: BufferBuilder a }+    deriving (Functor, Applicative, Monad)++-- | Run a sequence of 'Utf8Builder' actions and extracting the resulting+-- buffer as a 'ByteString'.+runUtf8Builder :: Utf8Builder () -> ByteString+runUtf8Builder a = BB.runBufferBuilder $ unBuilder a+{-# INLINE runUtf8Builder #-}+++-- Text encoding++-- TODO: optimize appendText with custom UTF-16 -> UTF-8 encoder in C++-- | Encodes the given 'Text' in UTF-8, appending it to the buffer.+appendText :: Text -> Utf8Builder ()+appendText a = Utf8Builder $ BB.appendBS $ encodeUtf8 a+{-# INLINE appendText #-}++-- | Encodes the given 'String' in UTF-8, appending it to the buffer.+appendString :: String -> Utf8Builder ()+appendString s = mapM_ appendChar s+{-# INLINABLE appendString #-}++-- | Encodes a single 'Char' in UTF-8, appending it to the buffer.+appendChar :: Char -> Utf8Builder ()+appendChar c = Utf8Builder $ BB.appendCharUtf8 c+{-# INLINE appendChar #-}+++-- ASCII-7++-- | Appends the bottom 7 bits of a byte to the buffer.+appendByte7 :: Word8 -> Utf8Builder ()+appendByte7 = Utf8Builder . BB.appendByte7+{-# INLINE appendByte7 #-}++-- | Appends the bottom 7 bits of a 'Char' to the buffer.+appendChar7 :: Char -> Utf8Builder ()+appendChar7 = Utf8Builder . BB.appendChar7+{-# INLINE appendChar7 #-}++-- | Appends the given ByteString to the buffer, taking the bottom+-- 7 bits of each byte.+appendBS7 :: ByteString -> Utf8Builder ()+appendBS7 = Utf8Builder . BB.appendBS7+{-# INLINE appendBS7 #-}++-- | Appends the zero-terminated byte string at the given address+-- to the buffer, taking the bottom 7 bits of each byte.+appendLiteral7 :: Addr# -> Utf8Builder ()+appendLiteral7 addr = Utf8Builder $ BB.appendLiteral7 addr+{-# INLINE appendLiteral7 #-}+++-- Printing numbers++appendDecimalSignedInt :: Int -> Utf8Builder ()+appendDecimalSignedInt a = Utf8Builder $ BB.appendDecimalSignedInt a+{-# INLINE appendDecimalSignedInt #-}++appendDecimalDouble :: Double -> Utf8Builder ()+appendDecimalDouble d = Utf8Builder $ BB.appendDecimalDouble d+{-# INLINE appendDecimalDouble #-}+++-- Escaped JSON++appendEscapedJsonLiteral :: Addr# -> Utf8Builder ()+appendEscapedJsonLiteral addr = Utf8Builder $ BB.appendEscapedJsonLiteral addr++appendEscapedJson :: ByteString -> Utf8Builder ()+appendEscapedJson a = Utf8Builder $ BB.appendEscapedJson a+{-# INLINE appendEscapedJson #-}++appendEscapedJsonText :: Text -> Utf8Builder ()+appendEscapedJsonText txt = Utf8Builder $ BB.appendEscapedJsonText txt+{-# INLINE appendEscapedJsonText #-}+++-- Unsafe++-- | Directly append a byte into the UTF-8 code stream.  Incorrect use of+-- this function can result in invalid UTF-8.+unsafeAppendByte :: Word8 -> Utf8Builder ()+unsafeAppendByte = Utf8Builder . BB.appendByte+{-# INLINE unsafeAppendByte #-}++-- | Directly append the bottom 8 bits of the given character to the UTF-8+-- code stream.  Incorrect use of this function can result in invalid UTF-8.+unsafeAppendChar8 :: Char -> Utf8Builder ()+unsafeAppendChar8 = Utf8Builder . BB.appendChar8+{-# INLINE unsafeAppendChar8 #-}++-- | Directly append the zero-terminated byte sequence pointed to by+-- the given address.  Be careful that the referenced byte sequence+-- contains valid UTF-8.+unsafeAppendLiteral :: Addr# -> Utf8Builder ()+unsafeAppendLiteral addr = Utf8Builder $ BB.appendLiteral addr+{-# INLINE unsafeAppendLiteral #-}++-- | Directly append the given byte sequence pointed to by the given address.+-- Be careful that the referenced byte sequence contains valid UTF-8.+--+-- __WARNING__: passing an incorrect length value is likely to cause an access+-- violation or worse.+unsafeAppendLiteralN :: Int -> Addr# -> Utf8Builder ()+unsafeAppendLiteralN !len addr = Utf8Builder $ BB.unsafeAppendLiteralN len addr+{-# INLINE unsafeAppendLiteralN #-}++-- | Directly append the given 'ByteString' to the output buffer.+-- Be careful that the referenced 'ByteString' contains valid UTF-8.+unsafeAppendBS :: ByteString -> Utf8Builder ()+unsafeAppendBS a = Utf8Builder $ BB.appendBS a+{-# INLINE unsafeAppendBS #-}

@@ -33,6 +33,20 @@             appendLiteral "bar"#     assertEqual "matches" "foobar" result +case_append_url_encoded_safe :: Assertion+case_append_url_encoded_safe = do+    let safe = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_"+    let result = runBufferBuilder $ do+            appendUrlEncoded safe+    assertEqual "matches" safe result++case_append_url_encoded_unsafe :: Assertion+case_append_url_encoded_unsafe = do+    let safe = "\0\1 /\\$%"+    let result = runBufferBuilder $ do+            appendUrlEncoded safe+    assertEqual "matches" "%00%01%20%2f%5c%24%25" result+ prop_match_intDec :: Int -> Bool prop_match_intDec i = runBufferBuilder (appendDecimalSignedInt i) == (BSC.pack $ show i)