{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.App.RenderIntrospection ( render, createObjectType, WithSchema, ) where import Control.Monad.Except (MonadError (throwError)) import Data.Morpheus.App.Internal.Resolving.Resolver ( Resolver, ResolverContext (..), unsafeInternalContext, ) import Data.Morpheus.App.Internal.Resolving.Types ( ResolverValue, mkBoolean, mkList, mkNull, mkObject, mkString, ) import qualified Data.Morpheus.Core as GQL import Data.Morpheus.Internal.Utils ( fromLBS, selectBy, ) import Data.Morpheus.Types.Internal.AST ( ANY, ArgumentDefinition (..), ArgumentsDefinition, DataEnumValue (..), Description, DirectiveDefinition (..), DirectiveLocation, Directives, FieldContent (..), FieldDefinition (..), FieldName, FieldsDefinition, GQLError, IN, Msg (msg), OUT, QUERY, Schema, TRUE, TypeContent (..), TypeDefinition (..), TypeKind (..), TypeName, TypeRef (..), TypeWrapper (BaseType, TypeList), UnionMember (..), VALID, Value (..), fieldVisibility, internal, kindOf, lookupDeprecated, lookupDeprecatedReason, mkInputUnionFields, msg, possibleInterfaceTypes, typeDefinitions, unpackName, ) import Data.Text (pack) import Relude class ( Monad m, MonadError GQLError m ) => WithSchema m where getSchema :: m (Schema VALID) instance Monad m => WithSchema (Resolver QUERY e m) where getSchema :: Resolver QUERY e m (Schema VALID) getSchema = ResolverContext -> Schema VALID schema (ResolverContext -> Schema VALID) -> Resolver QUERY e m ResolverContext -> Resolver QUERY e m (Schema VALID) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Resolver QUERY e m ResolverContext forall (m :: * -> *) (o :: OperationType) e. (Monad m, LiftOperation o) => Resolver o e m ResolverContext unsafeInternalContext selectType :: WithSchema m => TypeName -> m (TypeDefinition ANY VALID) selectType :: TypeName -> m (TypeDefinition ANY VALID) selectType TypeName name = m (Schema VALID) forall (m :: * -> *). WithSchema m => m (Schema VALID) getSchema m (Schema VALID) -> (Schema VALID -> m (TypeDefinition ANY VALID)) -> m (TypeDefinition ANY VALID) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= GQLError -> TypeName -> HashMap TypeName (TypeDefinition ANY VALID) -> m (TypeDefinition ANY VALID) forall e (m :: * -> *) k (c :: * -> *) a. (MonadError e m, IsMap k c, Monad m) => e -> k -> c a -> m a selectBy (GQLError -> GQLError internal (GQLError -> GQLError) -> GQLError -> GQLError forall a b. (a -> b) -> a -> b $ GQLError "INTROSPECTION Type not Found: \"" GQLError -> GQLError -> GQLError forall a. Semigroup a => a -> a -> a <> TypeName -> GQLError forall a. Msg a => a -> GQLError msg TypeName name GQLError -> GQLError -> GQLError forall a. Semigroup a => a -> a -> a <> GQLError "\"") TypeName name (HashMap TypeName (TypeDefinition ANY VALID) -> m (TypeDefinition ANY VALID)) -> (Schema VALID -> HashMap TypeName (TypeDefinition ANY VALID)) -> Schema VALID -> m (TypeDefinition ANY VALID) forall b c a. (b -> c) -> (a -> b) -> a -> c . Schema VALID -> HashMap TypeName (TypeDefinition ANY VALID) forall (s :: Stage). Schema s -> HashMap TypeName (TypeDefinition ANY s) typeDefinitions class RenderIntrospection a where render :: (Monad m, WithSchema m) => a -> m (ResolverValue m) instance RenderIntrospection TypeName where render :: TypeName -> m (ResolverValue m) render = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> (TypeName -> ResolverValue m) -> TypeName -> m (ResolverValue m) forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> ResolverValue m forall (m :: * -> *). Text -> ResolverValue m mkString (Text -> ResolverValue m) -> (TypeName -> Text) -> TypeName -> ResolverValue m forall b c a. (b -> c) -> (a -> b) -> a -> c . TypeName -> Text forall a (t :: NAME). NamePacking a => Name t -> a unpackName instance RenderIntrospection FieldName where render :: FieldName -> m (ResolverValue m) render = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> (FieldName -> ResolverValue m) -> FieldName -> m (ResolverValue m) forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> ResolverValue m forall (m :: * -> *). Text -> ResolverValue m mkString (Text -> ResolverValue m) -> (FieldName -> Text) -> FieldName -> ResolverValue m forall b c a. (b -> c) -> (a -> b) -> a -> c . FieldName -> Text forall a (t :: NAME). NamePacking a => Name t -> a unpackName instance RenderIntrospection Description where render :: Text -> m (ResolverValue m) render = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> (Text -> ResolverValue m) -> Text -> m (ResolverValue m) forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> ResolverValue m forall (m :: * -> *). Text -> ResolverValue m mkString instance RenderIntrospection a => RenderIntrospection [a] where render :: [a] -> m (ResolverValue m) render [a] ls = [ResolverValue m] -> ResolverValue m forall (m :: * -> *). [ResolverValue m] -> ResolverValue m mkList ([ResolverValue m] -> ResolverValue m) -> m [ResolverValue m] -> m (ResolverValue m) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (a -> m (ResolverValue m)) -> [a] -> m [ResolverValue m] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse a -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render [a] ls instance RenderIntrospection a => RenderIntrospection (Maybe a) where render :: Maybe a -> m (ResolverValue m) render (Just a value) = a -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render a value render Maybe a Nothing = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure ResolverValue m forall (m :: * -> *). ResolverValue m mkNull instance RenderIntrospection Bool where render :: Bool -> m (ResolverValue m) render = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> (Bool -> ResolverValue m) -> Bool -> m (ResolverValue m) forall b c a. (b -> c) -> (a -> b) -> a -> c . Bool -> ResolverValue m forall (m :: * -> *). Bool -> ResolverValue m mkBoolean instance RenderIntrospection TypeKind where render :: TypeKind -> m (ResolverValue m) render = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> (TypeKind -> ResolverValue m) -> TypeKind -> m (ResolverValue m) forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> ResolverValue m forall (m :: * -> *). Text -> ResolverValue m mkString (Text -> ResolverValue m) -> (TypeKind -> Text) -> TypeKind -> ResolverValue m forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Text fromLBS (ByteString -> Text) -> (TypeKind -> ByteString) -> TypeKind -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . TypeKind -> ByteString forall a. RenderGQL a => a -> ByteString GQL.render instance RenderIntrospection (DirectiveDefinition VALID) where render :: DirectiveDefinition VALID -> m (ResolverValue m) render DirectiveDefinition { FieldName directiveDefinitionName :: forall (s :: Stage). DirectiveDefinition s -> FieldName directiveDefinitionName :: FieldName directiveDefinitionName, Maybe Text directiveDefinitionDescription :: forall (s :: Stage). DirectiveDefinition s -> Maybe Text directiveDefinitionDescription :: Maybe Text directiveDefinitionDescription, [DirectiveLocation] directiveDefinitionLocations :: forall (s :: Stage). DirectiveDefinition s -> [DirectiveLocation] directiveDefinitionLocations :: [DirectiveLocation] directiveDefinitionLocations, ArgumentsDefinition VALID directiveDefinitionArgs :: forall (s :: Stage). DirectiveDefinition s -> ArgumentsDefinition s directiveDefinitionArgs :: ArgumentsDefinition VALID directiveDefinitionArgs } = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> ResolverValue m -> m (ResolverValue m) forall a b. (a -> b) -> a -> b $ TypeName -> [ResolverEntry m] -> ResolverValue m forall (m :: * -> *). TypeName -> [ResolverEntry m] -> ResolverValue m mkObject TypeName "__Directive" [ FieldName -> ResolverEntry m forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => name -> (FieldName, m (ResolverValue m)) renderName FieldName directiveDefinitionName, Maybe Text -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => Maybe Text -> (FieldName, m (ResolverValue m)) description Maybe Text directiveDefinitionDescription, (FieldName "locations", [DirectiveLocation] -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render [DirectiveLocation] directiveDefinitionLocations), (FieldName "args", ArgumentsDefinition VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render ArgumentsDefinition VALID directiveDefinitionArgs) ] instance RenderIntrospection DirectiveLocation where render :: DirectiveLocation -> m (ResolverValue m) render DirectiveLocation locations = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> ResolverValue m -> m (ResolverValue m) forall a b. (a -> b) -> a -> b $ Text -> ResolverValue m forall (m :: * -> *). Text -> ResolverValue m mkString (String -> Text pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ DirectiveLocation -> String forall b a. (Show a, IsString b) => a -> b show DirectiveLocation locations) instance RenderIntrospection (TypeDefinition cat VALID) where render :: TypeDefinition cat VALID -> m (ResolverValue m) render TypeDefinition { TypeName typeName :: forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> TypeName typeName :: TypeName typeName, Maybe Text typeDescription :: forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> Maybe Text typeDescription :: Maybe Text typeDescription, TypeContent TRUE cat VALID typeContent :: forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> TypeContent TRUE a s typeContent :: TypeContent TRUE cat VALID typeContent } = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> ResolverValue m -> m (ResolverValue m) forall a b. (a -> b) -> a -> b $ TypeContent TRUE cat VALID -> ResolverValue m forall (m :: * -> *) (bool :: Bool) (a :: TypeCategory). (Monad m, WithSchema m) => TypeContent bool a VALID -> ResolverValue m renderContent TypeContent TRUE cat VALID typeContent where __type :: ( Monad m, WithSchema m ) => TypeKind -> [(FieldName, m (ResolverValue m))] -> ResolverValue m __type :: TypeKind -> [(FieldName, m (ResolverValue m))] -> ResolverValue m __type TypeKind kind = TypeKind -> TypeName -> Maybe Text -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => TypeKind -> name -> Maybe Text -> [(FieldName, m (ResolverValue m))] -> ResolverValue m mkType TypeKind kind TypeName typeName Maybe Text typeDescription renderContent :: ( Monad m, WithSchema m ) => TypeContent bool a VALID -> ResolverValue m renderContent :: TypeContent bool a VALID -> ResolverValue m renderContent DataScalar {} = TypeKind -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall (m :: * -> *). (Monad m, WithSchema m) => TypeKind -> [(FieldName, m (ResolverValue m))] -> ResolverValue m __type TypeKind KindScalar [] renderContent (DataEnum DataEnum VALID enums) = TypeKind -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall (m :: * -> *). (Monad m, WithSchema m) => TypeKind -> [(FieldName, m (ResolverValue m))] -> ResolverValue m __type TypeKind KindEnum [(FieldName "enumValues", DataEnum VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render DataEnum VALID enums)] renderContent (DataInputObject FieldsDefinition IN VALID inputFields) = TypeKind -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall (m :: * -> *). (Monad m, WithSchema m) => TypeKind -> [(FieldName, m (ResolverValue m))] -> ResolverValue m __type TypeKind KindInputObject [(FieldName "inputFields", FieldsDefinition IN VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render FieldsDefinition IN VALID inputFields)] renderContent DataObject {[TypeName] objectImplements :: forall (a :: TypeCategory) (s :: Stage). CondTypeContent OBJECT a s -> [TypeName] objectImplements :: [TypeName] objectImplements, FieldsDefinition OUT VALID objectFields :: forall (a :: TypeCategory) (s :: Stage). CondTypeContent OBJECT a s -> FieldsDefinition OUT s objectFields :: FieldsDefinition OUT VALID objectFields} = TypeName -> Maybe Text -> [TypeName] -> FieldsDefinition OUT VALID -> ResolverValue m forall (m :: * -> *). (Monad m, WithSchema m) => TypeName -> Maybe Text -> [TypeName] -> FieldsDefinition OUT VALID -> ResolverValue m createObjectType TypeName typeName Maybe Text typeDescription [TypeName] objectImplements FieldsDefinition OUT VALID objectFields renderContent (DataUnion UnionTypeDefinition OUT VALID union) = TypeKind -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall (m :: * -> *). (Monad m, WithSchema m) => TypeKind -> [(FieldName, m (ResolverValue m))] -> ResolverValue m __type TypeKind KindUnion [(FieldName "possibleTypes", [UnionMember OUT VALID] -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render ([UnionMember OUT VALID] -> m (ResolverValue m)) -> [UnionMember OUT VALID] -> m (ResolverValue m) forall a b. (a -> b) -> a -> b $ UnionTypeDefinition OUT VALID -> [UnionMember OUT VALID] forall (t :: * -> *) a. Foldable t => t a -> [a] toList UnionTypeDefinition OUT VALID union)] renderContent (DataInputUnion UnionTypeDefinition IN VALID members) = TypeKind -> TypeName -> Maybe Text -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => TypeKind -> name -> Maybe Text -> [(FieldName, m (ResolverValue m))] -> ResolverValue m mkType TypeKind KindInputObject TypeName typeName ( Text -> Maybe Text forall a. a -> Maybe a Just ( Text "Note! This input is an exclusive object,\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "i.e., the customer can provide a value for only one field." ) Maybe Text -> Maybe Text -> Maybe Text forall a. Semigroup a => a -> a -> a <> Maybe Text typeDescription ) [ ( FieldName "inputFields", FieldsDefinition IN VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render (UnionTypeDefinition IN VALID -> FieldsDefinition IN VALID forall (t :: * -> *) (s :: Stage). Foldable t => t (UnionMember IN s) -> FieldsDefinition IN s mkInputUnionFields UnionTypeDefinition IN VALID members) ) ] renderContent (DataInterface FieldsDefinition OUT VALID fields) = TypeKind -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall (m :: * -> *). (Monad m, WithSchema m) => TypeKind -> [(FieldName, m (ResolverValue m))] -> ResolverValue m __type TypeKind KindInterface [ (FieldName "fields", FieldsDefinition OUT VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render FieldsDefinition OUT VALID fields), (FieldName "possibleTypes", TypeName -> m (ResolverValue m) forall (m :: * -> *). (Monad m, WithSchema m) => TypeName -> m (ResolverValue m) renderPossibleTypes TypeName typeName) ] instance RenderIntrospection (UnionMember OUT s) where render :: UnionMember OUT s -> m (ResolverValue m) render UnionMember {TypeName memberName :: forall (cat :: TypeCategory) (s :: Stage). UnionMember cat s -> TypeName memberName :: TypeName memberName} = TypeName -> m (TypeDefinition ANY VALID) forall (m :: * -> *). WithSchema m => TypeName -> m (TypeDefinition ANY VALID) selectType TypeName memberName m (TypeDefinition ANY VALID) -> (TypeDefinition ANY VALID -> m (ResolverValue m)) -> m (ResolverValue m) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= TypeDefinition ANY VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render instance RenderIntrospection (FieldDefinition cat s) => RenderIntrospection (FieldsDefinition cat s) where render :: FieldsDefinition cat s -> m (ResolverValue m) render = [FieldDefinition cat s] -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render ([FieldDefinition cat s] -> m (ResolverValue m)) -> (FieldsDefinition cat s -> [FieldDefinition cat s]) -> FieldsDefinition cat s -> m (ResolverValue m) forall b c a. (b -> c) -> (a -> b) -> a -> c . (FieldDefinition cat s -> Bool) -> [FieldDefinition cat s] -> [FieldDefinition cat s] forall a. (a -> Bool) -> [a] -> [a] filter FieldDefinition cat s -> Bool forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> Bool fieldVisibility ([FieldDefinition cat s] -> [FieldDefinition cat s]) -> (FieldsDefinition cat s -> [FieldDefinition cat s]) -> FieldsDefinition cat s -> [FieldDefinition cat s] forall b c a. (b -> c) -> (a -> b) -> a -> c . FieldsDefinition cat s -> [FieldDefinition cat s] forall (t :: * -> *) a. Foldable t => t a -> [a] toList instance RenderIntrospection (FieldContent TRUE IN VALID) where render :: FieldContent TRUE IN VALID -> m (ResolverValue m) render = Value VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render (Value VALID -> m (ResolverValue m)) -> (FieldContent TRUE IN VALID -> Value VALID) -> FieldContent TRUE IN VALID -> m (ResolverValue m) forall b c a. (b -> c) -> (a -> b) -> a -> c . FieldContent TRUE IN VALID -> Value VALID forall (cat :: TypeCategory) (s :: Stage). FieldContent (IN <=? cat) cat s -> Value s defaultInputValue instance RenderIntrospection (Value VALID) where render :: Value VALID -> m (ResolverValue m) render Value VALID Null = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure ResolverValue m forall (m :: * -> *). ResolverValue m mkNull render Value VALID x = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> ResolverValue m -> m (ResolverValue m) forall a b. (a -> b) -> a -> b $ Text -> ResolverValue m forall (m :: * -> *). Text -> ResolverValue m mkString (Text -> ResolverValue m) -> Text -> ResolverValue m forall a b. (a -> b) -> a -> b $ ByteString -> Text fromLBS (ByteString -> Text) -> ByteString -> Text forall a b. (a -> b) -> a -> b $ Value VALID -> ByteString forall a. RenderGQL a => a -> ByteString GQL.render Value VALID x instance RenderIntrospection (FieldDefinition OUT VALID) where render :: FieldDefinition OUT VALID -> m (ResolverValue m) render FieldDefinition {Maybe Text Maybe (FieldContent TRUE OUT VALID) TypeRef FieldName Directives VALID fieldDescription :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> Maybe Text fieldName :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> FieldName fieldType :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> TypeRef fieldContent :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> Maybe (FieldContent TRUE cat s) fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> Directives s fieldDirectives :: Directives VALID fieldContent :: Maybe (FieldContent TRUE OUT VALID) fieldType :: TypeRef fieldName :: FieldName fieldDescription :: Maybe Text ..} = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> ResolverValue m -> m (ResolverValue m) forall a b. (a -> b) -> a -> b $ TypeName -> [ResolverEntry m] -> ResolverValue m forall (m :: * -> *). TypeName -> [ResolverEntry m] -> ResolverValue m mkObject TypeName "__Field" ([ResolverEntry m] -> ResolverValue m) -> [ResolverEntry m] -> ResolverValue m forall a b. (a -> b) -> a -> b $ [ FieldName -> ResolverEntry m forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => name -> (FieldName, m (ResolverValue m)) renderName FieldName fieldName, Maybe Text -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => Maybe Text -> (FieldName, m (ResolverValue m)) description Maybe Text fieldDescription, TypeRef -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => TypeRef -> (FieldName, m (ResolverValue m)) type' TypeRef fieldType, (FieldName "args", m (ResolverValue m) -> (FieldContent TRUE OUT VALID -> m (ResolverValue m)) -> Maybe (FieldContent TRUE OUT VALID) -> m (ResolverValue m) forall b a. b -> (a -> b) -> Maybe a -> b maybe (ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> ResolverValue m -> m (ResolverValue m) forall a b. (a -> b) -> a -> b $ [ResolverValue m] -> ResolverValue m forall (m :: * -> *). [ResolverValue m] -> ResolverValue m mkList []) FieldContent TRUE OUT VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render Maybe (FieldContent TRUE OUT VALID) fieldContent) ] [ResolverEntry m] -> [ResolverEntry m] -> [ResolverEntry m] forall a. Semigroup a => a -> a -> a <> Directives VALID -> [ResolverEntry m] forall (m :: * -> *) (s :: Stage). (Monad m, WithSchema m) => Directives s -> [(FieldName, m (ResolverValue m))] renderDeprecated Directives VALID fieldDirectives instance RenderIntrospection (FieldContent TRUE OUT VALID) where render :: FieldContent TRUE OUT VALID -> m (ResolverValue m) render (FieldArgs ArgumentsDefinition VALID args) = ArgumentsDefinition VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render ArgumentsDefinition VALID args instance RenderIntrospection (ArgumentsDefinition VALID) where render :: ArgumentsDefinition VALID -> m (ResolverValue m) render = ([ResolverValue m] -> ResolverValue m) -> m [ResolverValue m] -> m (ResolverValue m) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap [ResolverValue m] -> ResolverValue m forall (m :: * -> *). [ResolverValue m] -> ResolverValue m mkList (m [ResolverValue m] -> m (ResolverValue m)) -> (ArgumentsDefinition VALID -> m [ResolverValue m]) -> ArgumentsDefinition VALID -> m (ResolverValue m) forall b c a. (b -> c) -> (a -> b) -> a -> c . (ArgumentDefinition VALID -> m (ResolverValue m)) -> [ArgumentDefinition VALID] -> m [ResolverValue m] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (FieldDefinition IN VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render (FieldDefinition IN VALID -> m (ResolverValue m)) -> (ArgumentDefinition VALID -> FieldDefinition IN VALID) -> ArgumentDefinition VALID -> m (ResolverValue m) forall b c a. (b -> c) -> (a -> b) -> a -> c . ArgumentDefinition VALID -> FieldDefinition IN VALID forall (s :: Stage). ArgumentDefinition s -> FieldDefinition IN s argument) ([ArgumentDefinition VALID] -> m [ResolverValue m]) -> (ArgumentsDefinition VALID -> [ArgumentDefinition VALID]) -> ArgumentsDefinition VALID -> m [ResolverValue m] forall b c a. (b -> c) -> (a -> b) -> a -> c . ArgumentsDefinition VALID -> [ArgumentDefinition VALID] forall (t :: * -> *) a. Foldable t => t a -> [a] toList instance RenderIntrospection (FieldDefinition IN VALID) where render :: FieldDefinition IN VALID -> m (ResolverValue m) render FieldDefinition {Maybe Text Maybe (FieldContent TRUE IN VALID) TypeRef FieldName Directives VALID fieldDirectives :: Directives VALID fieldContent :: Maybe (FieldContent TRUE IN VALID) fieldType :: TypeRef fieldName :: FieldName fieldDescription :: Maybe Text fieldDescription :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> Maybe Text fieldName :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> FieldName fieldType :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> TypeRef fieldContent :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> Maybe (FieldContent TRUE cat s) fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> Directives s ..} = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> ResolverValue m -> m (ResolverValue m) forall a b. (a -> b) -> a -> b $ TypeName -> [ResolverEntry m] -> ResolverValue m forall (m :: * -> *). TypeName -> [ResolverEntry m] -> ResolverValue m mkObject TypeName "__InputValue" [ FieldName -> ResolverEntry m forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => name -> (FieldName, m (ResolverValue m)) renderName FieldName fieldName, Maybe Text -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => Maybe Text -> (FieldName, m (ResolverValue m)) description Maybe Text fieldDescription, TypeRef -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => TypeRef -> (FieldName, m (ResolverValue m)) type' TypeRef fieldType, Maybe (FieldContent TRUE IN VALID) -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => Maybe (FieldContent TRUE IN VALID) -> (FieldName, m (ResolverValue m)) defaultValue Maybe (FieldContent TRUE IN VALID) fieldContent ] instance RenderIntrospection (DataEnumValue VALID) where render :: DataEnumValue VALID -> m (ResolverValue m) render DataEnumValue {TypeName enumName :: forall (s :: Stage). DataEnumValue s -> TypeName enumName :: TypeName enumName, Maybe Text enumDescription :: forall (s :: Stage). DataEnumValue s -> Maybe Text enumDescription :: Maybe Text enumDescription, Directives VALID enumDirectives :: forall (s :: Stage). DataEnumValue s -> Directives s enumDirectives :: Directives VALID enumDirectives} = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> ResolverValue m -> m (ResolverValue m) forall a b. (a -> b) -> a -> b $ TypeName -> [ResolverEntry m] -> ResolverValue m forall (m :: * -> *). TypeName -> [ResolverEntry m] -> ResolverValue m mkObject TypeName "__Field" ([ResolverEntry m] -> ResolverValue m) -> [ResolverEntry m] -> ResolverValue m forall a b. (a -> b) -> a -> b $ [ TypeName -> ResolverEntry m forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => name -> (FieldName, m (ResolverValue m)) renderName TypeName enumName, Maybe Text -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => Maybe Text -> (FieldName, m (ResolverValue m)) description Maybe Text enumDescription ] [ResolverEntry m] -> [ResolverEntry m] -> [ResolverEntry m] forall a. Semigroup a => a -> a -> a <> Directives VALID -> [ResolverEntry m] forall (m :: * -> *) (s :: Stage). (Monad m, WithSchema m) => Directives s -> [(FieldName, m (ResolverValue m))] renderDeprecated Directives VALID enumDirectives instance RenderIntrospection TypeRef where render :: TypeRef -> m (ResolverValue m) render TypeRef {TypeName typeConName :: TypeRef -> TypeName typeConName :: TypeName typeConName, TypeWrapper typeWrappers :: TypeRef -> TypeWrapper typeWrappers :: TypeWrapper typeWrappers} = TypeWrapper -> m (ResolverValue m) forall (m :: * -> *). (Monad m, WithSchema m) => TypeWrapper -> m (ResolverValue m) renderWrapper TypeWrapper typeWrappers where renderWrapper :: (Monad m, WithSchema m) => TypeWrapper -> m (ResolverValue m) renderWrapper :: TypeWrapper -> m (ResolverValue m) renderWrapper (TypeList TypeWrapper nextWrapper Bool isNonNull) = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> ResolverValue m -> m (ResolverValue m) forall a b. (a -> b) -> a -> b $ Bool -> ResolverValue m -> ResolverValue m forall (m :: * -> *). (Monad m, WithSchema m) => Bool -> ResolverValue m -> ResolverValue m withNonNull Bool isNonNull (ResolverValue m -> ResolverValue m) -> ResolverValue m -> ResolverValue m forall a b. (a -> b) -> a -> b $ TypeName -> [ResolverEntry m] -> ResolverValue m forall (m :: * -> *). TypeName -> [ResolverEntry m] -> ResolverValue m mkObject TypeName "__Type" [ TypeKind -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => TypeKind -> (FieldName, m (ResolverValue m)) renderKind TypeKind KindList, (FieldName "ofType", TypeWrapper -> m (ResolverValue m) forall (m :: * -> *). (Monad m, WithSchema m) => TypeWrapper -> m (ResolverValue m) renderWrapper TypeWrapper nextWrapper) ] renderWrapper (BaseType Bool isNonNull) = Bool -> ResolverValue m -> ResolverValue m forall (m :: * -> *). (Monad m, WithSchema m) => Bool -> ResolverValue m -> ResolverValue m withNonNull Bool isNonNull (ResolverValue m -> ResolverValue m) -> m (ResolverValue m) -> m (ResolverValue m) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> do TypeKind kind <- TypeDefinition ANY VALID -> TypeKind forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> TypeKind kindOf (TypeDefinition ANY VALID -> TypeKind) -> m (TypeDefinition ANY VALID) -> m TypeKind forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> TypeName -> m (TypeDefinition ANY VALID) forall (m :: * -> *). WithSchema m => TypeName -> m (TypeDefinition ANY VALID) selectType TypeName typeConName ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> ResolverValue m -> m (ResolverValue m) forall a b. (a -> b) -> a -> b $ TypeKind -> TypeName -> Maybe Text -> [ResolverEntry m] -> ResolverValue m forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => TypeKind -> name -> Maybe Text -> [(FieldName, m (ResolverValue m))] -> ResolverValue m mkType TypeKind kind TypeName typeConName Maybe Text forall a. Maybe a Nothing [] withNonNull :: ( Monad m, WithSchema m ) => Bool -> ResolverValue m -> ResolverValue m withNonNull :: Bool -> ResolverValue m -> ResolverValue m withNonNull Bool True ResolverValue m contentType = TypeName -> [ResolverEntry m] -> ResolverValue m forall (m :: * -> *). TypeName -> [ResolverEntry m] -> ResolverValue m mkObject TypeName "__Type" [ TypeKind -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => TypeKind -> (FieldName, m (ResolverValue m)) renderKind TypeKind KindNonNull, (FieldName "ofType", ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure ResolverValue m contentType) ] withNonNull Bool False ResolverValue m contentType = ResolverValue m contentType renderPossibleTypes :: (Monad m, WithSchema m) => TypeName -> m (ResolverValue m) renderPossibleTypes :: TypeName -> m (ResolverValue m) renderPossibleTypes TypeName name = [ResolverValue m] -> ResolverValue m forall (m :: * -> *). [ResolverValue m] -> ResolverValue m mkList ([ResolverValue m] -> ResolverValue m) -> m [ResolverValue m] -> m (ResolverValue m) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ( m (Schema VALID) forall (m :: * -> *). WithSchema m => m (Schema VALID) getSchema m (Schema VALID) -> (Schema VALID -> m [ResolverValue m]) -> m [ResolverValue m] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (TypeDefinition ANY VALID -> m (ResolverValue m)) -> [TypeDefinition ANY VALID] -> m [ResolverValue m] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse TypeDefinition ANY VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render ([TypeDefinition ANY VALID] -> m [ResolverValue m]) -> (Schema VALID -> [TypeDefinition ANY VALID]) -> Schema VALID -> m [ResolverValue m] forall b c a. (b -> c) -> (a -> b) -> a -> c . TypeName -> Schema VALID -> [TypeDefinition ANY VALID] forall (s :: Stage). TypeName -> Schema s -> [TypeDefinition ANY s] possibleInterfaceTypes TypeName name ) renderDeprecated :: ( Monad m, WithSchema m ) => Directives s -> [(FieldName, m (ResolverValue m))] renderDeprecated :: Directives s -> [(FieldName, m (ResolverValue m))] renderDeprecated Directives s dirs = [ (FieldName "isDeprecated", Bool -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render (Maybe (Directive s) -> Bool forall a. Maybe a -> Bool isJust (Maybe (Directive s) -> Bool) -> Maybe (Directive s) -> Bool forall a b. (a -> b) -> a -> b $ Directives s -> Maybe (Directive s) forall (s :: Stage). Directives s -> Maybe (Directive s) lookupDeprecated Directives s dirs)), (FieldName "deprecationReason", Maybe Text -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render (Directives s -> Maybe (Directive s) forall (s :: Stage). Directives s -> Maybe (Directive s) lookupDeprecated Directives s dirs Maybe (Directive s) -> (Directive s -> Maybe Text) -> Maybe Text forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Directive s -> Maybe Text forall (s :: Stage). Directive s -> Maybe Text lookupDeprecatedReason)) ] description :: ( Monad m, WithSchema m ) => Maybe Description -> (FieldName, m (ResolverValue m)) description :: Maybe Text -> (FieldName, m (ResolverValue m)) description = (FieldName "description",) (m (ResolverValue m) -> (FieldName, m (ResolverValue m))) -> (Maybe Text -> m (ResolverValue m)) -> Maybe Text -> (FieldName, m (ResolverValue m)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Maybe Text -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render mkType :: ( RenderIntrospection name, Monad m, WithSchema m ) => TypeKind -> name -> Maybe Description -> [(FieldName, m (ResolverValue m))] -> ResolverValue m mkType :: TypeKind -> name -> Maybe Text -> [(FieldName, m (ResolverValue m))] -> ResolverValue m mkType TypeKind kind name name Maybe Text desc [(FieldName, m (ResolverValue m))] etc = TypeName -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall (m :: * -> *). TypeName -> [ResolverEntry m] -> ResolverValue m mkObject TypeName "__Type" ( [ TypeKind -> (FieldName, m (ResolverValue m)) forall (m :: * -> *). (Monad m, WithSchema m) => TypeKind -> (FieldName, m (ResolverValue m)) renderKind TypeKind kind, name -> (FieldName, m (ResolverValue m)) forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => name -> (FieldName, m (ResolverValue m)) renderName name name, Maybe Text -> (FieldName, m (ResolverValue m)) forall (m :: * -> *). (Monad m, WithSchema m) => Maybe Text -> (FieldName, m (ResolverValue m)) description Maybe Text desc ] [(FieldName, m (ResolverValue m))] -> [(FieldName, m (ResolverValue m))] -> [(FieldName, m (ResolverValue m))] forall a. Semigroup a => a -> a -> a <> [(FieldName, m (ResolverValue m))] etc ) createObjectType :: (Monad m, WithSchema m) => TypeName -> Maybe Description -> [TypeName] -> FieldsDefinition OUT VALID -> ResolverValue m createObjectType :: TypeName -> Maybe Text -> [TypeName] -> FieldsDefinition OUT VALID -> ResolverValue m createObjectType TypeName name Maybe Text desc [TypeName] interfaces FieldsDefinition OUT VALID fields = TypeKind -> TypeName -> Maybe Text -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => TypeKind -> name -> Maybe Text -> [(FieldName, m (ResolverValue m))] -> ResolverValue m mkType (Maybe OperationType -> TypeKind KindObject Maybe OperationType forall a. Maybe a Nothing) TypeName name Maybe Text desc [(FieldName "fields", FieldsDefinition OUT VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render FieldsDefinition OUT VALID fields), (FieldName "interfaces", [ResolverValue m] -> ResolverValue m forall (m :: * -> *). [ResolverValue m] -> ResolverValue m mkList ([ResolverValue m] -> ResolverValue m) -> m [ResolverValue m] -> m (ResolverValue m) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (TypeName -> m (ResolverValue m)) -> [TypeName] -> m [ResolverValue m] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse TypeName -> m (ResolverValue m) forall (m :: * -> *). (Monad m, WithSchema m) => TypeName -> m (ResolverValue m) implementedInterface [TypeName] interfaces)] implementedInterface :: (Monad m, WithSchema m) => TypeName -> m (ResolverValue m) implementedInterface :: TypeName -> m (ResolverValue m) implementedInterface TypeName name = TypeName -> m (TypeDefinition ANY VALID) forall (m :: * -> *). WithSchema m => TypeName -> m (TypeDefinition ANY VALID) selectType TypeName name m (TypeDefinition ANY VALID) -> (TypeDefinition ANY VALID -> m (ResolverValue m)) -> m (ResolverValue m) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= TypeDefinition ANY VALID -> m (ResolverValue m) renderContent where renderContent :: TypeDefinition ANY VALID -> m (ResolverValue m) renderContent typeDef :: TypeDefinition ANY VALID typeDef@TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> TypeContent TRUE a s typeContent = DataInterface {}} = TypeDefinition ANY VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render TypeDefinition ANY VALID typeDef renderContent TypeDefinition ANY VALID _ = GQLError -> m (ResolverValue m) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (GQLError -> m (ResolverValue m)) -> GQLError -> m (ResolverValue m) forall a b. (a -> b) -> a -> b $ GQLError -> GQLError internal (GQLError -> GQLError) -> GQLError -> GQLError forall a b. (a -> b) -> a -> b $ GQLError "Type " GQLError -> GQLError -> GQLError forall a. Semigroup a => a -> a -> a <> TypeName -> GQLError forall a. Msg a => a -> GQLError msg TypeName name GQLError -> GQLError -> GQLError forall a. Semigroup a => a -> a -> a <> GQLError " must be an Interface" renderName :: ( RenderIntrospection name, Monad m, WithSchema m ) => name -> (FieldName, m (ResolverValue m)) renderName :: name -> (FieldName, m (ResolverValue m)) renderName = (FieldName "name",) (m (ResolverValue m) -> (FieldName, m (ResolverValue m))) -> (name -> m (ResolverValue m)) -> name -> (FieldName, m (ResolverValue m)) forall b c a. (b -> c) -> (a -> b) -> a -> c . name -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render renderKind :: (Monad m, WithSchema m) => TypeKind -> (FieldName, m (ResolverValue m)) renderKind :: TypeKind -> (FieldName, m (ResolverValue m)) renderKind = (FieldName "kind",) (m (ResolverValue m) -> (FieldName, m (ResolverValue m))) -> (TypeKind -> m (ResolverValue m)) -> TypeKind -> (FieldName, m (ResolverValue m)) forall b c a. (b -> c) -> (a -> b) -> a -> c . TypeKind -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render type' :: (Monad m, WithSchema m) => TypeRef -> (FieldName, m (ResolverValue m)) type' :: TypeRef -> (FieldName, m (ResolverValue m)) type' = (FieldName "type",) (m (ResolverValue m) -> (FieldName, m (ResolverValue m))) -> (TypeRef -> m (ResolverValue m)) -> TypeRef -> (FieldName, m (ResolverValue m)) forall b c a. (b -> c) -> (a -> b) -> a -> c . TypeRef -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render defaultValue :: (Monad m, WithSchema m) => Maybe (FieldContent TRUE IN VALID) -> ( FieldName, m (ResolverValue m) ) defaultValue :: Maybe (FieldContent TRUE IN VALID) -> (FieldName, m (ResolverValue m)) defaultValue = (FieldName "defaultValue",) (m (ResolverValue m) -> (FieldName, m (ResolverValue m))) -> (Maybe (FieldContent TRUE IN VALID) -> m (ResolverValue m)) -> Maybe (FieldContent TRUE IN VALID) -> (FieldName, m (ResolverValue m)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Maybe (FieldContent TRUE IN VALID) -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render