{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

module Jordan.ToJSON.Builder
  ( JSONBuilder (..),
    toJSONViaBuilder,
    toJSONAsBuilder,
  )
where

import Data.ByteString.Builder (Builder, toLazyByteString)
import qualified Data.ByteString.Builder.Prim as BP
import Data.ByteString.Builder.Scientific (scientificBuilder)
import qualified Data.ByteString.Lazy as LBS
import Data.Char (ord)
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8BuilderEscaped)
import Data.Void (absurd)
import Data.Word (Word8)
import Jordan.ToJSON.Class

-- | JSON Serializer that makes use of 'Data.ByteString.Builder' to do its work.
-- Should be really fast.
newtype JSONBuilder a = JSONBuilder {JSONBuilder a -> a -> Builder
runJSONBuilder :: a -> Builder}
  deriving (b -> JSONBuilder a -> JSONBuilder a
NonEmpty (JSONBuilder a) -> JSONBuilder a
JSONBuilder a -> JSONBuilder a -> JSONBuilder a
(JSONBuilder a -> JSONBuilder a -> JSONBuilder a)
-> (NonEmpty (JSONBuilder a) -> JSONBuilder a)
-> (forall b. Integral b => b -> JSONBuilder a -> JSONBuilder a)
-> Semigroup (JSONBuilder a)
forall b. Integral b => b -> JSONBuilder a -> JSONBuilder a
forall a. NonEmpty (JSONBuilder a) -> JSONBuilder a
forall a. JSONBuilder a -> JSONBuilder a -> JSONBuilder a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> JSONBuilder a -> JSONBuilder a
stimes :: b -> JSONBuilder a -> JSONBuilder a
$cstimes :: forall a b. Integral b => b -> JSONBuilder a -> JSONBuilder a
sconcat :: NonEmpty (JSONBuilder a) -> JSONBuilder a
$csconcat :: forall a. NonEmpty (JSONBuilder a) -> JSONBuilder a
<> :: JSONBuilder a -> JSONBuilder a -> JSONBuilder a
$c<> :: forall a. JSONBuilder a -> JSONBuilder a -> JSONBuilder a
Semigroup, Semigroup (JSONBuilder a)
JSONBuilder a
Semigroup (JSONBuilder a)
-> JSONBuilder a
-> (JSONBuilder a -> JSONBuilder a -> JSONBuilder a)
-> ([JSONBuilder a] -> JSONBuilder a)
-> Monoid (JSONBuilder a)
[JSONBuilder a] -> JSONBuilder a
JSONBuilder a -> JSONBuilder a -> JSONBuilder a
forall a. Semigroup (JSONBuilder a)
forall a. JSONBuilder a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [JSONBuilder a] -> JSONBuilder a
forall a. JSONBuilder a -> JSONBuilder a -> JSONBuilder a
mconcat :: [JSONBuilder a] -> JSONBuilder a
$cmconcat :: forall a. [JSONBuilder a] -> JSONBuilder a
mappend :: JSONBuilder a -> JSONBuilder a -> JSONBuilder a
$cmappend :: forall a. JSONBuilder a -> JSONBuilder a -> JSONBuilder a
mempty :: JSONBuilder a
$cmempty :: forall a. JSONBuilder a
$cp1Monoid :: forall a. Semigroup (JSONBuilder a)
Monoid) via (a -> Builder)

instance Contravariant JSONBuilder where
  contramap :: (a -> b) -> JSONBuilder b -> JSONBuilder a
contramap a -> b
f (JSONBuilder b -> Builder
a) = (a -> Builder) -> JSONBuilder a
forall a. (a -> Builder) -> JSONBuilder a
JSONBuilder ((a -> Builder) -> JSONBuilder a)
-> (a -> Builder) -> JSONBuilder a
forall a b. (a -> b) -> a -> b
$ b -> Builder
a (b -> Builder) -> (a -> b) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

data CommaSep
  = Written !Builder
  | Empty

instance Semigroup CommaSep where
  CommaSep
Empty <> :: CommaSep -> CommaSep -> CommaSep
<> CommaSep
a = CommaSep
a
  CommaSep
a <> CommaSep
Empty = CommaSep
a
  (Written Builder
a) <> (Written Builder
b) = Builder -> CommaSep
Written (Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b)

instance Monoid CommaSep where
  mempty :: CommaSep
mempty = CommaSep
Empty

runCommaSep :: CommaSep -> Builder
runCommaSep :: CommaSep -> Builder
runCommaSep CommaSep
Empty = Builder
""
runCommaSep (Written Builder
w) = Builder
w

newtype JSONCommaBuilder a = JSONCommaBuilder {JSONCommaBuilder a -> a -> CommaSep
runCommaBuilder :: a -> CommaSep}

-- Lifted from aeson (thanks to them!)
ascii2 :: (Char, Char) -> BP.BoundedPrim a
ascii2 :: (Char, Char) -> BoundedPrim a
ascii2 (Char, Char)
cs = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ (Char, Char) -> a -> (Char, Char)
forall a b. a -> b -> a
const (Char, Char)
cs (a -> (Char, Char)) -> FixedPrim (Char, Char) -> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
BP.>$< FixedPrim Char
BP.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BP.>*< FixedPrim Char
BP.char7
{-# INLINE ascii2 #-}

-- | Mostly lifted from Aeson (thanks to them).
escapeAscii :: BP.BoundedPrim Word8
escapeAscii :: BoundedPrim Word8
escapeAscii =
  -- Irritatingly we have a few non-control characters we need to escape,
  -- so we try to do that first.
  (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x5c) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\', Char
'\\')) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ -- a backslash
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x22) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\', Char
'"')) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ -- a quote
      (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x20) (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded FixedPrim Word8
BP.word8) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ -- Now, if we have an ordinal above 0x20, we can just encode directly
        (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0a) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\', Char
'n')) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ -- Special control character \n
          (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0d) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\', Char
'r')) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ -- special control character \r
            (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\', Char
't')) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ -- Special control character \t
              (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0c) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\', Char
'f')) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ -- Special control character \f
                (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x08) ((Char, Char) -> BoundedPrim Word8
forall a. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\', Char
'b')) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ -- Special control character \b
                  FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded FixedPrim Word8
hexEscape -- fallback for other control characters
  where
    hexEscape :: BP.FixedPrim Word8
    hexEscape :: FixedPrim Word8
hexEscape =
      (\Word8
c -> (Char
'\\', (Char
'u', (Char
'0', (Char
'0', Word8
c)))))
        (Word8 -> (Char, (Char, (Char, (Char, Word8)))))
-> FixedPrim (Char, (Char, (Char, (Char, Word8))))
-> FixedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
BP.>$< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, (Char, Word8)))
-> FixedPrim (Char, (Char, (Char, (Char, Word8))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BP.>*< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, (Char, Word8))
-> FixedPrim (Char, (Char, (Char, Word8)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BP.>*< FixedPrim Char
BP.char7 FixedPrim Char
-> FixedPrim (Char, Word8) -> FixedPrim (Char, (Char, Word8))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BP.>*< FixedPrim Char
BP.char7 FixedPrim Char -> FixedPrim Word8 -> FixedPrim (Char, Word8)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BP.>*< FixedPrim Word8
BP.word8HexFixed
{-# INLINE escapeAscii #-}

-- | Make a builder for a quoted string, which does all the cool escaping crap we need to do.
-- Mostly stolen shamelessly from Aeson.
serializeQuotedString :: Text -> Builder
serializeQuotedString :: Text -> Builder
serializeQuotedString Text
t = Builder
"\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BoundedPrim Word8 -> Text -> Builder
encodeUtf8BuilderEscaped BoundedPrim Word8
escapeAscii Text
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""

serializeKV :: (a -> Builder) -> Text -> a -> Builder
serializeKV :: (a -> Builder) -> Text -> a -> Builder
serializeKV a -> Builder
map Text
k a
v = Text -> Builder
serializeQuotedString Text
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
map a
v

instance Contravariant JSONCommaBuilder where
  contramap :: (a -> b) -> JSONCommaBuilder b -> JSONCommaBuilder a
contramap a -> b
f (JSONCommaBuilder b -> CommaSep
a) = (a -> CommaSep) -> JSONCommaBuilder a
forall a. (a -> CommaSep) -> JSONCommaBuilder a
JSONCommaBuilder ((a -> CommaSep) -> JSONCommaBuilder a)
-> (a -> CommaSep) -> JSONCommaBuilder a
forall a b. (a -> b) -> a -> b
$ b -> CommaSep
a (b -> CommaSep) -> (a -> b) -> a -> CommaSep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

instance Divisible JSONCommaBuilder where
  conquer :: JSONCommaBuilder a
conquer = (a -> CommaSep) -> JSONCommaBuilder a
forall a. (a -> CommaSep) -> JSONCommaBuilder a
JSONCommaBuilder ((a -> CommaSep) -> JSONCommaBuilder a)
-> (a -> CommaSep) -> JSONCommaBuilder a
forall a b. (a -> b) -> a -> b
$ CommaSep -> a -> CommaSep
forall a b. a -> b -> a
const CommaSep
Empty
  divide :: (a -> (b, c))
-> JSONCommaBuilder b -> JSONCommaBuilder c -> JSONCommaBuilder a
divide a -> (b, c)
split JSONCommaBuilder b
sB JSONCommaBuilder c
sC = (a -> CommaSep) -> JSONCommaBuilder a
forall a. (a -> CommaSep) -> JSONCommaBuilder a
JSONCommaBuilder ((a -> CommaSep) -> JSONCommaBuilder a)
-> (a -> CommaSep) -> JSONCommaBuilder a
forall a b. (a -> b) -> a -> b
$ \a
a ->
    case a -> (b, c)
split a
a of
      (b
b, c
c) -> JSONCommaBuilder b -> b -> CommaSep
forall a. JSONCommaBuilder a -> a -> CommaSep
runCommaBuilder JSONCommaBuilder b
sB b
b CommaSep -> CommaSep -> CommaSep
forall a. Semigroup a => a -> a -> a
<> JSONCommaBuilder c -> c -> CommaSep
forall a. JSONCommaBuilder a -> a -> CommaSep
runCommaBuilder JSONCommaBuilder c
sC c
c

instance JSONObjectSerializer JSONCommaBuilder where
  serializeFieldWith :: Text
-> (forall (jsonSerializer :: * -> *).
    JSONSerializer jsonSerializer =>
    jsonSerializer a)
-> JSONCommaBuilder a
serializeFieldWith Text
field (JSONBuilder a) = (a -> CommaSep) -> JSONCommaBuilder a
forall a. (a -> CommaSep) -> JSONCommaBuilder a
JSONCommaBuilder ((a -> CommaSep) -> JSONCommaBuilder a)
-> (a -> CommaSep) -> JSONCommaBuilder a
forall a b. (a -> b) -> a -> b
$ \a
arg ->
    Builder -> CommaSep
Written (Builder -> CommaSep) -> Builder -> CommaSep
forall a b. (a -> b) -> a -> b
$ Text -> Builder
serializeQuotedString Text
field Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
a a
arg
  serializeJust :: Text
-> (forall (jsonSerializer :: * -> *).
    JSONSerializer jsonSerializer =>
    jsonSerializer a)
-> JSONCommaBuilder (Maybe a)
serializeJust Text
field (JSONBuilder a) = (Maybe a -> CommaSep) -> JSONCommaBuilder (Maybe a)
forall a. (a -> CommaSep) -> JSONCommaBuilder a
JSONCommaBuilder ((Maybe a -> CommaSep) -> JSONCommaBuilder (Maybe a))
-> (Maybe a -> CommaSep) -> JSONCommaBuilder (Maybe a)
forall a b. (a -> b) -> a -> b
$ \case
    Maybe a
Nothing -> CommaSep
Empty
    Just a
a' -> Builder -> CommaSep
Written (Builder -> CommaSep) -> Builder -> CommaSep
forall a b. (a -> b) -> a -> b
$ Text -> Builder
serializeQuotedString Text
field Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
a a
a'

instance JSONTupleSerializer JSONCommaBuilder where
  serializeItemWith :: (forall (jsonSerializer :: * -> *).
 JSONSerializer jsonSerializer =>
 jsonSerializer a)
-> JSONCommaBuilder a
serializeItemWith (JSONBuilder a) = (a -> CommaSep) -> JSONCommaBuilder a
forall a. (a -> CommaSep) -> JSONCommaBuilder a
JSONCommaBuilder ((a -> CommaSep) -> JSONCommaBuilder a)
-> (a -> CommaSep) -> JSONCommaBuilder a
forall a b. (a -> b) -> a -> b
$ Builder -> CommaSep
Written (Builder -> CommaSep) -> (a -> Builder) -> a -> CommaSep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
a

instance Selectable JSONBuilder where
  giveUp :: (arg -> Void) -> JSONBuilder arg
giveUp arg -> Void
f = (arg -> Builder) -> JSONBuilder arg
forall a. (a -> Builder) -> JSONBuilder a
JSONBuilder ((arg -> Builder) -> JSONBuilder arg)
-> (arg -> Builder) -> JSONBuilder arg
forall a b. (a -> b) -> a -> b
$ \arg
a -> Void -> Builder
forall a. Void -> a
absurd (arg -> Void
f arg
a)
  select :: (arg -> Either lhs rhs)
-> JSONBuilder lhs -> JSONBuilder rhs -> JSONBuilder arg
select arg -> Either lhs rhs
sel JSONBuilder lhs
serL JSONBuilder rhs
serR = (arg -> Builder) -> JSONBuilder arg
forall a. (a -> Builder) -> JSONBuilder a
JSONBuilder ((arg -> Builder) -> JSONBuilder arg)
-> (arg -> Builder) -> JSONBuilder arg
forall a b. (a -> b) -> a -> b
$ \arg
a ->
    case arg -> Either lhs rhs
sel arg
a of
      Left lhs
lhs -> JSONBuilder lhs -> lhs -> Builder
forall a. JSONBuilder a -> a -> Builder
runJSONBuilder JSONBuilder lhs
serL lhs
lhs
      Right rhs
rhs -> JSONBuilder rhs -> rhs -> Builder
forall a. JSONBuilder a -> a -> Builder
runJSONBuilder JSONBuilder rhs
serR rhs
rhs

instance JSONSerializer JSONBuilder where
  serializeObject :: (forall (objSerializer :: * -> *).
 JSONObjectSerializer objSerializer =>
 objSerializer a)
-> JSONBuilder a
serializeObject (JSONCommaBuilder f) = (a -> Builder) -> JSONBuilder a
forall a. (a -> Builder) -> JSONBuilder a
JSONBuilder ((a -> Builder) -> JSONBuilder a)
-> (a -> Builder) -> JSONBuilder a
forall a b. (a -> b) -> a -> b
$ \a
a ->
    case a -> CommaSep
f a
a of
      Written Builder
bu -> Builder
"{" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bu Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
      CommaSep
Empty -> Builder
"{}"
  serializeTuple :: (forall (tupleSerializer :: * -> *).
 JSONTupleSerializer tupleSerializer =>
 tupleSerializer a)
-> JSONBuilder a
serializeTuple (JSONCommaBuilder f) = (a -> Builder) -> JSONBuilder a
forall a. (a -> Builder) -> JSONBuilder a
JSONBuilder ((a -> Builder) -> JSONBuilder a)
-> (a -> Builder) -> JSONBuilder a
forall a b. (a -> b) -> a -> b
$ \a
a ->
    case a -> CommaSep
f a
a of
      Written Builder
bu -> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bu Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"
      CommaSep
Empty -> Builder
"[]"
  serializeDictionary :: (forall (jsonSerializer :: * -> *).
 JSONSerializer jsonSerializer =>
 jsonSerializer a)
-> JSONBuilder (t (Text, a))
serializeDictionary (JSONBuilder t) = (t (Text, a) -> Builder) -> JSONBuilder (t (Text, a))
forall a. (a -> Builder) -> JSONBuilder a
JSONBuilder ((t (Text, a) -> Builder) -> JSONBuilder (t (Text, a)))
-> (t (Text, a) -> Builder) -> JSONBuilder (t (Text, a))
forall a b. (a -> b) -> a -> b
$ \t (Text, a)
a ->
    Builder
"{" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CommaSep -> Builder
runCommaSep (((Text, a) -> CommaSep) -> t (Text, a) -> CommaSep
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Text
k, a
v) -> Builder -> CommaSep
Written ((a -> Builder) -> Text -> a -> Builder
forall a. (a -> Builder) -> Text -> a -> Builder
serializeKV a -> Builder
t Text
k a
v)) t (Text, a)
a) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
  serializeText :: JSONBuilder Text
serializeText = (Text -> Builder) -> JSONBuilder Text
forall a. (a -> Builder) -> JSONBuilder a
JSONBuilder ((Text -> Builder) -> JSONBuilder Text)
-> (Text -> Builder) -> JSONBuilder Text
forall a b. (a -> b) -> a -> b
$ \Text
t -> Text -> Builder
serializeQuotedString Text
t
  serializeTextConstant :: Text -> JSONBuilder a
serializeTextConstant = (a -> Builder) -> JSONBuilder a
forall a. (a -> Builder) -> JSONBuilder a
JSONBuilder ((a -> Builder) -> JSONBuilder a)
-> (Text -> a -> Builder) -> Text -> JSONBuilder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> a -> Builder
forall a b. a -> b -> a
const (Builder -> a -> Builder)
-> (Text -> Builder) -> Text -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
serializeQuotedString
  serializeNumber :: JSONBuilder Scientific
serializeNumber = (Scientific -> Builder) -> JSONBuilder Scientific
forall a. (a -> Builder) -> JSONBuilder a
JSONBuilder ((Scientific -> Builder) -> JSONBuilder Scientific)
-> (Scientific -> Builder) -> JSONBuilder Scientific
forall a b. (a -> b) -> a -> b
$ \Scientific
a -> Scientific -> Builder
scientificBuilder Scientific
a
  serializeNull :: JSONBuilder any
serializeNull = (any -> Builder) -> JSONBuilder any
forall a. (a -> Builder) -> JSONBuilder a
JSONBuilder ((any -> Builder) -> JSONBuilder any)
-> (any -> Builder) -> JSONBuilder any
forall a b. (a -> b) -> a -> b
$ Builder -> any -> Builder
forall a b. a -> b -> a
const Builder
"null"
  serializeBool :: JSONBuilder Bool
serializeBool = (Bool -> Builder) -> JSONBuilder Bool
forall a. (a -> Builder) -> JSONBuilder a
JSONBuilder ((Bool -> Builder) -> JSONBuilder Bool)
-> (Bool -> Builder) -> JSONBuilder Bool
forall a b. (a -> b) -> a -> b
$ \case
    Bool
True -> Builder
"true"
    Bool
False -> Builder
"false"
  serializeArray :: JSONBuilder [a]
serializeArray = ([a] -> Builder) -> JSONBuilder [a]
forall a. (a -> Builder) -> JSONBuilder a
JSONBuilder (([a] -> Builder) -> JSONBuilder [a])
-> ([a] -> Builder) -> JSONBuilder [a]
forall a b. (a -> b) -> a -> b
$ \[a]
array ->
    case (a -> CommaSep) -> [a] -> CommaSep
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Builder -> CommaSep
Written (Builder -> CommaSep) -> (a -> Builder) -> a -> CommaSep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONBuilder a -> a -> Builder
forall a. JSONBuilder a -> a -> Builder
runJSONBuilder JSONBuilder a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON) [a]
array of
      CommaSep
Empty -> Builder
"[]"
      Written Builder
n -> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"

-- | Serialize a Haskell datatype to a 'Builder'.
--
-- This is available for performance reasons: you may wish to use hPutBuilder
-- in order to (more or less) directly serialize some JSON object to a file handle.
toJSONAsBuilder :: (ToJSON a) => a -> Builder
toJSONAsBuilder :: a -> Builder
toJSONAsBuilder = JSONBuilder a -> a -> Builder
forall a. JSONBuilder a -> a -> Builder
runJSONBuilder JSONBuilder a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON

-- | Serialize a Haskell datatype to a lazy ByteString.
toJSONViaBuilder :: (ToJSON a) => a -> LBS.ByteString
toJSONViaBuilder :: a -> ByteString
toJSONViaBuilder = Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONBuilder a -> a -> Builder
forall a. JSONBuilder a -> a -> Builder
runJSONBuilder JSONBuilder a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON