{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns, UndecidableInstances #-}
module Data.BufferBuilder.Json
(
Value
, ToJson (..)
, encodeJson
, JsonString
, ToJsonString (..)
, ObjectBuilder
, emptyObject
, (.=)
, (.=#)
, row
, array
, nullValue
, unsafeValueUtf8Builder
, unsafeStringUtf8Builder
, unsafeAppendUtf8Builder
, unsafeAppendBS
) where
import GHC.Base
import Foreign.Storable
import Control.Monad (when, forM_)
import Data.BufferBuilder.Utf8 (Utf8Builder)
import qualified Data.BufferBuilder.Utf8 as UB
import Data.ByteString (ByteString)
import Data.Monoid hiding ((<>))
import Data.Semigroup
import Data.Text (Text)
import Data.Foldable (Foldable, foldMap)
import qualified Data.Vector as Vector
import qualified Data.Vector.Generic as GVector
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
import qualified Data.HashMap.Strict as HashMap
newtype Value = Value { Value -> Utf8Builder ()
utf8Builder :: Utf8Builder () }
class ToJson a where
toJson :: a -> Value
encodeJson :: ToJson a => a -> ByteString
encodeJson :: a -> ByteString
encodeJson = Utf8Builder () -> ByteString
UB.runUtf8Builder (Utf8Builder () -> ByteString)
-> (a -> Utf8Builder ()) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Utf8Builder ()
utf8Builder (Value -> Utf8Builder ()) -> (a -> Value) -> a -> Utf8Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJson a => a -> Value
toJson
{-# INLINE encodeJson #-}
newtype JsonString = JsonString { JsonString -> Utf8Builder ()
unJsonString :: Utf8Builder () }
class ToJson a => ToJsonString a where
toJsonString :: a -> JsonString
data ObjectBuilder = NoPair | Pair !(Utf8Builder ())
instance Semigroup ObjectBuilder where
{-# INLINE (<>) #-}
ObjectBuilder
NoPair <> :: ObjectBuilder -> ObjectBuilder -> ObjectBuilder
<> ObjectBuilder
a = ObjectBuilder
a
ObjectBuilder
a <> ObjectBuilder
NoPair = ObjectBuilder
a
(Pair Utf8Builder ()
a) <> (Pair Utf8Builder ()
b) = Utf8Builder () -> ObjectBuilder
Pair (Utf8Builder () -> ObjectBuilder)
-> Utf8Builder () -> ObjectBuilder
forall a b. (a -> b) -> a -> b
$ do
Utf8Builder ()
a
Char -> Utf8Builder ()
UB.appendChar7 Char
','
Utf8Builder ()
b
instance Monoid ObjectBuilder where
{-# INLINE mempty #-}
mempty :: ObjectBuilder
mempty = ObjectBuilder
NoPair
{-# INLINE mappend #-}
mappend :: ObjectBuilder -> ObjectBuilder -> ObjectBuilder
mappend = ObjectBuilder -> ObjectBuilder -> ObjectBuilder
forall a. Semigroup a => a -> a -> a
(<>)
instance ToJson ObjectBuilder where
{-# INLINE toJson #-}
toJson :: ObjectBuilder -> Value
toJson ObjectBuilder
NoPair = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ do
Char -> Utf8Builder ()
UB.appendChar7 Char
'{'
Char -> Utf8Builder ()
UB.appendChar7 Char
'}'
toJson (Pair Utf8Builder ()
a) = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ do
Char -> Utf8Builder ()
UB.appendChar7 Char
'{'
Utf8Builder ()
a
Char -> Utf8Builder ()
UB.appendChar7 Char
'}'
emptyObject :: Value
emptyObject :: Value
emptyObject = ObjectBuilder -> Value
forall a. ToJson a => a -> Value
toJson ObjectBuilder
NoPair
{-# INLINE emptyObject #-}
row :: (ToJsonString k, ToJson v) => k -> v -> ObjectBuilder
row :: k -> v -> ObjectBuilder
row k
k v
v = Utf8Builder () -> ObjectBuilder
Pair (Utf8Builder () -> ObjectBuilder)
-> Utf8Builder () -> ObjectBuilder
forall a b. (a -> b) -> a -> b
$ do
JsonString -> Utf8Builder ()
unJsonString (JsonString -> Utf8Builder ()) -> JsonString -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ k -> JsonString
forall a. ToJsonString a => a -> JsonString
toJsonString k
k
Char -> Utf8Builder ()
UB.appendChar7 Char
':'
Value -> Utf8Builder ()
utf8Builder (Value -> Utf8Builder ()) -> Value -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ v -> Value
forall a. ToJson a => a -> Value
toJson v
v
infixr 8 `row`
{-# INLINE row #-}
(.=) :: ToJson a => Text -> a -> ObjectBuilder
Text
a .= :: Text -> a -> ObjectBuilder
.= a
b = Utf8Builder () -> ObjectBuilder
Pair (Utf8Builder () -> ObjectBuilder)
-> Utf8Builder () -> ObjectBuilder
forall a b. (a -> b) -> a -> b
$ do
Text -> Utf8Builder ()
UB.appendEscapedJsonText Text
a
Char -> Utf8Builder ()
UB.appendChar7 Char
':'
Value -> Utf8Builder ()
utf8Builder (Value -> Utf8Builder ()) -> Value -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJson a => a -> Value
toJson a
b
infixr 8 .=
{-# INLINE (.=) #-}
(.=#) :: ToJson a => Addr# -> a -> ObjectBuilder
Addr#
a .=# :: Addr# -> a -> ObjectBuilder
.=# a
b = Utf8Builder () -> ObjectBuilder
Pair (Utf8Builder () -> ObjectBuilder)
-> Utf8Builder () -> ObjectBuilder
forall a b. (a -> b) -> a -> b
$ do
Addr# -> Utf8Builder ()
UB.appendEscapedJsonLiteral Addr#
a
Char -> Utf8Builder ()
UB.appendChar7 Char
':'
Value -> Utf8Builder ()
utf8Builder (Value -> Utf8Builder ()) -> Value -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJson a => a -> Value
toJson a
b
infixr 8 .=#
{-# INLINE (.=#) #-}
{-# INLINE writePair #-}
writePair :: (ToJsonString k, ToJson v) => (k, v) -> Utf8Builder ()
writePair :: (k, v) -> Utf8Builder ()
writePair (k
key, v
value) = do
JsonString -> Utf8Builder ()
unJsonString (JsonString -> Utf8Builder ()) -> JsonString -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ k -> JsonString
forall a. ToJsonString a => a -> JsonString
toJsonString k
key
Char -> Utf8Builder ()
UB.appendChar7 Char
':'
Value -> Utf8Builder ()
utf8Builder (Value -> Utf8Builder ()) -> Value -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ v -> Value
forall a. ToJson a => a -> Value
toJson v
value
instance (ToJsonString k, ToJson v) => ToJson (HashMap.HashMap k v) where
{-# INLINABLE toJson #-}
toJson :: HashMap k v -> Value
toJson HashMap k v
hm = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ do
Char -> Utf8Builder ()
UB.appendChar7 Char
'{'
case HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap k v
hm of
[] -> Char -> Utf8Builder ()
UB.appendChar7 Char
'}'
((k, v)
x:[(k, v)]
xs) -> do
(k, v) -> Utf8Builder ()
forall k v. (ToJsonString k, ToJson v) => (k, v) -> Utf8Builder ()
writePair (k, v)
x
[(k, v)] -> ((k, v) -> Utf8Builder ()) -> Utf8Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(k, v)]
xs (((k, v) -> Utf8Builder ()) -> Utf8Builder ())
-> ((k, v) -> Utf8Builder ()) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ \(k, v)
p -> do
Char -> Utf8Builder ()
UB.appendChar7 Char
','
(k, v) -> Utf8Builder ()
forall k v. (ToJsonString k, ToJson v) => (k, v) -> Utf8Builder ()
writePair (k, v)
p
Char -> Utf8Builder ()
UB.appendChar7 Char
'}'
array :: (Foldable t, ToJson a) => t a -> Value
array :: t a -> Value
array t a
collection = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ do
Char -> Utf8Builder ()
UB.appendChar7 Char
'['
case (a -> ObjectBuilder) -> t a -> ObjectBuilder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Utf8Builder () -> ObjectBuilder
Pair (Utf8Builder () -> ObjectBuilder)
-> (a -> Utf8Builder ()) -> a -> ObjectBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Utf8Builder ()
utf8Builder (Value -> Utf8Builder ()) -> (a -> Value) -> a -> Utf8Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJson a => a -> Value
toJson) t a
collection of
ObjectBuilder
NoPair -> () -> Utf8Builder ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Pair Utf8Builder ()
b) -> Utf8Builder ()
b
Char -> Utf8Builder ()
UB.appendChar7 Char
']'
{-# INLINABLE array #-}
instance ToJson a => ToJson [a] where
{-# INLINABLE toJson #-}
toJson :: [a] -> Value
toJson ![a]
ls = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ do
Char -> Utf8Builder ()
UB.appendChar7 Char
'['
case [a]
ls of
[] -> Char -> Utf8Builder ()
UB.appendChar7 Char
']'
a
x:[a]
xs -> do
Value -> Utf8Builder ()
utf8Builder (Value -> Utf8Builder ()) -> Value -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJson a => a -> Value
toJson a
x
[a] -> (a -> Utf8Builder ()) -> Utf8Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [a]
xs ((a -> Utf8Builder ()) -> Utf8Builder ())
-> (a -> Utf8Builder ()) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ \(!a
e) -> do
Char -> Utf8Builder ()
UB.appendChar7 Char
','
Value -> Utf8Builder ()
utf8Builder (Value -> Utf8Builder ()) -> Value -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJson a => a -> Value
toJson a
e
Char -> Utf8Builder ()
UB.appendChar7 Char
']'
instance ToJson a => ToJson (Vector.Vector a) where
{-# INLINABLE toJson #-}
toJson :: Vector a -> Value
toJson = Vector a -> Value
forall (v :: * -> *) a. (Vector v a, ToJson a) => v a -> Value
vector
instance (Storable a, ToJson a) => ToJson (VS.Vector a) where
{-# INLINABLE toJson #-}
toJson :: Vector a -> Value
toJson = Vector a -> Value
forall (v :: * -> *) a. (Vector v a, ToJson a) => v a -> Value
vector
instance (VP.Prim a, ToJson a) => ToJson (VP.Vector a) where
{-# INLINABLE toJson #-}
toJson :: Vector a -> Value
toJson = Vector a -> Value
forall (v :: * -> *) a. (Vector v a, ToJson a) => v a -> Value
vector
instance (GVector.Vector VU.Vector a, ToJson a) => ToJson (VU.Vector a) where
{-# INLINABLE toJson #-}
toJson :: Vector a -> Value
toJson = Vector a -> Value
forall (v :: * -> *) a. (Vector v a, ToJson a) => v a -> Value
vector
{-# INLINABLE vector #-}
vector :: (GVector.Vector v a, ToJson a) => v a -> Value
vector :: v a -> Value
vector !v a
vec = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ do
Char -> Utf8Builder ()
UB.appendChar7 Char
'['
let len :: Int
len = v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
GVector.length v a
vec
Bool -> Utf8Builder () -> Utf8Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Utf8Builder () -> Utf8Builder ())
-> Utf8Builder () -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ do
Value -> Utf8Builder ()
utf8Builder (Value -> Utf8Builder ()) -> Value -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJson a => a -> Value
toJson (v a
vec v a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
`GVector.unsafeIndex` Int
0)
v a -> (a -> Utf8Builder ()) -> Utf8Builder ()
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
v a -> (a -> m b) -> m ()
GVector.forM_ (v a -> v a
forall (v :: * -> *) a. Vector v a => v a -> v a
GVector.tail v a
vec) ((a -> Utf8Builder ()) -> Utf8Builder ())
-> (a -> Utf8Builder ()) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ \a
e -> do
Char -> Utf8Builder ()
UB.appendChar7 Char
','
Value -> Utf8Builder ()
utf8Builder (Value -> Utf8Builder ()) -> Value -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJson a => a -> Value
toJson a
e
Char -> Utf8Builder ()
UB.appendChar7 Char
']'
nullValue :: Value
nullValue :: Value
nullValue = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Addr# -> Utf8Builder ()
UB.unsafeAppendLiteralN Int
4 Addr#
"null"#
{-# INLINE nullValue #-}
instance ToJson Value where
{-# INLINE toJson #-}
toJson :: Value -> Value
toJson = Value -> Value
forall a. a -> a
id
instance ToJson Bool where
{-# INLINE toJson #-}
toJson :: Bool -> Value
toJson Bool
True = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Addr# -> Utf8Builder ()
UB.unsafeAppendLiteralN Int
4 Addr#
"true"#
toJson Bool
False = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Addr# -> Utf8Builder ()
UB.unsafeAppendLiteralN Int
5 Addr#
"false"#
instance ToJson a => ToJson (Maybe a) where
{-# INLINE toJson #-}
toJson :: Maybe a -> Value
toJson Maybe a
m = case Maybe a
m of
Maybe a
Nothing -> Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Addr# -> Utf8Builder ()
UB.unsafeAppendLiteralN Int
4 Addr#
"null"#
Just a
a -> a -> Value
forall a. ToJson a => a -> Value
toJson a
a
instance ToJson Text where
{-# INLINE toJson #-}
toJson :: Text -> Value
toJson Text
text = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Utf8Builder ()
UB.appendEscapedJsonText Text
text
instance ToJson Double where
{-# INLINE toJson #-}
toJson :: Double -> Value
toJson Double
a = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ Double -> Utf8Builder ()
UB.appendDecimalDouble Double
a
instance ToJson Int where
{-# INLINE toJson #-}
toJson :: Int -> Value
toJson Int
a = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Utf8Builder ()
UB.appendDecimalSignedInt Int
a
instance ToJsonString JsonString where
toJsonString :: JsonString -> JsonString
toJsonString = JsonString -> JsonString
forall a. a -> a
id
instance ToJson JsonString where
toJson :: JsonString -> Value
toJson = Utf8Builder () -> Value
Value (Utf8Builder () -> Value)
-> (JsonString -> Utf8Builder ()) -> JsonString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonString -> Utf8Builder ()
unJsonString
instance ToJsonString Text where
{-# INLINE toJsonString #-}
toJsonString :: Text -> JsonString
toJsonString Text
text = Utf8Builder () -> JsonString
JsonString (Utf8Builder () -> JsonString) -> Utf8Builder () -> JsonString
forall a b. (a -> b) -> a -> b
$ Text -> Utf8Builder ()
UB.appendEscapedJsonText Text
text
unsafeValueUtf8Builder :: Utf8Builder () -> Value
unsafeValueUtf8Builder :: Utf8Builder () -> Value
unsafeValueUtf8Builder = Utf8Builder () -> Value
Value
unsafeStringUtf8Builder :: Utf8Builder () -> JsonString
unsafeStringUtf8Builder :: Utf8Builder () -> JsonString
unsafeStringUtf8Builder = Utf8Builder () -> JsonString
JsonString
{-# DEPRECATED unsafeAppendBS "Use unsafeValueUtf8Builder or unsafeStringUtf8Builder instead" #-}
unsafeAppendBS :: ByteString -> Value
unsafeAppendBS :: ByteString -> Value
unsafeAppendBS ByteString
bs = Utf8Builder () -> Value
Value (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Utf8Builder ()
UB.unsafeAppendBS ByteString
bs
{-# DEPRECATED unsafeAppendUtf8Builder "Use unsafeValueUtf8Builder or unsafeStringUtf8Builder instead" #-}
unsafeAppendUtf8Builder :: Utf8Builder () -> Value
unsafeAppendUtf8Builder :: Utf8Builder () -> Value
unsafeAppendUtf8Builder = Utf8Builder () -> Value
unsafeValueUtf8Builder