{-# LANGUAGE CPP, 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
    , runBufferBuilder'

    -- * Optional configuration
    , Options(..)
    , runBufferBuilderWithOptions
    , runBufferBuilderWithOptions'

    -- * Query builder
    , calculateLength
    , currentLength

    -- * 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_new_length_calculator" bw_new_length_calculator :: 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 :: BufferBuilder a -> Handle -> IO a
unBB (BB Handle -> IO a
a) = Handle -> IO a
a

instance Functor BufferBuilder where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> BufferBuilder a -> BufferBuilder b
fmap a -> b
f (BB Handle -> IO a
a) = (Handle -> IO b) -> BufferBuilder b
forall a. (Handle -> IO a) -> BufferBuilder a
BB ((Handle -> IO b) -> BufferBuilder b)
-> (Handle -> IO b) -> BufferBuilder b
forall a b. (a -> b) -> a -> b
$ \Handle
h -> (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Handle -> IO a
a Handle
h)

instance Applicative BufferBuilder where
    {-# INLINE pure #-}
    pure :: a -> BufferBuilder a
pure = (Handle -> IO a) -> BufferBuilder a
forall a. (Handle -> IO a) -> BufferBuilder a
BB ((Handle -> IO a) -> BufferBuilder a)
-> (a -> Handle -> IO a) -> a -> BufferBuilder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Handle -> IO a
forall a b. a -> b -> a
const (IO a -> Handle -> IO a) -> (a -> IO a) -> a -> Handle -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    {-# INLINE (<*>) #-}
    (BB Handle -> IO (a -> b)
f) <*> :: BufferBuilder (a -> b) -> BufferBuilder a -> BufferBuilder b
<*> (BB Handle -> IO a
a) = (Handle -> IO b) -> BufferBuilder b
forall a. (Handle -> IO a) -> BufferBuilder a
BB ((Handle -> IO b) -> BufferBuilder b)
-> (Handle -> IO b) -> BufferBuilder b
forall a b. (a -> b) -> a -> b
$ \Handle
h -> (Handle -> IO (a -> b)
f Handle
h) IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Handle -> IO a
a Handle
h)

instance Monad BufferBuilder where
    {-# INLINE return #-}
    return :: a -> BufferBuilder a
return = (Handle -> IO a) -> BufferBuilder a
forall a. (Handle -> IO a) -> BufferBuilder a
BB ((Handle -> IO a) -> BufferBuilder a)
-> (a -> Handle -> IO a) -> a -> BufferBuilder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Handle -> IO a
forall a b. a -> b -> a
const (IO a -> Handle -> IO a) -> (a -> IO a) -> a -> Handle -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

    {-# INLINE (>>=) #-}
    (BB Handle -> IO a
lhs) >>= :: BufferBuilder a -> (a -> BufferBuilder b) -> BufferBuilder b
>>= a -> BufferBuilder b
next = (Handle -> IO b) -> BufferBuilder b
forall a. (Handle -> IO a) -> BufferBuilder a
BB ((Handle -> IO b) -> BufferBuilder b)
-> (Handle -> IO b) -> BufferBuilder b
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
        a
a <- Handle -> IO a
lhs Handle
h
        BufferBuilder b -> Handle -> IO b
forall a. BufferBuilder a -> Handle -> IO a
unBB (a -> BufferBuilder b
next a
a) Handle
h

withHandle :: (Handle -> IO a) -> BufferBuilder a
withHandle :: (Handle -> IO a) -> BufferBuilder a
withHandle = (Handle -> IO a) -> BufferBuilder a
forall a. (Handle -> IO a) -> BufferBuilder a
BB
{-# INLINE withHandle #-}

data BufferOutOfMemoryError = BufferOutOfMemoryError
    deriving (Int -> BufferOutOfMemoryError -> ShowS
[BufferOutOfMemoryError] -> ShowS
BufferOutOfMemoryError -> String
(Int -> BufferOutOfMemoryError -> ShowS)
-> (BufferOutOfMemoryError -> String)
-> ([BufferOutOfMemoryError] -> ShowS)
-> Show BufferOutOfMemoryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BufferOutOfMemoryError] -> ShowS
$cshowList :: [BufferOutOfMemoryError] -> ShowS
show :: BufferOutOfMemoryError -> String
$cshow :: BufferOutOfMemoryError -> String
showsPrec :: Int -> BufferOutOfMemoryError -> ShowS
$cshowsPrec :: Int -> BufferOutOfMemoryError -> ShowS
Show, Typeable)
instance Exception BufferOutOfMemoryError

data Options = Options
    { Options -> Int
initialCapacity :: !Int
    , Options -> Bool
trimFinalBuffer :: !Bool
    }

defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options :: Int -> Bool -> Options
Options
    { initialCapacity :: Int
initialCapacity = Int
128 -- some quantitative data would be great
    , trimFinalBuffer :: Bool
trimFinalBuffer = Bool
False
    }

-- | Run a sequence of 'BufferBuilder' actions and extract the resulting
-- buffer as a 'BS.ByteString'.
runBufferBuilder :: BufferBuilder a -> BS.ByteString
runBufferBuilder :: BufferBuilder a -> ByteString
runBufferBuilder = (a, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((a, ByteString) -> ByteString)
-> (BufferBuilder a -> (a, ByteString))
-> BufferBuilder a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferBuilder a -> (a, ByteString)
forall a. BufferBuilder a -> (a, ByteString)
runBufferBuilder'

-- | Run a sequence of 'BufferBuilder' actions and extract the resulting
-- buffer as a 'BS.ByteString'.  Also returns the BufferBuilder's result.
runBufferBuilder' :: BufferBuilder a -> (a, BS.ByteString)
runBufferBuilder' :: BufferBuilder a -> (a, ByteString)
runBufferBuilder' = Options -> BufferBuilder a -> (a, ByteString)
forall a. Options -> BufferBuilder a -> (a, ByteString)
runBufferBuilderWithOptions' Options
defaultOptions

runBufferBuilderWithOptions :: Options -> BufferBuilder a -> BS.ByteString
runBufferBuilderWithOptions :: Options -> BufferBuilder a -> ByteString
runBufferBuilderWithOptions Options
options = (a, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((a, ByteString) -> ByteString)
-> (BufferBuilder a -> (a, ByteString))
-> BufferBuilder a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> BufferBuilder a -> (a, ByteString)
forall a. Options -> BufferBuilder a -> (a, ByteString)
runBufferBuilderWithOptions' Options
options

runBufferBuilderWithOptions' :: Options -> BufferBuilder a -> (a, BS.ByteString)
runBufferBuilderWithOptions' :: Options -> BufferBuilder a -> (a, ByteString)
runBufferBuilderWithOptions' Options
options = IO (a, ByteString) -> (a, ByteString)
forall a. IO a -> a
unsafeDupablePerformIO (IO (a, ByteString) -> (a, ByteString))
-> (BufferBuilder a -> IO (a, ByteString))
-> BufferBuilder a
-> (a, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> BufferBuilder a -> IO (a, ByteString)
forall a. Options -> BufferBuilder a -> IO (a, ByteString)
runBufferBuilderIO Options
options

runBufferBuilderIO :: Options -> BufferBuilder a -> IO (a, BS.ByteString)
runBufferBuilderIO :: Options -> BufferBuilder a -> IO (a, ByteString)
runBufferBuilderIO !Options{Bool
Int
trimFinalBuffer :: Bool
initialCapacity :: Int
trimFinalBuffer :: Options -> Bool
initialCapacity :: Options -> Int
..} !(BB Handle -> IO a
bw) = do
    Handle
handle <- Int -> IO Handle
bw_new Int
initialCapacity
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Handle
handle Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
== Handle
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        BufferOutOfMemoryError -> IO ()
forall a e. Exception e => e -> a
throw BufferOutOfMemoryError
BufferOutOfMemoryError

    ForeignPtr Handle'
handleFP <- FinalizerPtr Handle' -> Handle -> IO (ForeignPtr Handle')
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Handle'
bw_free Handle
handle
    a
rv <- Handle -> IO a
bw Handle
handle

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
trimFinalBuffer (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Handle -> IO ()
bw_trim Handle
handle

    -- FFI doesn't support returning multiple arguments, so we need
    -- two calls: one for the size and the other to release the
    -- pointer.
    Int
size <- Handle -> IO Int
bw_get_size Handle
handle
    Ptr Word8
src <- Handle -> IO (Ptr Word8)
bw_release_address Handle
handle

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Word8
src Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        BufferOutOfMemoryError -> IO ()
forall a e. Exception e => e -> a
throw BufferOutOfMemoryError
BufferOutOfMemoryError

    ForeignPtr Word8
borrowed <- FinalizerPtr Word8 -> Ptr Word8 -> IO (ForeignPtr Word8)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Word8
forall a. FinalizerPtr a
finalizerFree Ptr Word8
src
    let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr ForeignPtr Word8
borrowed Int
0 Int
size
    ForeignPtr Handle' -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Handle'
handleFP
    (a, ByteString) -> IO (a, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
rv, ByteString
bs)

-- | Given a BufferBuilder, calculate its length.  This runs every BufferBuilder action
-- in a mode that simply accumulates the number of bytes without copying any data into an
-- output buffer.
calculateLength :: BufferBuilder a -> Int
calculateLength :: BufferBuilder a -> Int
calculateLength !(BB Handle -> IO a
bw) = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ do
    Handle
handle <- IO Handle
bw_new_length_calculator
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Handle
handle Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
== Handle
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        BufferOutOfMemoryError -> IO ()
forall a e. Exception e => e -> a
throw BufferOutOfMemoryError
BufferOutOfMemoryError

    ForeignPtr Handle'
handleFP <- FinalizerPtr Handle' -> Handle -> IO (ForeignPtr Handle')
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Handle'
bw_free Handle
handle
    a
_ <- Handle -> IO a
bw Handle
handle
    Int
size <- Handle -> IO Int
bw_get_size Handle
handle
    ForeignPtr Handle' -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Handle'
handleFP
    Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
size

-- | Reads current length of BufferBuilder.  If memory allocation has failed at any point, this returns zero.
-- In the future, currentLength may throw an exception upon memory allocation failure.
currentLength :: BufferBuilder Int
currentLength :: BufferBuilder Int
currentLength = (Handle -> IO Int) -> BufferBuilder Int
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle Handle -> IO Int
bw_get_size

-- | 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 :: Word8 -> BufferBuilder ()
appendByte Word8
b = (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> Word8 -> IO ()
bw_append_byte Handle
h Word8
b
{-# INLINE appendByte #-}

c2w :: Char -> Word8
c2w :: Char -> Word8
c2w = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE c2w #-}

-- | Appends a character to the buffer, truncating it to the bottom 8 bits.
appendChar8 :: Char -> BufferBuilder ()
appendChar8 :: Char -> BufferBuilder ()
appendChar8 = Word8 -> BufferBuilder ()
appendByte (Word8 -> BufferBuilder ())
-> (Char -> Word8) -> Char -> BufferBuilder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
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 :: ByteString -> BufferBuilder ()
appendBS !(BS.PS ForeignPtr Word8
fp Int
offset Int
len) =
    (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
        ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
addr ->
            Handle -> Int -> Ptr Word8 -> IO ()
bw_append_bs Handle
h Int
len (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
addr Int
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 :: ByteString -> BufferBuilder ()
appendLBS ByteString
lbs = (ByteString -> BufferBuilder ())
-> [ByteString] -> BufferBuilder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> BufferBuilder ()
appendBS ([ByteString] -> BufferBuilder ())
-> [ByteString] -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BSL.toChunks ByteString
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# -> BufferBuilder ()
appendLiteral Addr#
addr =
    (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
        Handle -> Ptr Word8 -> IO ()
bw_append_bsz Handle
h (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
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 :: Int -> Addr# -> BufferBuilder ()
unsafeAppendLiteralN Int
len Addr#
addr =
    (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
        Handle -> Int -> Ptr Word8 -> IO ()
bw_append_bs Handle
h Int
len (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr)
{-# INLINE unsafeAppendLiteralN #-}


-- 7-bit truncation

appendByte7 :: Word8 -> BufferBuilder ()
appendByte7 :: Word8 -> BufferBuilder ()
appendByte7 Word8
b = (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> Word8 -> IO ()
bw_append_byte7 Handle
h Word8
b
{-# INLINE appendByte7 #-}

appendChar7 :: Char -> BufferBuilder ()
appendChar7 :: Char -> BufferBuilder ()
appendChar7 = Word8 -> BufferBuilder ()
appendByte7 (Word8 -> BufferBuilder ())
-> (Char -> Word8) -> Char -> BufferBuilder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE appendChar7 #-}

appendBS7 :: BS.ByteString -> BufferBuilder ()
appendBS7 :: ByteString -> BufferBuilder ()
appendBS7 !(BS.PS ForeignPtr Word8
fp Int
offset Int
len) =
    (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
        ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
addr ->
            Handle -> Int -> Ptr Word8 -> IO ()
bw_append_bs7 Handle
h Int
len (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
addr Int
offset)
{-# INLINE appendBS7 #-}

appendLiteral7 :: Addr# -> BufferBuilder ()
appendLiteral7 :: Addr# -> BufferBuilder ()
appendLiteral7 Addr#
addr =
    (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
        Handle -> Ptr Word8 -> IO ()
bw_append_bsz7 Handle
h (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr)
{-# INLINE appendLiteral7 #-}

unsafeAppendLiteralN7 :: Int -> Addr# -> BufferBuilder ()
unsafeAppendLiteralN7 :: Int -> Addr# -> BufferBuilder ()
unsafeAppendLiteralN7 Int
len Addr#
addr =
    (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
        Handle -> Int -> Ptr Word8 -> IO ()
bw_append_bs7 Handle
h Int
len (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr)
{-# INLINE unsafeAppendLiteralN7 #-}

-- Encoding UTF-8

-- | Appends a UTF-8-encoded 'Char' to the buffer.
appendCharUtf8 :: Char -> BufferBuilder ()
appendCharUtf8 :: Char -> BufferBuilder ()
appendCharUtf8 Char
c = (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> Char -> IO ()
bw_append_char_utf8 Handle
h Char
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 :: String -> BufferBuilder ()
appendStringUtf8 = (Char -> BufferBuilder ()) -> String -> BufferBuilder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> BufferBuilder ()
appendCharUtf8
{-# INLINABLE appendStringUtf8 #-}


-- Printing Numbers

-- | Appends a decimal integer, just like calling printf("%d", ...)
appendDecimalSignedInt :: Int -> BufferBuilder ()
appendDecimalSignedInt :: Int -> BufferBuilder ()
appendDecimalSignedInt Int
i =
    (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
        Handle -> Int -> IO ()
bw_append_decimal_signed_int Handle
h Int
i
{-# INLINE appendDecimalSignedInt #-}

-- | Appends a decimal double, just like calling printf("%f", ...)
appendDecimalDouble :: Double -> BufferBuilder ()
appendDecimalDouble :: Double -> BufferBuilder ()
appendDecimalDouble Double
d =
    (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
        Handle -> Double -> IO ()
bw_append_decimal_double Handle
h Double
d
{-# INLINE appendDecimalDouble #-}


-- Encoding JSON

appendEscapedJson :: BS.ByteString -> BufferBuilder ()
appendEscapedJson :: ByteString -> BufferBuilder ()
appendEscapedJson !(BS.PS (ForeignPtr Addr#
addr ForeignPtrContents
_) Int
offset Int
len) =
    (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
        Handle -> Int -> Ptr Word8 -> IO ()
bw_append_json_escaped Handle
h Int
len (Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
addr) Int
offset)
{-# INLINE appendEscapedJson #-}

appendEscapedJsonLiteral :: Addr# -> BufferBuilder ()
appendEscapedJsonLiteral :: Addr# -> BufferBuilder ()
appendEscapedJsonLiteral Addr#
addr =
    (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
        Int
len <- Ptr Word8 -> IO Int
c_strlen (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr)
        Handle -> Int -> Ptr Word8 -> IO ()
bw_append_json_escaped Handle
h Int
len (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr)
{-# INLINE appendEscapedJsonLiteral #-}

appendEscapedJsonText :: Text -> BufferBuilder ()
appendEscapedJsonText :: Text -> BufferBuilder ()
appendEscapedJsonText !(Text Array
arr Int
ofs Int
len) =
#if MIN_VERSION_text(2,0,0)
    let ByteArray byteArray = arr
    in withHandle $ \h ->
        bw_append_json_escaped h len (Ptr (byteArrayContents# byteArray) `plusPtr` ofs)
#else
    let byteArray :: ByteArray#
byteArray = Array -> ByteArray#
aBA Array
arr
    in (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
        Handle -> Int -> Ptr Word16 -> IO ()
bw_append_json_escaped_utf16 Handle
h Int
len (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
byteArray) Ptr Any -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ofs))
#endif
{-# 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 :: ByteString -> BufferBuilder ()
appendUrlEncoded !(BS.PS (ForeignPtr Addr#
addr ForeignPtrContents
_) Int
offset Int
len) =
    (Handle -> IO ()) -> BufferBuilder ()
forall a. (Handle -> IO a) -> BufferBuilder a
withHandle ((Handle -> IO ()) -> BufferBuilder ())
-> (Handle -> IO ()) -> BufferBuilder ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
        Handle -> Int -> Ptr Word8 -> IO ()
bw_append_url_encoded Handle
h Int
len (Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
addr) Int
offset)
{-# INLINE appendUrlEncoded #-}