-- A module for representing encoded json
-- and efficient operations to construct them

module Hasura.EncJSON
  ( EncJSON,
    encJFromBuilder,
    encJToLBS,
    encJToBS,
    encJFromJValue,
    encJFromChar,
    encJFromText,
    encJFromNonEmptyText,
    encJFromBool,
    encJFromBS,
    encJFromLBS,
    encJFromList,
    encJFromAssocList,
    encJFromInsOrdHashMap,
    encJFromOrderedValue,
  )
where

import Data.Aeson qualified as J
import Data.Aeson.Encoding qualified as J
import Data.Aeson.Ordered qualified as JO
import Data.ByteString qualified as B
import Data.ByteString.Builder qualified as BB
import Data.ByteString.Lazy qualified as BL
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.Text.Encoding qualified as TE
import Data.Text.NonEmpty (NonEmptyText)
import Data.Text.NonEmpty qualified as NET
import Data.Vector qualified as V
import Hasura.Prelude

newtype EncJSON = EncJSON {EncJSON -> Builder
unEncJSON :: BB.Builder}

-- No instances for `EncJSON`. In particular, because:
--
-- - Having a `Semigroup` or `Monoid` instance allows constructing semantically
--   illegal values of type `EncJSON`. To drive this point home: the derived
--   `Semigroup` and `Monoid` instances always produce illegal JSON. It is
--   merely through an abuse of these APIs that legal JSON can be created.
--
-- - `IsString` would be a footgun because it's not clear what its expected
--   behavior is: does it construct serialized JSON from a serialized `String`,
--   or does it serialize a given `String` into a JSON-encoded string value?
--
-- - `Eq` would also be a footgun: does it compare two serialized values, or
--   does it compare values semantically?
--
-- - `Show`: unused.

encJToLBS :: EncJSON -> BL.ByteString
encJToLBS :: EncJSON -> ByteString
encJToLBS = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (EncJSON -> Builder) -> EncJSON -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncJSON -> Builder
unEncJSON
{-# INLINE encJToLBS #-}

encJToBS :: EncJSON -> B.ByteString
encJToBS :: EncJSON -> ByteString
encJToBS = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (EncJSON -> ByteString) -> EncJSON -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncJSON -> ByteString
encJToLBS
{-# INLINE encJToBS #-}

encJFromBuilder :: BB.Builder -> EncJSON
encJFromBuilder :: Builder -> EncJSON
encJFromBuilder = Builder -> EncJSON
EncJSON
{-# INLINE encJFromBuilder #-}

encJFromBS :: B.ByteString -> EncJSON
encJFromBS :: ByteString -> EncJSON
encJFromBS = Builder -> EncJSON
EncJSON (Builder -> EncJSON)
-> (ByteString -> Builder) -> ByteString -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BB.byteString
{-# INLINE encJFromBS #-}

encJFromLBS :: BL.ByteString -> EncJSON
encJFromLBS :: ByteString -> EncJSON
encJFromLBS = Builder -> EncJSON
EncJSON (Builder -> EncJSON)
-> (ByteString -> Builder) -> ByteString -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BB.lazyByteString
{-# INLINE encJFromLBS #-}

encJFromJValue :: J.ToJSON a => a -> EncJSON
encJFromJValue :: a -> EncJSON
encJFromJValue = Builder -> EncJSON
encJFromBuilder (Builder -> EncJSON) -> (a -> Builder) -> a -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding' Value -> Builder
forall tag. Encoding' tag -> Builder
J.fromEncoding (Encoding' Value -> Builder)
-> (a -> Encoding' Value) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding' Value
forall a. ToJSON a => a -> Encoding' Value
J.toEncoding
{-# INLINE encJFromJValue #-}

encJFromChar :: Char -> EncJSON
encJFromChar :: Char -> EncJSON
encJFromChar = Builder -> EncJSON
EncJSON (Builder -> EncJSON) -> (Char -> Builder) -> Char -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
BB.charUtf8
{-# INLINE encJFromChar #-}

encJFromText :: Text -> EncJSON
encJFromText :: Text -> EncJSON
encJFromText = Builder -> EncJSON
encJFromBuilder (Builder -> EncJSON) -> (Text -> Builder) -> Text -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TE.encodeUtf8Builder
{-# INLINE encJFromText #-}

encJFromNonEmptyText :: NonEmptyText -> EncJSON
encJFromNonEmptyText :: NonEmptyText -> EncJSON
encJFromNonEmptyText = Builder -> EncJSON
encJFromBuilder (Builder -> EncJSON)
-> (NonEmptyText -> Builder) -> NonEmptyText -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TE.encodeUtf8Builder (Text -> Builder)
-> (NonEmptyText -> Text) -> NonEmptyText -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> Text
NET.unNonEmptyText
{-# INLINE encJFromNonEmptyText #-}

encJFromBool :: Bool -> EncJSON
encJFromBool :: Bool -> EncJSON
encJFromBool = \case
  Bool
False -> Text -> EncJSON
encJFromText Text
"false"
  Bool
True -> Text -> EncJSON
encJFromText Text
"true"
{-# INLINE encJFromBool #-}

encJFromList :: [EncJSON] -> EncJSON
encJFromList :: [EncJSON] -> EncJSON
encJFromList =
  Builder -> EncJSON
encJFromBuilder (Builder -> EncJSON)
-> ([EncJSON] -> Builder) -> [EncJSON] -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    [] -> Builder
"[]"
    EncJSON
x : [EncJSON]
xs -> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> EncJSON -> Builder
unEncJSON EncJSON
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (EncJSON -> Builder -> Builder) -> Builder -> [EncJSON] -> Builder
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EncJSON -> Builder -> Builder
go Builder
"]" [EncJSON]
xs
      where
        go :: EncJSON -> Builder -> Builder
go EncJSON
v Builder
b = Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> EncJSON -> Builder
unEncJSON EncJSON
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b

-- from association list
encJFromAssocList :: [(Text, EncJSON)] -> EncJSON
encJFromAssocList :: [(Text, EncJSON)] -> EncJSON
encJFromAssocList =
  Builder -> EncJSON
encJFromBuilder (Builder -> EncJSON)
-> ([(Text, EncJSON)] -> Builder) -> [(Text, EncJSON)] -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    [] -> Builder
"{}"
    (Text, EncJSON)
x : [(Text, EncJSON)]
xs -> Builder
"{" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text, EncJSON) -> Builder
builder' (Text, EncJSON)
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Text, EncJSON) -> Builder -> Builder)
-> Builder -> [(Text, EncJSON)] -> Builder
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text, EncJSON) -> Builder -> Builder
go Builder
"}" [(Text, EncJSON)]
xs
      where
        go :: (Text, EncJSON) -> Builder -> Builder
go (Text, EncJSON)
v Builder
b = Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text, EncJSON) -> Builder
builder' (Text, EncJSON)
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b
        -- builds "key":value from (key,value)
        builder' :: (Text, EncJSON) -> Builder
builder' (Text
t, EncJSON
v) = Encoding' Any -> Builder
forall tag. Encoding' tag -> Builder
J.fromEncoding (Text -> Encoding' Any
forall a. Text -> Encoding' a
J.text Text
t) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> EncJSON -> Builder
unEncJSON EncJSON
v

encJFromInsOrdHashMap :: InsOrdHashMap Text EncJSON -> EncJSON
encJFromInsOrdHashMap :: InsOrdHashMap Text EncJSON -> EncJSON
encJFromInsOrdHashMap = [(Text, EncJSON)] -> EncJSON
encJFromAssocList ([(Text, EncJSON)] -> EncJSON)
-> (InsOrdHashMap Text EncJSON -> [(Text, EncJSON)])
-> InsOrdHashMap Text EncJSON
-> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsOrdHashMap Text EncJSON -> [(Text, EncJSON)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList

-- | Encode a 'JO.Value' as 'EncJSON'.
encJFromOrderedValue :: JO.Value -> EncJSON
encJFromOrderedValue :: Value -> EncJSON
encJFromOrderedValue = \case
  JO.Object Object
obj ->
    [(Text, EncJSON)] -> EncJSON
encJFromAssocList ([(Text, EncJSON)] -> EncJSON) -> [(Text, EncJSON)] -> EncJSON
forall a b. (a -> b) -> a -> b
$ (((Text, Value) -> (Text, EncJSON))
-> [(Text, Value)] -> [(Text, EncJSON)]
forall a b. (a -> b) -> [a] -> [b]
map (((Text, Value) -> (Text, EncJSON))
 -> [(Text, Value)] -> [(Text, EncJSON)])
-> ((Value -> EncJSON) -> (Text, Value) -> (Text, EncJSON))
-> (Value -> EncJSON)
-> [(Text, Value)]
-> [(Text, EncJSON)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> EncJSON) -> (Text, Value) -> (Text, EncJSON)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second) Value -> EncJSON
encJFromOrderedValue ([(Text, Value)] -> [(Text, EncJSON)])
-> [(Text, Value)] -> [(Text, EncJSON)]
forall a b. (a -> b) -> a -> b
$ Object -> [(Text, Value)]
JO.toList Object
obj
  JO.Array Array
vec ->
    [EncJSON] -> EncJSON
encJFromList ([EncJSON] -> EncJSON) -> [EncJSON] -> EncJSON
forall a b. (a -> b) -> a -> b
$ (Value -> EncJSON) -> [Value] -> [EncJSON]
forall a b. (a -> b) -> [a] -> [b]
map Value -> EncJSON
encJFromOrderedValue ([Value] -> [EncJSON]) -> [Value] -> [EncJSON]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
vec
  JO.String Text
s -> Text -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue Text
s
  JO.Number Scientific
sci -> Scientific -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue Scientific
sci
  JO.Bool Bool
b -> Bool -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue Bool
b
  Value
JO.Null -> Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue Value
J.Null