graphql-engine/server/src-lib/Hasura/EncJSON.hs
Robert 11a454c2d6 server, pro: actually reformat the code-base using ormolu
This commit applies ormolu to the whole Haskell code base by running `make format`.

For in-flight branches, simply merging changes from `main` will result in merge conflicts.
To avoid this, update your branch using the following instructions. Replace `<format-commit>`
by the hash of *this* commit.

$ git checkout my-feature-branch
$ git merge <format-commit>^    # and resolve conflicts normally
$ make format
$ git commit -a -m "reformat with ormolu"
$ git merge -s ours post-ormolu

https://github.com/hasura/graphql-engine-mono/pull/2404

GitOrigin-RevId: 75049f5c12f430c615eafb4c6b8e83e371e01c8e
2021-09-23 22:57:37 +00:00

119 lines
3.2 KiB
Haskell

-- A module for representing encoded json
-- and efficient operations to construct them
module Hasura.EncJSON
( EncJSON,
encJFromBuilder,
encJToLBS,
encJToBS,
encJFromJValue,
encJFromChar,
encJFromText,
encJFromBS,
encJFromLBS,
encJFromList,
encJFromAssocList,
encJFromInsOrdHashMap,
encJFromOrderedValue,
)
where
import Data.Aeson 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.Vector qualified as V
import Database.PG.Query qualified as Q
import Hasura.Prelude
-- encoded json
-- TODO (from master): can be improved with gadts capturing bytestring, lazybytestring
-- and builder
newtype EncJSON = EncJSON {unEncJSON :: BB.Builder}
deriving (Semigroup, Monoid, IsString)
instance Show EncJSON where
showsPrec d x =
showParen (d > 10) $
showString "encJFromBS " . showsPrec 11 (encJToLBS x)
instance Eq EncJSON where
(==) = (==) `on` encJToLBS
instance Q.FromCol EncJSON where
fromCol = fmap encJFromBS . Q.fromCol
encJToLBS :: EncJSON -> BL.ByteString
encJToLBS = BB.toLazyByteString . unEncJSON
{-# INLINE encJToLBS #-}
encJToBS :: EncJSON -> B.ByteString
encJToBS = BL.toStrict . encJToLBS
{-# INLINE encJToBS #-}
encJFromBuilder :: BB.Builder -> EncJSON
encJFromBuilder = EncJSON
{-# INLINE encJFromBuilder #-}
encJFromBS :: B.ByteString -> EncJSON
encJFromBS = EncJSON . BB.byteString
{-# INLINE encJFromBS #-}
encJFromLBS :: BL.ByteString -> EncJSON
encJFromLBS = EncJSON . BB.lazyByteString
{-# INLINE encJFromLBS #-}
encJFromJValue :: J.ToJSON a => a -> EncJSON
encJFromJValue = encJFromBuilder . J.fromEncoding . J.toEncoding
{-# INLINE encJFromJValue #-}
encJFromChar :: Char -> EncJSON
encJFromChar = EncJSON . BB.charUtf8
{-# INLINE encJFromChar #-}
encJFromText :: Text -> EncJSON
encJFromText = encJFromBS . TE.encodeUtf8
{-# INLINE encJFromText #-}
encJFromList :: [EncJSON] -> EncJSON
encJFromList = \case
[] -> "[]"
x : xs ->
encJFromChar '['
<> x
<> foldr go (encJFromChar ']') xs
where
go v b = encJFromChar ',' <> v <> b
-- from association list
encJFromAssocList :: [(Text, EncJSON)] -> EncJSON
encJFromAssocList = \case
[] -> "{}"
x : xs ->
encJFromChar '{'
<> builder' x
<> foldr go (encJFromChar '}') xs
where
go v b = encJFromChar ',' <> builder' v <> b
-- builds "key":value from (key,value)
builder' (t, v) =
encJFromChar '"' <> encJFromText t <> encJFromText "\":" <> v
encJFromInsOrdHashMap :: InsOrdHashMap Text EncJSON -> EncJSON
encJFromInsOrdHashMap = encJFromAssocList . OMap.toList
-- | Encode a 'JO.Value' as 'EncJSON'.
encJFromOrderedValue :: JO.Value -> EncJSON
encJFromOrderedValue = \case
JO.Object obj ->
encJFromAssocList $ (map . second) encJFromOrderedValue $ JO.toList obj
JO.Array vec ->
encJFromList $ map encJFromOrderedValue $ V.toList vec
JO.String s -> encJFromJValue s
JO.Number sci -> encJFromJValue sci
JO.Bool b -> encJFromJValue b
JO.Null -> encJFromJValue J.Null