mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-15 17:31:56 +03:00
6f6177db38
I didn't track why these were left behind. Presumably GHC 9.2 has an improved redundant constraint checker, so that explains a few. Otherwise, perhaps code got refactored along the way. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6256 GitOrigin-RevId: b6275edf3e867f8e33bdec533ce9932381d36bbb
57 lines
2.1 KiB
Haskell
57 lines
2.1 KiB
Haskell
-- | This module contains functions to help with making assertions on the result
|
|
-- of parser introspection queries.
|
|
module Hasura.GraphQL.Schema.Introspection
|
|
( queryInputFieldsParserIntrospection,
|
|
)
|
|
where
|
|
|
|
import Data.Aeson qualified as A
|
|
import Data.Aeson.Ordered qualified as AO
|
|
import Data.Text qualified as T
|
|
import Hasura.Backends.Postgres.Instances.Schema ()
|
|
import Hasura.Base.ErrorMessage
|
|
import Hasura.Base.ToErrorValue (ToErrorValue (toErrorValue))
|
|
import Hasura.GraphQL.Parser.Name qualified as GName
|
|
import Hasura.GraphQL.Schema.Introspect qualified as I
|
|
import Hasura.GraphQL.Schema.Parser qualified as P
|
|
import Hasura.Prelude
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
import Test.Parser.Monad
|
|
|
|
-- | Produce an introspection parser for an 'InputFieldsParser'.
|
|
-- Use the "Test.Parser.Field.field" quasi-quoter to construct the introspection query.
|
|
queryInputFieldsParserIntrospection ::
|
|
forall n a.
|
|
-- | The Parser to introspect
|
|
P.InputFieldsParser n a ->
|
|
-- | The Introspection query
|
|
G.Field G.NoFragments P.Variable ->
|
|
IO A.Value
|
|
queryInputFieldsParserIntrospection parser field = do
|
|
introspectionParser <- introspectDefintions (P.ifDefinitions parser)
|
|
runParserTest $ P.fParser introspectionParser field
|
|
|
|
introspectDefintions ::
|
|
forall n a.
|
|
(P.HasTypeDefinitions a, P.MonadParse n) =>
|
|
a ->
|
|
IO (P.FieldParser n A.Value)
|
|
introspectDefintions definitions = do
|
|
let introParser :: Either P.ConflictingDefinitions (P.FieldParser n A.Value) = do
|
|
types <- P.collectTypeDefinitions [P.TypeDefinitionsWrapper definitions]
|
|
let schema =
|
|
P.Schema
|
|
{ sDescription = Nothing,
|
|
sTypes = types,
|
|
sQueryType =
|
|
P.TNamed
|
|
P.NonNullable
|
|
$ P.Definition GName._String Nothing Nothing [] (P.TIObject (P.ObjectInfo [] [])),
|
|
sMutationType = Nothing,
|
|
sSubscriptionType = Nothing,
|
|
sDirectives = []
|
|
}
|
|
return $ (AO.fromOrdered . ($ schema)) <$> I.schema @n
|
|
|
|
onLeft introParser (error . T.unpack . fromErrorMessage . toErrorValue)
|