{-|
Module      : Z.Data.JSON.Builder
Description : JSON representation and builders
Copyright   : (c) Dong Han, 2019
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provides builders for JSON 'Value's, a Haskell JSON representation. These builders are designed to comply with <https://tools.ietf.org/html/rfc8258 rfc8258>. Only control characters are escaped, other unicode codepoints are directly written instead of being escaped.

-}
module Z.Data.JSON.Builder
  ( -- * Value Builders
    value
  , object
  , object'
  , array
  , array'
  , string
  , scientific
    -- * Builder helpers
  , kv, kv'
    -- * Re-export 'Value' type
  , Value(..)
  ) where

import           Control.Monad
import qualified Z.Data.Builder                 as B
import qualified Z.Data.Text                    as T
import qualified Z.Data.Text.ShowT              as T
import           Z.Data.Vector.Base             as V
import           Z.Data.JSON.Value              (Value(..))
import           Data.Scientific              (Scientific, base10Exponent, coefficient)

-- | Use @:@ as separator to connect a label(no need to escape, only add quotes) with field builders.
kv :: T.Text -> B.Builder () -> B.Builder ()
{-# INLINE kv #-}
Text
l kv :: Text -> Builder () -> Builder ()
`kv` Builder ()
b = Builder () -> Builder ()
B.quotes (Text -> Builder ()
B.text Text
l) Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
B.colon Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
b

-- | Use @:@ as separator to connect a label(escaped and add quotes) with field builders.
kv' :: T.Text -> B.Builder () -> B.Builder ()
{-# INLINE kv' #-}
Text
l kv' :: Text -> Builder () -> Builder ()
`kv'` Builder ()
b = Text -> Builder ()
string Text
l Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
B.colon Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
b

-- | Encode a 'Value', you can use this function with 'toValue' to get 'encodeJSON' with a small overhead.
value :: Value -> B.Builder ()
{-# INLINABLE value #-}
value :: Value -> Builder ()
value (Object Vector (Text, Value)
kvs) = Vector (Text, Value) -> Builder ()
object Vector (Text, Value)
kvs
value (Array Vector Value
vs) = Vector Value -> Builder ()
array Vector Value
vs
value (String Text
t) = Text -> Builder ()
string Text
t
value (Number Scientific
n) = Scientific -> Builder ()
scientific Scientific
n
value (Bool Bool
True) = Builder ()
"true"
value (Bool Bool
False) = Builder ()
"false"
value Value
Null = Builder ()
"null"

array :: V.Vector Value -> B.Builder ()
{-# INLINE array #-}
array :: Vector Value -> Builder ()
array = Builder () -> Builder ()
B.square (Builder () -> Builder ())
-> (Vector Value -> Builder ()) -> Vector Value -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> (Value -> Builder ()) -> Vector Value -> Builder ()
forall (v :: * -> *) a.
Vec v a =>
Builder () -> (a -> Builder ()) -> v a -> Builder ()
B.intercalateVec Builder ()
B.comma Value -> Builder ()
value

array' :: (a -> B.Builder ()) -> V.Vector a -> B.Builder ()
{-# INLINE array' #-}
array' :: (a -> Builder ()) -> Vector a -> Builder ()
array' a -> Builder ()
f = Builder () -> Builder ()
B.square (Builder () -> Builder ())
-> (Vector a -> Builder ()) -> Vector a -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> (a -> Builder ()) -> Vector a -> Builder ()
forall (v :: * -> *) a.
Vec v a =>
Builder () -> (a -> Builder ()) -> v a -> Builder ()
B.intercalateVec Builder ()
B.comma a -> Builder ()
f

object :: V.Vector (T.Text, Value) -> B.Builder ()
{-# INLINE object #-}
object :: Vector (Text, Value) -> Builder ()
object = Builder () -> Builder ()
B.curly (Builder () -> Builder ())
-> (Vector (Text, Value) -> Builder ())
-> Vector (Text, Value)
-> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder ()
-> ((Text, Value) -> Builder ())
-> Vector (Text, Value)
-> Builder ()
forall (v :: * -> *) a.
Vec v a =>
Builder () -> (a -> Builder ()) -> v a -> Builder ()
B.intercalateVec Builder ()
B.comma (\ (Text
k, Value
v) -> Text
k Text -> Builder () -> Builder ()
`kv'` Value -> Builder ()
value Value
v)

object' :: (a -> B.Builder ()) -> V.Vector (T.Text, a) -> B.Builder ()
{-# INLINE object' #-}
object' :: (a -> Builder ()) -> Vector (Text, a) -> Builder ()
object' a -> Builder ()
f = Builder () -> Builder ()
B.curly (Builder () -> Builder ())
-> (Vector (Text, a) -> Builder ())
-> Vector (Text, a)
-> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder ()
-> ((Text, a) -> Builder ()) -> Vector (Text, a) -> Builder ()
forall (v :: * -> *) a.
Vec v a =>
Builder () -> (a -> Builder ()) -> v a -> Builder ()
B.intercalateVec Builder ()
B.comma (\ (Text
k, a
v) -> Text
k Text -> Builder () -> Builder ()
`kv'` a -> Builder ()
f a
v)

-- | Escape text into JSON string and add double quotes, escaping rules:
--
-- @
--    \'\\b\':  \"\\b\"
--    \'\\f\':  \"\\f\"
--    \'\\n\':  \"\\n\"
--    \'\\r\':  \"\\r\"
--    \'\\t\':  \"\\t\"
--    \'\"\':  \"\\\"\"
--    \'\\\':  \"\\\\\"
--    \'\/\':  \"\\/\"
--    other chars <= 0x1F: "\\u00XX"
-- @
--
string :: T.Text -> B.Builder ()
{-# INLINE string #-}
string :: Text -> Builder ()
string = Text -> Builder ()
T.escapeTextJSON

-- | This builder try to render integer when (0 <= e < 1024), and scientific notation otherwise.
scientific :: Scientific -> B.Builder ()
{-# INLINE scientific #-}
scientific :: Scientific -> Builder ()
scientific Scientific
s
    | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1024 = Scientific -> Builder ()
B.scientific Scientific
s
    | Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Integer -> Builder ()
B.integer Integer
c
    | Bool
otherwise = do
        Integer -> Builder ()
B.integer Integer
c
        Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
c Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0) (Int -> Builder () -> Builder ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
e (Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
B.encodePrim Word8
B.ZERO))
  where
    e :: Int
e = Scientific -> Int
base10Exponent Scientific
s
    c :: Integer
c = Scientific -> Integer
coefficient Scientific
s