mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 21:12:09 +03:00
6e8da71ece
(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
66 lines
2.3 KiB
Haskell
66 lines
2.3 KiB
Haskell
{-# LANGUAGE ViewPatterns #-}
|
|
|
|
-- | This module defines all functions that convert between different
|
|
-- representations of values in the schema; most commonly: GraphQL literals,
|
|
-- JSON values, and 'InputValue', a type that provides an abstraction above both
|
|
-- of those.
|
|
module Hasura.GraphQL.Parser.Internal.Convert
|
|
( jsonToGraphQL,
|
|
valueToJSON,
|
|
)
|
|
where
|
|
|
|
import Data.Aeson qualified as A
|
|
import Data.Aeson.Key qualified as K
|
|
import Data.Aeson.KeyMap qualified as KM
|
|
import Data.HashMap.Strict.Extended qualified as M
|
|
import Data.Int (Int64)
|
|
import Data.Scientific (toBoundedInteger)
|
|
import Data.Text.Extended
|
|
import Hasura.GraphQL.Parser.Class.Parse
|
|
import Hasura.GraphQL.Parser.Internal.TypeChecking
|
|
import Hasura.GraphQL.Parser.Schema
|
|
import Hasura.Prelude
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
|
|
valueToJSON :: MonadParse m => G.GType -> InputValue Variable -> m A.Value
|
|
valueToJSON expectedType inputVal = do
|
|
peeledVal <- peelVariable expectedType inputVal
|
|
pure $ valueToJSON' peeledVal
|
|
where
|
|
valueToJSON' :: InputValue Variable -> A.Value
|
|
valueToJSON' = \case
|
|
JSONValue j -> j
|
|
GraphQLValue g -> graphQLToJSON g
|
|
|
|
graphQLToJSON :: G.Value Variable -> A.Value
|
|
graphQLToJSON = \case
|
|
G.VNull -> A.Null
|
|
G.VInt i -> A.toJSON i
|
|
G.VFloat f -> A.toJSON f
|
|
G.VString t -> A.toJSON t
|
|
G.VBoolean b -> A.toJSON b
|
|
G.VEnum (G.EnumValue n) -> A.toJSON n
|
|
G.VList values -> A.toJSON $ graphQLToJSON <$> values
|
|
G.VObject objects -> A.toJSON $ graphQLToJSON <$> objects
|
|
G.VVariable variable -> valueToJSON' $ absurd <$> vValue variable
|
|
|
|
jsonToGraphQL :: MonadError Text m => A.Value -> m (G.Value Void)
|
|
jsonToGraphQL = \case
|
|
A.Null -> pure G.VNull
|
|
A.Bool val -> pure $ G.VBoolean val
|
|
A.String val -> pure $ G.VString val
|
|
A.Number val -> case toBoundedInteger val of
|
|
Just intVal -> pure $ G.VInt $ fromIntegral @Int64 intVal
|
|
Nothing -> pure $ G.VFloat val
|
|
A.Array vals -> G.VList <$> traverse jsonToGraphQL (toList vals)
|
|
A.Object vals ->
|
|
G.VObject . M.fromList <$> for (KM.toList vals) \(K.toText -> key, val) -> do
|
|
graphQLName <-
|
|
G.mkName key
|
|
`onNothing` throwError
|
|
( "variable value contains an object with key "
|
|
<> key <<> ", which is not a legal GraphQL name"
|
|
)
|
|
(graphQLName,) <$> jsonToGraphQL val
|