{-|
Module      : Z.Data.Builder.Base
Description : Efficient serialization/format.
Copyright   : (c) Dong Han, 2017-2019
              (c) Tao He, 2018-2019
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

A 'Builder' records a buffer writing function, which can be 'mappend' in O(1) via composition.

  * When building a short strict 'Bytes' with 'build'\/'buildWith', we double the buffer
    each time buffer is full.

  * When building a large lazy @[Bytes]@ with 'buildChunks'\/'buildChunksWith',
    we insert a new chunk when buffer is full.


Most of the time using combinators from this module to build 'Builder' s is enough,
but in case of rolling something shining from the ground, keep an eye on correct 'BuildResult' handling.

-}

module Z.Data.Builder.Base
  ( -- * Builder type
    Builder(..)
  , append
  , Buffer(..), freezeBuffer
  , BuildResult(..)
  , BuildStep
   -- * Running a builder
  , build
  , buildWith
  , buildChunks
  , buildChunksWith
  , buildText
  , unsafeBuildText
    -- * Basic buiders
  , bytes
  , ensureN
  , writeN
   -- * Pritimive builders
  , encodePrim
  , BE(..), LE(..)
  , encodePrimLE
  , encodePrimBE
  -- * More builders
  , stringModifiedUTF8, charModifiedUTF8, stringUTF8
  , charUTF8, string7, char7, word7, string8, char8, word8, word8N, text
  -- * Builder helpers
  , paren, curly, square, angle, quotes, squotes, colon, comma, intercalateVec, intercalateList
  ) where

import           Control.Monad
import           Control.Monad.Primitive
import           Data.Bits                          (unsafeShiftL, unsafeShiftR, (.&.))
import           Data.Word
import           Data.Int
import           GHC.CString                        (unpackCString#, unpackCStringUtf8#)
import           GHC.Exts                           hiding (build)
import           GHC.Stack
import           Data.Primitive.PrimArray
import           Z.Data.Array.Unaligned
import           Z.Data.ASCII
import qualified Z.Data.Text.Base                 as T
import qualified Z.Data.Text.UTF8Codec            as T
import qualified Z.Data.Vector.Base               as V
import qualified Z.Data.Array                     as A
import           Z.Foreign
import           System.IO.Unsafe
import           Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..))

-- | Helper type to help ghc unpack
--
data Buffer = Buffer {-# UNPACK #-} !(MutablePrimArray RealWorld Word8)  -- ^ the buffer content
                     {-# UNPACK #-} !Int  -- ^ writing offset

-- | Freeze buffer and return a 'V.Bytes'.
--
-- Note the mutable buffer array will be shrinked with 'shrinkMutablePrimArray', which may not
-- able to be reused.
freezeBuffer :: Buffer -> IO V.Bytes
{-# INLINE freezeBuffer #-}
freezeBuffer :: Buffer -> IO Bytes
freezeBuffer (Buffer MutablePrimArray RealWorld Word8
buf Int
offset) = do
    Int
siz <- MutablePrimArray (PrimState IO) Word8 -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
siz) (MutablePrimArray (PrimState IO) Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf Int
offset)
    !PrimArray Word8
arr <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf
    Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
arr Int
0 Int
offset)

-- | @BuilderStep@ is a function that fill buffer under given conditions.
--
type BuildStep = Buffer -> IO BuildResult

-- | 'BuildSignal's abstract signals to the caller of a 'BuildStep'. There are
-- three signals: 'Done', 'BufferFull', or 'InsertBytes' signals
data BuildResult
    = Done {-# UNPACK #-} !Buffer
    | BufferFull {-# UNPACK #-} !Buffer {-# UNPACK #-} !Int BuildStep
    | InsertBytes {-# UNPACK #-} !Buffer V.Bytes BuildStep

-- | @Builder@ is a monad to help compose @BuilderStep@. With next @BuilderStep@ continuation,
-- we can do interesting things like perform some action, or interleave the build process.
--
-- Notes on 'IsString' instance: @Builder ()@'s 'IsString' instance use 'stringModifiedUTF8',
-- which is different from 'stringUTF8' in that it DOES NOT PROVIDE UTF8 GUARANTEES! :
--
-- * @\\NUL@ will be written as @\\xC0 \\x80@.
-- * @\\xD800@ ~ @\\xDFFF@ will be encoded in three bytes as normal UTF-8 codepoints.
--
newtype Builder a = Builder { Builder a -> (a -> BuildStep) -> BuildStep
runBuilder :: (a -> BuildStep) -> BuildStep }

instance Show (Builder a) where
    show :: Builder a -> String
show = Bytes -> String
forall a. Show a => a -> String
show (Bytes -> String) -> (Builder a -> Bytes) -> Builder a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder a -> Bytes
forall a. Builder a -> Bytes
build

instance Functor Builder where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> Builder a -> Builder b
fmap a -> b
f (Builder (a -> BuildStep) -> BuildStep
b) = ((b -> BuildStep) -> BuildStep) -> Builder b
forall a. ((a -> BuildStep) -> BuildStep) -> Builder a
Builder (\ b -> BuildStep
k -> (a -> BuildStep) -> BuildStep
b (b -> BuildStep
k (b -> BuildStep) -> (a -> b) -> a -> BuildStep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))
    {-# INLINE (<$) #-}
    a
a <$ :: a -> Builder b -> Builder a
<$ (Builder (b -> BuildStep) -> BuildStep
b) = ((a -> BuildStep) -> BuildStep) -> Builder a
forall a. ((a -> BuildStep) -> BuildStep) -> Builder a
Builder (\ a -> BuildStep
k -> (b -> BuildStep) -> BuildStep
b (\ b
_ -> a -> BuildStep
k a
a))

instance Applicative Builder where
    {-# INLINE pure #-}
    pure :: a -> Builder a
pure a
x = ((a -> BuildStep) -> BuildStep) -> Builder a
forall a. ((a -> BuildStep) -> BuildStep) -> Builder a
Builder (\ a -> BuildStep
k -> a -> BuildStep
k a
x)
    {-# INLINE (<*>) #-}
    (Builder ((a -> b) -> BuildStep) -> BuildStep
f) <*> :: Builder (a -> b) -> Builder a -> Builder b
<*> (Builder (a -> BuildStep) -> BuildStep
b) = ((b -> BuildStep) -> BuildStep) -> Builder b
forall a. ((a -> BuildStep) -> BuildStep) -> Builder a
Builder (\ b -> BuildStep
k -> ((a -> b) -> BuildStep) -> BuildStep
f ( \ a -> b
ab -> (a -> BuildStep) -> BuildStep
b (b -> BuildStep
k (b -> BuildStep) -> (a -> b) -> a -> BuildStep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
ab)))
    {-# INLINE (*>) #-}
    *> :: Builder a -> Builder b -> Builder b
(*>) = Builder a -> Builder b -> Builder b
forall a b. Builder a -> Builder b -> Builder b
append

instance Monad Builder where
    {-# INLINE (>>=) #-}
    (Builder (a -> BuildStep) -> BuildStep
b) >>= :: Builder a -> (a -> Builder b) -> Builder b
>>= a -> Builder b
f = ((b -> BuildStep) -> BuildStep) -> Builder b
forall a. ((a -> BuildStep) -> BuildStep) -> Builder a
Builder (\ b -> BuildStep
k -> (a -> BuildStep) -> BuildStep
b ( \ a
a -> Builder b -> (b -> BuildStep) -> BuildStep
forall a. Builder a -> (a -> BuildStep) -> BuildStep
runBuilder (a -> Builder b
f a
a) b -> BuildStep
k))
    {-# INLINE (>>) #-}
    >> :: Builder a -> Builder b -> Builder b
(>>) = Builder a -> Builder b -> Builder b
forall a b. Builder a -> Builder b -> Builder b
append

instance Semigroup (Builder ()) where
    <> :: Builder () -> Builder () -> Builder ()
(<>) = Builder () -> Builder () -> Builder ()
forall a b. Builder a -> Builder b -> Builder b
append
    {-# INLINE (<>) #-}

instance Monoid (Builder ()) where
    mempty :: Builder ()
mempty = () -> Builder ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    {-# INLINE mempty #-}
    mappend :: Builder () -> Builder () -> Builder ()
mappend = Builder () -> Builder () -> Builder ()
forall a b. Builder a -> Builder b -> Builder b
append
    {-# INLINE mappend #-}
    mconcat :: [Builder ()] -> Builder ()
mconcat = (Builder () -> Builder () -> Builder ())
-> Builder () -> [Builder ()] -> Builder ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Builder () -> Builder () -> Builder ()
forall a b. Builder a -> Builder b -> Builder b
append (() -> Builder ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    {-# INLINE mconcat #-}

-- | This instance simple write literals' bytes into buffer,
-- which is different from 'stringUTF8' in that it DOES NOT PROVIDE UTF8 GUARANTEES! :
instance (a ~ ()) => IsString (Builder a) where
    {-# INLINE fromString #-}
    fromString :: String -> Builder a
fromString = String -> Builder a
String -> Builder ()
stringModifiedUTF8

instance Arbitrary (Builder ()) where
    arbitrary :: Gen (Builder ())
arbitrary = Bytes -> Builder ()
bytes (Bytes -> Builder ()) -> Gen Bytes -> Gen (Builder ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bytes
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: Builder () -> [Builder ()]
shrink Builder ()
b = (Bytes -> Builder ()
bytes (Bytes -> Builder ())
-> ([Word8] -> Bytes) -> [Word8] -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Bytes
forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack) ([Word8] -> Builder ()) -> [[Word8]] -> [Builder ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8] -> [[Word8]]
forall a. Arbitrary a => a -> [a]
shrink (Bytes -> [Word8]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack (Builder () -> Bytes
forall a. Builder a -> Bytes
build Builder ()
b))

instance CoArbitrary (Builder ()) where
    coarbitrary :: Builder () -> Gen b -> Gen b
coarbitrary = Bytes -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (Bytes -> Gen b -> Gen b)
-> (Builder () -> Bytes) -> Builder () -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Bytes
forall a. Builder a -> Bytes
build

-- | Encode string with modified UTF-8 encoding, will be rewritten to a memcpy if possible.
stringModifiedUTF8 :: String -> Builder ()
{-# INLINE CONLIKE [0] stringModifiedUTF8 #-}
{-# RULES
    "stringModifiedUTF8/packAddrModified" forall addr . stringModifiedUTF8 (unpackCString# addr) = packAddrModified addr
  #-}
{-# RULES
    "stringModifiedUTF8/packAddrModified" forall addr . stringModifiedUTF8 (unpackCStringUtf8# addr) = packAddrModified addr
  #-}
stringModifiedUTF8 :: String -> Builder ()
stringModifiedUTF8 = (Char -> Builder ()) -> String -> Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> Builder ()
charModifiedUTF8

-- | Turn 'Char' into 'Builder' with Modified UTF8 encoding
--
-- @\\NUL@ is encoded as two bytes @C0 80@ , @\\xD800@ ~ @\\xDFFF@ is encoded as a three bytes normal UTF-8 codepoint.
charModifiedUTF8 :: Char -> Builder ()
{-# INLINE charModifiedUTF8 #-}
charModifiedUTF8 :: Char -> Builder ()
charModifiedUTF8 Char
chr = do
    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO Int)
-> Builder ()
ensureN Int
4 (\ MutablePrimArray RealWorld Word8
mba Int
i -> MutablePrimArray (PrimState IO) Word8 -> Int -> Char -> IO Int
forall (m :: * -> *).
PrimMonad m =>
MutablePrimArray (PrimState m) Word8 -> Int -> Char -> m Int
T.encodeCharModifiedUTF8 MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba Int
i Char
chr)

packAddrModified :: Addr# -> Builder ()
{-# INLINE packAddrModified #-}
packAddrModified :: Addr# -> Builder ()
packAddrModified Addr#
addr0# = Addr# -> Builder ()
copy Addr#
addr0#
  where
    len :: Int
len = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> (IO CSize -> CSize) -> IO CSize -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CSize -> CSize
forall a. IO a -> a
unsafeDupablePerformIO (IO CSize -> Int) -> IO CSize -> Int
forall a b. (a -> b) -> a -> b
$ Addr# -> IO CSize
V.c_strlen Addr#
addr0#
    copy :: Addr# -> Builder ()
copy Addr#
addr# = do
        Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
len (\ MutablePrimArray RealWorld Word8
mba Int
i -> MutablePrimArray (PrimState IO) Word8
-> Int -> Ptr Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba Int
i (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len)

append :: Builder a -> Builder b -> Builder b
{-# INLINE append #-}
append :: Builder a -> Builder b -> Builder b
append (Builder (a -> BuildStep) -> BuildStep
f) (Builder (b -> BuildStep) -> BuildStep
g) = ((b -> BuildStep) -> BuildStep) -> Builder b
forall a. ((a -> BuildStep) -> BuildStep) -> Builder a
Builder (\ b -> BuildStep
k -> (a -> BuildStep) -> BuildStep
f ( \ a
_ ->  (b -> BuildStep) -> BuildStep
g b -> BuildStep
k))

--------------------------------------------------------------------------------

-- | Write a 'V.Bytes'.
bytes :: V.Bytes -> Builder ()
{-# INLINE bytes #-}
bytes :: Bytes -> Builder ()
bytes bs :: Bytes
bs@(V.PrimVector PrimArray Word8
arr Int
s Int
l) = ((() -> BuildStep) -> BuildStep) -> Builder ()
forall a. ((a -> BuildStep) -> BuildStep) -> Builder a
Builder (\ () -> BuildStep
k buffer :: Buffer
buffer@(Buffer MutablePrimArray RealWorld Word8
buf Int
offset) -> do
    Int
siz <- MutablePrimArray (PrimState IO) Word8 -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf
    if Int
siz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l
    then do
        MutablePrimArray (PrimState IO) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf Int
offset PrimArray Word8
arr Int
s Int
l
        () -> BuildStep
k () (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf (Int
offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l))
    else BuildResult -> IO BuildResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer -> Bytes -> BuildStep -> BuildResult
InsertBytes Buffer
buffer Bytes
bs (() -> BuildStep
k ()))) -- bytes should be copied in outer handling

--------------------------------------------------------------------------------

-- | Shortcut to 'buildWith' 'V.defaultInitSize'.
build :: Builder a -> V.Bytes
{-# INLINE build #-}
build :: Builder a -> Bytes
build = Int -> Builder a -> Bytes
forall a. Int -> Builder a -> Bytes
buildWith Int
V.defaultInitSize

-- | Build some bytes and validate if it's UTF8 bytes.
buildText :: HasCallStack => Builder a -> T.Text
{-# INLINE buildText #-}
buildText :: Builder a -> Text
buildText = HasCallStack => Bytes -> Text
Bytes -> Text
T.validate (Bytes -> Text) -> (Builder a -> Bytes) -> Builder a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder a -> Bytes
forall a. Int -> Builder a -> Bytes
buildWith Int
V.defaultInitSize

-- | Build some bytes assuming it's UTF8 encoding.
--
-- Be carefully use this function because you could constrcut illegal 'T.Text' values.
-- Check 'Z.Data.Text.ShowT' for UTF8 encoding builders. This functions is intended to
-- be used in debug only.
unsafeBuildText :: Builder a -> T.Text
{-# INLINE unsafeBuildText #-}
unsafeBuildText :: Builder a -> Text
unsafeBuildText = Bytes -> Text
T.Text (Bytes -> Text) -> (Builder a -> Bytes) -> Builder a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder a -> Bytes
forall a. Int -> Builder a -> Bytes
buildWith Int
V.defaultInitSize

-- | Run Builder with doubling buffer strategy, which is suitable
-- for building short bytes.
buildWith :: Int -> Builder a -> V.Bytes
{-# INLINABLE buildWith #-}
buildWith :: Int -> Builder a -> Bytes
buildWith Int
initSiz (Builder (a -> BuildStep) -> BuildStep
b) = IO Bytes -> Bytes
forall a. IO a -> a
unsafePerformIO (IO Bytes -> Bytes) -> IO Bytes -> Bytes
forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray RealWorld Word8
buf <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
initSiz
    BuildResult -> IO Bytes
loop (BuildResult -> IO Bytes) -> IO BuildResult -> IO Bytes
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (a -> BuildStep) -> BuildStep
b (\ a
_ -> BuildResult -> IO BuildResult
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildResult -> IO BuildResult)
-> (Buffer -> BuildResult) -> BuildStep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> BuildResult
Done) (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf Int
0)
  where
    loop :: BuildResult -> IO Bytes
loop BuildResult
r = case BuildResult
r of
        Done Buffer
buffer -> Buffer -> IO Bytes
freezeBuffer Buffer
buffer
        BufferFull (Buffer MutablePrimArray RealWorld Word8
buf Int
offset) Int
wantSiz BuildStep
k -> do
            !Int
siz <- MutablePrimArray (PrimState IO) Word8 -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf
            let !siz' :: Int
siz' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wantSiz Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1)
                            (Int
siz Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1)
            MutablePrimArray RealWorld Word8
buf' <- MutablePrimArray (PrimState IO) Word8
-> Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> m (MutablePrimArray (PrimState m) a)
resizeMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf Int
siz'   -- grow buffer
            BuildResult -> IO Bytes
loop (BuildResult -> IO Bytes) -> IO BuildResult -> IO Bytes
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildStep
k (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf' Int
offset)
        InsertBytes (Buffer MutablePrimArray RealWorld Word8
buf Int
offset) (V.PrimVector PrimArray Word8
arr Int
s Int
l) BuildStep
k -> do
            !Int
siz <- MutablePrimArray (PrimState IO) Word8 -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf
            let !siz' :: Int
siz' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1)
                            (Int
siz Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1)
            MutablePrimArray RealWorld Word8
buf' <- MutablePrimArray (PrimState IO) Word8
-> Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> m (MutablePrimArray (PrimState m) a)
resizeMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf Int
siz'   -- grow buffer
            MutablePrimArray (PrimState IO) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf' Int
offset PrimArray Word8
arr Int
s Int
l
            BuildResult -> IO Bytes
loop (BuildResult -> IO Bytes) -> IO BuildResult -> IO Bytes
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildStep
k (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf' (Int
offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l))

-- | Shortcut to 'buildChunksWith' 'V.defaultChunkSize'.
buildChunks :: Builder a -> [V.Bytes]
{-# INLINE buildChunks #-}
buildChunks :: Builder a -> [Bytes]
buildChunks = Int -> Int -> Builder a -> [Bytes]
forall a. Int -> Int -> Builder a -> [Bytes]
buildChunksWith  Int
V.smallChunkSize Int
V.defaultChunkSize

-- | Run Builder with inserting chunk strategy, which is suitable
-- for building a list of bytes chunks and processing them in a streaming ways.
--
-- Note the building process is lazy, building happens when list chunks are consumed.
buildChunksWith :: Int -> Int -> Builder a -> [V.Bytes]
{-# INLINABLE buildChunksWith #-}
buildChunksWith :: Int -> Int -> Builder a -> [Bytes]
buildChunksWith Int
initSiz Int
chunkSiz (Builder (a -> BuildStep) -> BuildStep
b) = IO [Bytes] -> [Bytes]
forall a. IO a -> a
unsafePerformIO (IO [Bytes] -> [Bytes]) -> IO [Bytes] -> [Bytes]
forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray RealWorld Word8
buf <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
initSiz
    BuildResult -> IO [Bytes]
loop (BuildResult -> IO [Bytes]) -> IO BuildResult -> IO [Bytes]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (a -> BuildStep) -> BuildStep
b (\ a
_ -> BuildResult -> IO BuildResult
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildResult -> IO BuildResult)
-> (Buffer -> BuildResult) -> BuildStep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> BuildResult
Done) (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf Int
0)
  where
    loop :: BuildResult -> IO [Bytes]
loop BuildResult
r = case BuildResult
r of
        Done Buffer
buffer -> do
            !Bytes
v <- Buffer -> IO Bytes
freezeBuffer Buffer
buffer
            [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bytes
v]
        BufferFull buffer :: Buffer
buffer@(Buffer MutablePrimArray RealWorld Word8
_ Int
offset) Int
wantSiz BuildStep
k -> do
            let !siz' :: Int
siz' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
chunkSiz Int
wantSiz
            MutablePrimArray RealWorld Word8
buf' <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
siz'   -- new buffer
            if Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then BuildResult -> IO [Bytes]
loop (BuildResult -> IO [Bytes]) -> IO BuildResult -> IO [Bytes]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildStep
k (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf' Int
0)
            else do
                !Bytes
v <- Buffer -> IO Bytes
freezeBuffer Buffer
buffer
                [Bytes]
vs <- IO [Bytes] -> IO [Bytes]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [Bytes] -> IO [Bytes])
-> (BuildResult -> IO [Bytes]) -> BuildResult -> IO [Bytes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildResult -> IO [Bytes]
loop (BuildResult -> IO [Bytes]) -> IO BuildResult -> IO [Bytes]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildStep
k (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf' Int
0)
                [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
vBytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
vs)
        InsertBytes buffer :: Buffer
buffer@(Buffer MutablePrimArray RealWorld Word8
_ Int
offset) v :: Bytes
v@(V.PrimVector PrimArray Word8
arr Int
s Int
l) BuildStep
k -> do
            if Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then do
                [Bytes]
vs <- IO [Bytes] -> IO [Bytes]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [Bytes] -> IO [Bytes])
-> (BuildResult -> IO [Bytes]) -> BuildResult -> IO [Bytes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildResult -> IO [Bytes]
loop (BuildResult -> IO [Bytes]) -> IO BuildResult -> IO [Bytes]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildStep
k Buffer
buffer
                [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
vBytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
vs)
            else do
                !Bytes
v' <- Buffer -> IO Bytes
freezeBuffer Buffer
buffer
                MutablePrimArray RealWorld Word8
buf' <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
chunkSiz   -- new buffer
                if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
chunkSiz Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
                then do
                    MutablePrimArray (PrimState IO) Word8
-> Int -> PrimArray Word8 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf' Int
0 PrimArray Word8
arr Int
s Int
l
                    [Bytes]
vs <- IO [Bytes] -> IO [Bytes]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [Bytes] -> IO [Bytes])
-> (BuildResult -> IO [Bytes]) -> BuildResult -> IO [Bytes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildResult -> IO [Bytes]
loop (BuildResult -> IO [Bytes]) -> IO BuildResult -> IO [Bytes]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildStep
k (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf' Int
l)
                    [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
v'Bytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
vs)
                else do
                    [Bytes]
vs <- IO [Bytes] -> IO [Bytes]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [Bytes] -> IO [Bytes])
-> (BuildResult -> IO [Bytes]) -> BuildResult -> IO [Bytes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildResult -> IO [Bytes]
loop (BuildResult -> IO [Bytes]) -> IO BuildResult -> IO [Bytes]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BuildStep
k (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf' Int
0)
                    [Bytes] -> IO [Bytes]
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
v'Bytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:Bytes
vBytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
vs)


--------------------------------------------------------------------------------

ensureN :: Int  -- ^ size bound
       -> (MutablePrimArray RealWorld Word8 -> Int -> IO Int)  -- ^ the writer which return a new offset
                                                               -- for next write
       -> Builder ()
{-# INLINE ensureN #-}
ensureN :: Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO Int)
-> Builder ()
ensureN !Int
n MutablePrimArray RealWorld Word8 -> Int -> IO Int
f = ((() -> BuildStep) -> BuildStep) -> Builder ()
forall a. ((a -> BuildStep) -> BuildStep) -> Builder a
Builder (\ () -> BuildStep
k buffer :: Buffer
buffer@(Buffer MutablePrimArray RealWorld Word8
buf Int
offset) -> do
    Int
siz <- MutablePrimArray (PrimState IO) Word8 -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf
    if Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
siz
    then MutablePrimArray RealWorld Word8 -> Int -> IO Int
f MutablePrimArray RealWorld Word8
buf Int
offset IO Int -> (Int -> IO BuildResult) -> IO BuildResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Int
offset' -> () -> BuildStep
k () (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf Int
offset')
    else BuildResult -> IO BuildResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer -> Int -> BuildStep -> BuildResult
BufferFull Buffer
buffer Int
n (\ (Buffer MutablePrimArray RealWorld Word8
buf' Int
offset') -> do
        MutablePrimArray RealWorld Word8 -> Int -> IO Int
f MutablePrimArray RealWorld Word8
buf' Int
offset' IO Int -> (Int -> IO BuildResult) -> IO BuildResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Int
offset'' -> () -> BuildStep
k () (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf' Int
offset''))))

writeN :: Int  -- ^ size bound
       -> (MutablePrimArray RealWorld Word8 -> Int -> IO ())  -- ^ the writer should write exactly N bytes
       -> Builder ()
{-# INLINE writeN #-}
writeN :: Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN !Int
n MutablePrimArray RealWorld Word8 -> Int -> IO ()
f = ((() -> BuildStep) -> BuildStep) -> Builder ()
forall a. ((a -> BuildStep) -> BuildStep) -> Builder a
Builder (\ () -> BuildStep
k buffer :: Buffer
buffer@(Buffer MutablePrimArray RealWorld Word8
buf Int
offset) -> do
    Int
siz <- MutablePrimArray (PrimState IO) Word8 -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
buf
    if Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
siz
    then MutablePrimArray RealWorld Word8 -> Int -> IO ()
f MutablePrimArray RealWorld Word8
buf Int
offset IO () -> IO BuildResult -> IO BuildResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> BuildStep
k () (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf (Int
offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n))
    else BuildResult -> IO BuildResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer -> Int -> BuildStep -> BuildResult
BufferFull Buffer
buffer Int
n (\ (Buffer MutablePrimArray RealWorld Word8
buf' Int
offset') -> do
        MutablePrimArray RealWorld Word8 -> Int -> IO ()
f MutablePrimArray RealWorld Word8
buf' Int
offset' IO () -> IO BuildResult -> IO BuildResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> BuildStep
k () (MutablePrimArray RealWorld Word8 -> Int -> Buffer
Buffer MutablePrimArray RealWorld Word8
buf' (Int
offset'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n)))))

-- | Write a primitive type in host byte order.
--
-- @
-- > encodePrim (256 :: Word16, BE 256 :: BE Word16)
-- > [0,1,1,0]
-- @
encodePrim :: forall a. Unaligned a => a -> Builder ()
{-# INLINE encodePrim #-}
{-# SPECIALIZE INLINE encodePrim :: Word -> Builder () #-}
{-# SPECIALIZE INLINE encodePrim :: Word64 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrim :: Word32 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrim :: Word16 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrim :: Word8 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrim :: Int -> Builder () #-}
{-# SPECIALIZE INLINE encodePrim :: Int64 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrim :: Int32 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrim :: Int16 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrim :: Int8 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrim :: Double -> Builder () #-}
{-# SPECIALIZE INLINE encodePrim :: Float -> Builder () #-}
encodePrim :: a -> Builder ()
encodePrim a
x = do
    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n (\ MutablePrimArray RealWorld Word8
mpa Int
i -> MutablePrimArray (PrimState IO) Word8 -> Int -> a -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Unaligned a) =>
MutablePrimArray (PrimState m) Word8 -> Int -> a -> m ()
writePrimWord8ArrayAs MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
i a
x)
  where
    n :: Int
n = UnalignedSize a -> Int
forall k (a :: k). UnalignedSize a -> Int
getUnalignedSize (Unaligned a => UnalignedSize a
forall a. Unaligned a => UnalignedSize a
unalignedSize @a)

-- | Write a primitive type with little endianess.
encodePrimLE :: forall a. Unaligned (LE a) => a -> Builder ()
{-# INLINE encodePrimLE #-}
{-# SPECIALIZE INLINE encodePrimLE :: Word -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimLE :: Word64 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimLE :: Word32 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimLE :: Word16 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimLE :: Int -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimLE :: Int64 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimLE :: Int32 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimLE :: Int16 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimLE :: Double -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimLE :: Float -> Builder () #-}
encodePrimLE :: a -> Builder ()
encodePrimLE = LE a -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim (LE a -> Builder ()) -> (a -> LE a) -> a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LE a
forall a. a -> LE a
LE

-- | Write a primitive type with big endianess.
encodePrimBE :: forall a. Unaligned (BE a) => a -> Builder ()
{-# INLINE encodePrimBE #-}
{-# SPECIALIZE INLINE encodePrimBE :: Word -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimBE :: Word64 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimBE :: Word32 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimBE :: Word16 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimBE :: Int -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimBE :: Int64 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimBE :: Int32 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimBE :: Int16 -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimBE :: Double -> Builder () #-}
{-# SPECIALIZE INLINE encodePrimBE :: Float -> Builder () #-}
encodePrimBE :: a -> Builder ()
encodePrimBE = BE a -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim (BE a -> Builder ()) -> (a -> BE a) -> a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BE a
forall a. a -> BE a
BE

--------------------------------------------------------------------------------

-- | Turn 'String' into 'Builder' with UTF8 encoding
--
-- Illegal codepoints will be written as 'T.replacementChar's.
--
-- This is different from writing string literals builders via @OverloadedStrings@, because string literals
-- do not provide UTF8 guarantees.
--
-- This function will be rewritten into a memcpy if possible, (running a fast UTF-8 validation
-- at runtime first).
stringUTF8 :: String -> Builder ()
{-# INLINE CONLIKE [0] stringUTF8 #-}
{-# RULES
    "stringUTF8/packASCIIAddr" forall addr . stringUTF8 (unpackCString# addr) = packASCIIAddr addr
  #-}
{-# RULES
    "stringUTF8/packUTF8Addr" forall addr . stringUTF8 (unpackCString# addr) = packUTF8Addr addr
  #-}
stringUTF8 :: String -> Builder ()
stringUTF8 = (Char -> Builder ()) -> String -> Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> Builder ()
charUTF8

packASCIIAddr :: Addr# -> Builder ()
{-# INLINE packASCIIAddr #-}
packASCIIAddr :: Addr# -> Builder ()
packASCIIAddr Addr#
addr0# = Addr# -> Builder ()
copy Addr#
addr0#
  where
    len :: Int
len = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> (IO CSize -> CSize) -> IO CSize -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CSize -> CSize
forall a. IO a -> a
unsafeDupablePerformIO (IO CSize -> Int) -> IO CSize -> Int
forall a b. (a -> b) -> a -> b
$ Addr# -> IO CSize
V.c_strlen Addr#
addr0#
    copy :: Addr# -> Builder ()
copy Addr#
addr# = do
        Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
len (\ MutablePrimArray RealWorld Word8
mba Int
i -> MutablePrimArray (PrimState IO) Word8
-> Int -> Ptr Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba Int
i (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len)

packUTF8Addr :: Addr# -> Builder ()
{-# INLINE packUTF8Addr #-}
packUTF8Addr :: Addr# -> Builder ()
packUTF8Addr Addr#
addr0# = Addr# -> Builder ()
validateAndCopy Addr#
addr0#
  where
    len :: Int
len = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> (IO CSize -> CSize) -> IO CSize -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CSize -> CSize
forall a. IO a -> a
unsafeDupablePerformIO (IO CSize -> Int) -> IO CSize -> Int
forall a b. (a -> b) -> a -> b
$ Addr# -> IO CSize
V.c_strlen Addr#
addr0#
    valid :: Int
valid = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ Addr# -> Int -> IO Int
T.c_utf8_validate_addr Addr#
addr0# Int
len
    validateAndCopy :: Addr# -> Builder ()
validateAndCopy Addr#
addr#
        | Int
valid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Char -> Builder ()) -> String -> Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> Builder ()
charUTF8 (Addr# -> String
unpackCString# Addr#
addr#)
        | Bool
otherwise = do
            Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
len (\ MutablePrimArray RealWorld Word8
mba Int
i -> MutablePrimArray (PrimState IO) Word8
-> Int -> Ptr Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba Int
i (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len)

-- | Turn 'Char' into 'Builder' with UTF8 encoding
--
-- Illegal codepoints will be written as 'T.replacementChar's.
charUTF8 :: Char -> Builder ()
{-# INLINE charUTF8 #-}
charUTF8 :: Char -> Builder ()
charUTF8 Char
chr = do
    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO Int)
-> Builder ()
ensureN Int
4 (\ MutablePrimArray RealWorld Word8
mba Int
i -> MutablePrimArray (PrimState IO) Word8 -> Int -> Char -> IO Int
forall (m :: * -> *).
PrimMonad m =>
MutablePrimArray (PrimState m) Word8 -> Int -> Char -> m Int
T.encodeChar MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mba Int
i Char
chr)

-- | Turn 'String' into 'Builder' with ASCII7 encoding
--
-- Codepoints beyond @'\x7F'@ will be chopped.
string7 :: String -> Builder ()
{-# INLINE string7 #-}
string7 :: String -> Builder ()
string7 = (Char -> Builder ()) -> String -> Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> Builder ()
char7

-- | Turn 'Char' into 'Builder' with ASCII7 encoding
--
-- Codepoints beyond @'\x7F'@ will be chopped.
char7 :: Char -> Builder ()
{-# INLINE char7 #-}
char7 :: Char -> Builder ()
char7 Char
chr =
    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
1 (\ MutablePrimArray RealWorld Word8
mpa Int
i -> MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Unaligned a) =>
MutablePrimArray (PrimState m) Word8 -> Int -> a -> m ()
writePrimWord8ArrayAs MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
i (Char -> Word8
c2w Char
chr Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F))

-- | Turn 'Word8' into 'Builder' with ASCII7 encoding
--
-- Codepoints beyond @'\x7F'@ will be chopped.
word7 :: Word8 -> Builder ()
{-# INLINE word7 #-}
word7 :: Word8 -> Builder ()
word7 Word8
w = Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
1 (\ MutablePrimArray RealWorld Word8
mpa Int
i -> MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Unaligned a) =>
MutablePrimArray (PrimState m) Word8 -> Int -> a -> m ()
writePrimWord8ArrayAs MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
i (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F))

-- | Turn 'String' into 'Builder' with ASCII8 encoding
--
-- Codepoints beyond @'\xFF'@ will be chopped.
-- Note, this encoding is NOT compatible with UTF8 encoding, i.e. bytes written
-- by this builder may not be legal UTF8 encoding bytes.
string8 :: String -> Builder ()
{-# INLINE string8 #-}
string8 :: String -> Builder ()
string8 = (Char -> Builder ()) -> String -> Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> Builder ()
char8

-- | Turn 'Char' into 'Builder' with ASCII8 encoding
--
-- Codepoints beyond @'\xFF'@ will be chopped.
-- Note, this encoding is NOT compatible with UTF8 encoding, i.e. bytes written
-- by this builder may not be legal UTF8 encoding bytes.
char8 :: Char -> Builder ()
{-# INLINE char8 #-}
char8 :: Char -> Builder ()
char8 Char
chr = Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
1 (\ MutablePrimArray RealWorld Word8
mpa Int
i -> MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Unaligned a) =>
MutablePrimArray (PrimState m) Word8 -> Int -> a -> m ()
writePrimWord8ArrayAs MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
i (Char -> Word8
c2w Char
chr))

-- | Turn 'Word8' into 'Builder' with ASCII8 encoding, (alias to 'encodePrim').
--
-- Note, this encoding is NOT compatible with UTF8 encoding, i.e. bytes written
-- by this builder may not be legal UTF8 encoding bytes.
word8 :: Word8 -> Builder ()
{-# INLINE word8 #-}
word8 :: Word8 -> Builder ()
word8 = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim

-- | Faster version of @replicateM x . word8@ by using @memset@.
--
-- Note, this encoding is NOT compatible with UTF8 encoding, i.e. bytes written
-- by this builder may not be legal UTF8 encoding bytes.
word8N :: Int -> Word8 -> Builder ()
{-# INLINE word8N #-}
word8N :: Int -> Word8 -> Builder ()
word8N Int
x Word8
w8 = do
    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
x (\ MutablePrimArray RealWorld Word8
mpa Int
i -> MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
i Int
x Word8
w8)

-- | Write UTF8 encoded 'Text' using 'Builder'.
--
-- Note, if you're trying to write string literals builders,
-- please open 'OverloadedStrings' and use 'Builder's 'IsString' instance,
-- it will be rewritten into a memcpy.
text :: T.Text -> Builder ()
{-# INLINE text #-}
text :: Text -> Builder ()
text (T.Text Bytes
bs) = Bytes -> Builder ()
bytes Bytes
bs

--------------------------------------------------------------------------------


-- | add @(...)@ to original builder.
paren :: Builder () -> Builder ()
{-# INLINE paren #-}
paren :: Builder () -> Builder ()
paren Builder ()
b = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
PAREN_LEFT Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
b Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
PAREN_RIGHT

-- | add @{...}@ to original builder.
curly :: Builder () -> Builder ()
{-# INLINE curly #-}
curly :: Builder () -> Builder ()
curly Builder ()
b = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
CURLY_LEFT Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
b Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
CURLY_RIGHT

-- | add @[...]@ to original builder.
square :: Builder () -> Builder ()
{-# INLINE square #-}
square :: Builder () -> Builder ()
square Builder ()
b = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
SQUARE_LEFT Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
b Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
SQUARE_RIGHT

-- | add @/<.../>@ to original builder.
angle :: Builder () -> Builder ()
{-# INLINE angle #-}
angle :: Builder () -> Builder ()
angle Builder ()
b = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
ANGLE_LEFT Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
b Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
ANGLE_RIGHT

-- | add @/".../"@ to original builder.
quotes :: Builder () -> Builder ()
{-# INLINE quotes #-}
quotes :: Builder () -> Builder ()
quotes Builder ()
b = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
QUOTE_DOUBLE Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
b Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
QUOTE_DOUBLE

-- | add @/'.../'@ to original builder.
squotes :: Builder () -> Builder ()
{-# INLINE squotes #-}
squotes :: Builder () -> Builder ()
squotes Builder ()
b = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
QUOTE_SINGLE Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
b Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
QUOTE_SINGLE

-- | write an ASCII @:@
colon :: Builder ()
{-# INLINE colon #-}
colon :: Builder ()
colon = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
COLON

-- | write an ASCII @,@
comma :: Builder ()
{-# INLINE comma #-}
comma :: Builder ()
comma = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
COMMA

-- | Use separator to connect a vector of builders.
--
-- @
-- import Z.Data.Builder as B
-- import Z.Data.Text    as T
-- import Z.Data.Vector  as V
--
-- > T.validate . B.build $ B.intercalateVec "," B.int (V.pack [1,2,3,4] :: V.PrimVector Int)
-- "1,2,3,4"
-- @
intercalateVec :: (V.Vec v a)
            => Builder ()           -- ^ the seperator
            -> (a -> Builder ())    -- ^ value formatter
            -> v a                  -- ^ value vector
            ->  Builder ()
{-# INLINE intercalateVec #-}
intercalateVec :: Builder () -> (a -> Builder ()) -> v a -> Builder ()
intercalateVec Builder ()
sep a -> Builder ()
f (V.Vec IArray v a
a Int
s Int
l)
    | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = () -> Builder ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = Int -> Builder ()
go Int
s
  where
    !end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    go :: Int -> Builder ()
go !Int
i | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end = do
                a -> Builder ()
f (a -> Builder ()) -> Builder a -> Builder ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IArray v a -> Int -> Builder a
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
A.indexArrM IArray v a
a Int
i
          | Bool
otherwise = do
                a -> Builder ()
f (a -> Builder ()) -> Builder a -> Builder ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IArray v a -> Int -> Builder a
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
A.indexArrM IArray v a
a Int
i
                Builder ()
sep
                Int -> Builder ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | Use separator to connect list of builders.
--
-- @
-- import Z.Data.Builder as B
-- import Z.Data.Text    as T
-- import Z.Data.Vector  as V
--
-- T.validate . B.build $ B.intercalateList "," B.int ([1,2,3,4] :: [Int])
-- "1,2,3,4"
-- @
intercalateList :: Builder ()           -- ^ the seperator
                -> (a -> Builder ())    -- ^ value formatter
                -> [a]                  -- ^ value list
                -> Builder ()
{-# INLINE intercalateList #-}
intercalateList :: Builder () -> (a -> Builder ()) -> [a] -> Builder ()
intercalateList Builder ()
s a -> Builder ()
f [a]
xs = [a] -> Builder ()
go [a]
xs
  where
    go :: [a] -> Builder ()
go [] = () -> Builder ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    go [a
x] = a -> Builder ()
f a
x
    go (a
x:[a]
xs') = a -> Builder ()
f a
x Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
s Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> Builder ()
go [a]
xs'