{-|
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
  , prettyValue
  , prettyValue'
    -- * Builder helpers
  , kv, kv'
    -- * Re-export 'Value' type
  , Value(..)
  ) where

import           Control.Monad
import           Z.Data.ASCII
import qualified Z.Data.Builder                 as B
import qualified Z.Data.Text                    as T
import qualified Z.Data.Text.Print              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 escape, only add quotes) with field builders.
--
-- Don't use chars which need escaped in label.
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(escape the label 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
_ = 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\"
--    \'\"\':  \"\\\"\"
--    \'\\\':  \"\\\\\"
--    \'\DEL\':  \"\\u007f\"
--    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 < 16), 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
16 = 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
DIGIT_0))
  where
    e :: Int
e = Scientific -> Int
base10Exponent Scientific
s
    c :: Integer
c = Scientific -> Integer
coefficient Scientific
s

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

-- | 'ValuePretty\'' with 4 spaces indentation per level, e.g.
--
-- @
-- {
--     "results":
--     [
--         {
--             "from_user_id_str":"80430860",
--             "profile_image_url":"http://a2.twimg.com/profile_images/536455139/icon32_normal.png",
--             "created_at":"Wed, 26 Jan 2011 07:07:02 +0000",
--             "from_user":"kazu_yamamoto",
--             "id_str":"30159761706061824",
--             "metadata":
--             {
--                 "result_type":"recent"
--             },
--             "to_user_id":null,
--             "text":"Haskell Server Pages って、まだ続いていたのか！",
--             "id":30159761706061824,
--             "from_user_id":80430860,
--             "geo":null,
--             "iso_language_code":"no",
--             "to_user_id_str":null,
--             "source":"&lt;a href=&quot;http://twitter.com/&quot;&gt;web&lt;/a&gt;"
--         }
--     ],
--     "max_id":30159761706061824,
--     "since_id":0,
--     "refresh_url":"?since_id=30159761706061824&q=haskell",
--     "next_page":"?page=2&max_id=30159761706061824&rpp=1&q=haskell",
--     "results_per_page":1,
--     "page":1,
--     "completed_in":1.2606e-2,
--     "since_id_str":"0",
--     "max_id_str":"30159761706061824",
--     "query":"haskell"
-- }
-- @
--
prettyValue :: Value -> B.Builder ()
prettyValue :: Value -> Builder ()
prettyValue = Int -> Int -> Value -> Builder ()
prettyValue' Int
4 Int
0


-- | Encode a 'Value' with indentation and linefeed.
prettyValue' :: Int  -- ^ indentation per level
             -> Int  -- ^ initial indentation
             -> Value -> B.Builder ()
{-# INLINABLE prettyValue' #-}
prettyValue' :: Int -> Int -> Value -> Builder ()
prettyValue' Int
c !Int
ind (Object Vector (Text, Value)
kvs) = Int -> Int -> Vector (Text, Value) -> Builder ()
objectPretty Int
c Int
ind Vector (Text, Value)
kvs
prettyValue' Int
c !Int
ind (Array Vector Value
vs)   = Int -> Int -> Vector Value -> Builder ()
arrayPretty Int
c Int
ind Vector Value
vs
prettyValue' Int
_ !Int
ind (String Text
t)   = Int -> Word8 -> Builder ()
B.word8N Int
ind Word8
SPACE Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Builder ()
string Text
t
prettyValue' Int
_ !Int
ind (Number Scientific
n)   = Int -> Word8 -> Builder ()
B.word8N Int
ind Word8
SPACE Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Scientific -> Builder ()
scientific Scientific
n
prettyValue' Int
_ !Int
ind (Bool Bool
True)  = Int -> Word8 -> Builder ()
B.word8N Int
ind Word8
SPACE Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
"true"
prettyValue' Int
_ !Int
ind (Bool Bool
False) = Int -> Word8 -> Builder ()
B.word8N Int
ind Word8
SPACE Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
"false"
prettyValue' Int
_ !Int
ind Value
_            = Int -> Word8 -> Builder ()
B.word8N Int
ind Word8
SPACE Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
"null"

arrayPretty :: Int -> Int -> V.Vector Value -> B.Builder ()
{-# INLINE arrayPretty #-}
arrayPretty :: Int -> Int -> Vector Value -> Builder ()
arrayPretty Int
idpl Int
ind Vector Value
vs
    | Vector Value -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Vector Value
vs = Int -> Word8 -> Builder ()
B.word8N Int
ind Word8
SPACE Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder () -> Builder ()
B.square (() -> Builder ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    | Bool
otherwise = do
        Int -> Word8 -> Builder ()
B.word8N Int
ind Word8
SPACE
        (Word8, Word8) -> Builder ()
forall a. Unaligned a => a -> Builder ()
B.encodePrim (Word8
SQUARE_LEFT, Word8
NEWLINE)
        Builder () -> (Value -> Builder ()) -> Vector Value -> Builder ()
forall (v :: * -> *) a.
Vec v a =>
Builder () -> (a -> Builder ()) -> v a -> Builder ()
B.intercalateVec
            ((Word8, Word8) -> Builder ()
forall a. Unaligned a => a -> Builder ()
B.encodePrim (Word8
COMMA, Word8
NEWLINE))
            (Int -> Int -> Value -> Builder ()
prettyValue' Int
idpl Int
ind')
            Vector Value
vs
        Word8 -> Builder ()
B.word8 Word8
NEWLINE
        Int -> Word8 -> Builder ()
B.word8N Int
ind Word8
SPACE
        Word8 -> Builder ()
B.word8 Word8
SQUARE_RIGHT
  where
    ind' :: Int
ind' = Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
idpl

objectPretty :: Int -> Int -> V.Vector (T.Text, Value) -> B.Builder ()
{-# INLINE objectPretty #-}
objectPretty :: Int -> Int -> Vector (Text, Value) -> Builder ()
objectPretty Int
idpl Int
ind Vector (Text, Value)
kvs
    | Vector (Text, Value) -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Vector (Text, Value)
kvs = Int -> Word8 -> Builder ()
B.word8N Int
ind Word8
SPACE Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder () -> Builder ()
B.curly (() -> Builder ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    | Bool
otherwise = do
        Int -> Word8 -> Builder ()
B.word8N Int
ind Word8
SPACE
        (Word8, Word8) -> Builder ()
forall a. Unaligned a => a -> Builder ()
B.encodePrim (Word8
CURLY_LEFT, Word8
NEWLINE)
        Builder ()
-> ((Text, Value) -> Builder ())
-> Vector (Text, Value)
-> Builder ()
forall (v :: * -> *) a.
Vec v a =>
Builder () -> (a -> Builder ()) -> v a -> Builder ()
B.intercalateVec
            ((Word8, Word8) -> Builder ()
forall a. Unaligned a => a -> Builder ()
B.encodePrim (Word8
COMMA, Word8
NEWLINE))
            (\ (Text
k, Value
v) -> do
                Int -> Word8 -> Builder ()
B.word8N Int
ind' Word8
SPACE
                Text -> Builder ()
string Text
k
                Builder ()
B.colon
                if Value -> Bool
isSimpleValue Value
v
                then Int -> Int -> Value -> Builder ()
prettyValue' Int
idpl Int
0 Value
v
                else do
                    Word8 -> Builder ()
B.word8 Word8
NEWLINE
                    Int -> Int -> Value -> Builder ()
prettyValue' Int
idpl Int
ind' Value
v)
            Vector (Text, Value)
kvs
        Word8 -> Builder ()
B.word8 Word8
NEWLINE
        Int -> Word8 -> Builder ()
B.word8N Int
ind Word8
SPACE
        Word8 -> Builder ()
B.word8 Word8
CURLY_RIGHT
  where
    ind' :: Int
ind' = Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
idpl
    isSimpleValue :: Value -> Bool
isSimpleValue Value
v = case Value
v of
        (Object Vector (Text, Value)
kvs') -> Vector (Text, Value) -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Vector (Text, Value)
kvs'
        (Array Vector Value
vs) -> Vector Value -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Vector Value
vs
        Value
_ -> Bool
True