graphql-engine/server/src-lib/Hasura/GraphQL/Parser/Internal/Convert.hs
Brandon Simmons b167120f96 server: add explicit export lists in OSS server and enforce with warning
We'll see if this improves compile times at all, but I think it's worth
doing as at least the most minimal form of module documentation.

This was accomplished by first compiling everything with
-ddump-minimal-imports, and then a bunch of scripting (with help from
ormolu)

**EDIT** it doesn't seem to improve CI compile times but the noise floor is high as it looks like we're not caching library dependencies anymore

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2730
GitOrigin-RevId: 667eb8de1e0f1af70420cbec90402922b8b84cb4
2021-11-04 16:09:38 +00:00

62 lines
2.2 KiB
Haskell

-- | 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.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 (M.toList vals) \(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