{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} 

module Data.BufferBuilder.Aeson () where

import GHC.Base
import GHC.Integer.GMP.Internals
import           Data.Aeson (Value (..))
import           Data.BufferBuilder.Json (ToJson (..), nullValue, unsafeAppendBS, unsafeAppendUtf8Builder)
import qualified Data.BufferBuilder.Json as Json
import qualified Data.BufferBuilder.Utf8 as Utf8Builder
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Builder.Scientific as BB
import qualified Data.Scientific as Scientific

#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (foldrWithKey)
import Data.Aeson.Key (toText)
#endif

-- TODO: this doesn't need to convert the bytestring to strict before appending it
-- there is an appendBSL
slowNumber :: Scientific.Scientific -> Json.Value
slowNumber :: Scientific -> Value
slowNumber Scientific
n = ByteString -> Value
unsafeAppendBS
                    (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict
                    (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString
                    (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> Builder
BB.formatScientificBuilder FPFormat
BB.Fixed Maybe Int
forall a. Maybe a
Nothing Scientific
n

instance ToJson Value where
    {-# INLINE toJson #-}
#if MIN_VERSION_aeson(2,0,0)
    toJson :: Value -> Value
toJson (Object Object
o) = ObjectBuilder -> Value
forall a. ToJson a => a -> Value
toJson (ObjectBuilder -> Value) -> ObjectBuilder -> Value
forall a b. (a -> b) -> a -> b
$ (Key -> Value -> ObjectBuilder -> ObjectBuilder)
-> ObjectBuilder -> Object -> ObjectBuilder
forall v a. (Key -> v -> a -> a) -> a -> KeyMap v -> a
foldrWithKey
                            (\Key
k Value
v ObjectBuilder
built -> (Key -> Text
toText Key
k Text -> Value -> ObjectBuilder
forall a. ToJson a => Text -> a -> ObjectBuilder
Json..= (Value -> Value
forall a. ToJson a => a -> Value
toJson Value
v)) ObjectBuilder -> ObjectBuilder -> ObjectBuilder
forall a. Semigroup a => a -> a -> a
<> ObjectBuilder
built)
                            ObjectBuilder
forall a. Monoid a => a
mempty
                            Object
o
#else
    toJson (Object o) = toJson o
#endif
    toJson (Array Array
a) = Array -> Value
forall a. ToJson a => a -> Value
toJson Array
a
    toJson (String Text
s) = Text -> Value
forall a. ToJson a => a -> Value
toJson Text
s
    toJson (Number Scientific
n) = case Scientific -> Integer
Scientific.coefficient Scientific
n of
        (S# Int#
smallcoeff) -> case Scientific -> Int
Scientific.base10Exponent Scientific
n of
            Int
0 -> Int -> Value
forall a. ToJson a => a -> Value
toJson (Int# -> Int
I# Int#
smallcoeff)
            Int
exp' -> Utf8Builder () -> Value
unsafeAppendUtf8Builder (Utf8Builder () -> Value) -> Utf8Builder () -> Value
forall a b. (a -> b) -> a -> b
$ do
                Int -> Utf8Builder ()
Utf8Builder.appendDecimalSignedInt (Int# -> Int
I# Int#
smallcoeff)
                Char -> Utf8Builder ()
Utf8Builder.appendChar7 Char
'e'
                Int -> Utf8Builder ()
Utf8Builder.appendDecimalSignedInt Int
exp'
        Integer
_ -> Scientific -> Value
slowNumber Scientific
n
    toJson (Bool Bool
b) = Bool -> Value
forall a. ToJson a => a -> Value
toJson Bool
b
    toJson Value
Null = Value
nullValue