graphql-engine/server/src-lib/Data/Aeson/Extended.hs
Brandon Simmons 6e8da71ece server: migrate to aeson-2 in preparation for ghc 9.2 upgrade
(Work here originally done by awjchen, rebased and fixed up for merge by
jberryman)

This is part of a merge train towards GHC 9.2 compatibility. The main
issue is the use of the new abstract `KeyMap` in 2.0. See:
https://hackage.haskell.org/package/aeson-2.0.3.0/changelog

Alex's original work is here:
#4305

BEHAVIOR CHANGE NOTE: This change causes a different arbitrary ordering
of serialized Json, for example during metadata export. CLI users care
about this in particular, and so we need to call it out as a _behavior
change_ as we did in v2.5.0. The good news though is that after this
change ordering should be more stable (alphabetical key order).

See: https://hasurahq.slack.com/archives/C01M20G1YRW/p1654012632634389

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4611
Co-authored-by: awjchen <13142944+awjchen@users.noreply.github.com>
GitOrigin-RevId: 700265162c782739b2bb88300ee3cda3819b2e87
2022-06-08 15:32:27 +00:00

67 lines
2.0 KiB
Haskell

module Data.Aeson.Extended
( FromJSONKeyValue (..),
ToJSONKeyValue (..),
FromJSONWithContext (..),
mapWithJSONPath,
encodeToStrictText,
(.=?),
-- * Re-exports
module Data.Aeson,
)
where
-------------------------------------------------------------------------------
import Data.Aeson
import Data.Aeson.Text (encodeToTextBuilder)
import Data.Aeson.Types (JSONPathElement (..), Parser)
import Data.Functor.Const (getConst)
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Hasura.Prelude
-------------------------------------------------------------------------------
class ToJSONKeyValue a where
toJSONKeyValue :: a -> (Key, Value)
class FromJSONKeyValue a where
parseJSONKeyValue :: (Key, Value) -> Parser a
instance ToJSONKeyValue Void where
toJSONKeyValue = absurd
instance ToJSONKeyValue a => ToJSONKeyValue (Const a b) where
toJSONKeyValue = toJSONKeyValue . getConst
-- | Similar to 'FromJSON', except the parser can also source data with which
-- to construct 'a' from a context 'ctx'.
--
-- This can be useful if the 'a' value contains some data that is not from the
-- current piece of JSON (the 'Value'). For example, some data from higher
-- up in the overall JSON graph, or from some system context.
class FromJSONWithContext ctx a | a -> ctx where
parseJSONWithContext :: ctx -> Value -> Parser a
-------------------------------------------------------------------------------
-- | An optional key-value pair for encoding a JSON object.
--
-- @
-- object $ ["foo" .= 0] <> catMaybes [ "bar" .=? Nothing, "baz" .=? 2 ]
-- @
(.=?) :: (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
(.=?) k = fmap (k .=)
{-# INLINE (.=?) #-}
infixr 8 .=?
-- | Map a 'Parser' over a list, keeping the JSONPath context
mapWithJSONPath :: (a -> Parser b) -> [a] -> Parser [b]
mapWithJSONPath parser xs =
traverse (\(idx, item) -> parser item <?> Index idx) $ zip [0 ..] xs
encodeToStrictText :: ToJSON a => a -> Text
encodeToStrictText = toStrict . toLazyText . encodeToTextBuilder