{-# 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 Data.Foldable (foldr') import Data.Morpheus.App.Internal.Resolving ( Resolver, ResolverContext (..), ResolverValue, mkBoolean, mkList, mkNull, mkObject, mkString, unsafeInternalContext, ) import qualified Data.Morpheus.Core as GQL import Data.Morpheus.Internal.Utils ( Failure, elems, failure, fromLBS, selectBy, ) import Data.Morpheus.Types.Internal.AST ( ANY, ArgumentDefinition (..), ArgumentsDefinition, DataEnumValue (..), DataTypeWrapper (..), Description, DirectiveDefinition (..), DirectiveLocation, Directives, FieldContent (..), FieldDefinition (..), FieldName (..), FieldsDefinition, GQLErrors, IN, Message, OUT, QUERY, Schema, TRUE, TypeContent (..), TypeDefinition (..), TypeKind (..), TypeName (..), TypeRef (..), UnionMember (..), VALID, Value (..), fieldVisibility, kindOf, lookupDeprecated, lookupDeprecatedReason, mkInputUnionFields, msg, possibleInterfaceTypes, toGQLWrapper, ) import Data.Text (pack) import Relude class ( Monad m, Failure Message m, Failure GQLErrors 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 >>= Message -> TypeName -> Schema VALID -> m (TypeDefinition ANY VALID) forall e (m :: * -> *) k a c. (Failure e m, Selectable k a c, Monad m) => e -> k -> c -> m a selectBy (Message " INTERNAL: INTROSPECTION Type not Found: \"" Message -> Message -> Message forall a. Semigroup a => a -> a -> a <> TypeName -> Message forall a. Msg a => a -> Message msg TypeName name Message -> Message -> Message forall a. Semigroup a => a -> a -> a <> Message "\"") TypeName name 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 . Token -> ResolverValue m forall (m :: * -> *). Token -> ResolverValue m mkString (Token -> ResolverValue m) -> (TypeName -> Token) -> TypeName -> ResolverValue m forall b c a. (b -> c) -> (a -> b) -> a -> c . TypeName -> Token readTypeName 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 . Token -> ResolverValue m forall (m :: * -> *). Token -> ResolverValue m mkString (Token -> ResolverValue m) -> (FieldName -> Token) -> FieldName -> ResolverValue m forall b c a. (b -> c) -> (a -> b) -> a -> c . FieldName -> Token readName instance RenderIntrospection Description where render :: Token -> m (ResolverValue m) render = ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure (ResolverValue m -> m (ResolverValue m)) -> (Token -> ResolverValue m) -> Token -> m (ResolverValue m) forall b c a. (b -> c) -> (a -> b) -> a -> c . Token -> ResolverValue m forall (m :: * -> *). Token -> 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 . Token -> ResolverValue m forall (m :: * -> *). Token -> ResolverValue m mkString (Token -> ResolverValue m) -> (TypeKind -> Token) -> TypeKind -> ResolverValue m forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Token fromLBS (ByteString -> Token) -> (TypeKind -> ByteString) -> TypeKind -> Token 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 Token directiveDefinitionDescription :: forall (s :: Stage). DirectiveDefinition s -> Maybe Token directiveDefinitionDescription :: Maybe Token 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 Token -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => Maybe Token -> (FieldName, m (ResolverValue m)) description Maybe Token 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 $ Token -> ResolverValue m forall (m :: * -> *). Token -> ResolverValue m mkString (String -> Token pack (String -> Token) -> String -> Token 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 Token typeDescription :: forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> Maybe Token typeDescription :: Maybe Token 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 Token -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => TypeKind -> name -> Maybe Token -> [(FieldName, m (ResolverValue m))] -> ResolverValue m mkType TypeKind kind TypeName typeName Maybe Token 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 Token -> [TypeName] -> FieldsDefinition OUT VALID -> ResolverValue m forall (m :: * -> *). (Monad m, WithSchema m) => TypeName -> Maybe Token -> [TypeName] -> FieldsDefinition OUT VALID -> ResolverValue m createObjectType TypeName typeName Maybe Token typeDescription [TypeName] objectImplements FieldsDefinition OUT VALID objectFields renderContent (DataUnion DataUnion 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", DataUnion VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render DataUnion VALID union)] renderContent (DataInputUnion DataInputUnion VALID members) = TypeKind -> TypeName -> Maybe Token -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => TypeKind -> name -> Maybe Token -> [(FieldName, m (ResolverValue m))] -> ResolverValue m mkType TypeKind KindInputObject TypeName typeName ( Token -> Maybe Token forall a. a -> Maybe a Just ( Token "Note! This input is an exclusive object,\n" Token -> Token -> Token forall a. Semigroup a => a -> a -> a <> Token "i.e., the customer can provide a value for only one field." ) Maybe Token -> Maybe Token -> Maybe Token forall a. Semigroup a => a -> a -> a <> Maybe Token typeDescription ) [ ( FieldName "inputFields", FieldsDefinition IN VALID -> m (ResolverValue m) forall a (m :: * -> *). (RenderIntrospection a, Monad m, WithSchema m) => a -> m (ResolverValue m) render (DataInputUnion VALID -> FieldsDefinition IN VALID forall (s :: Stage). [UnionMember IN s] -> FieldsDefinition IN s mkInputUnionFields DataInputUnion 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 a coll. Elems a coll => coll -> [a] elems 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 $ Token -> ResolverValue m forall (m :: * -> *). Token -> ResolverValue m mkString (Token -> ResolverValue m) -> Token -> ResolverValue m forall a b. (a -> b) -> a -> b $ ByteString -> Token fromLBS (ByteString -> Token) -> ByteString -> Token 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 {[Directive VALID] Maybe Token Maybe (FieldContent TRUE OUT VALID) TypeRef FieldName fieldDescription :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> Maybe Token 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 -> [Directive s] fieldDirectives :: [Directive VALID] fieldContent :: Maybe (FieldContent TRUE OUT VALID) fieldType :: TypeRef fieldName :: FieldName fieldDescription :: Maybe Token ..} = 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 Token -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => Maybe Token -> (FieldName, m (ResolverValue m)) description Maybe Token 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 <> [Directive VALID] -> [ResolverEntry m] forall (m :: * -> *) (s :: Stage). (Monad m, WithSchema m) => Directives s -> [(FieldName, m (ResolverValue m))] renderDeprecated [Directive 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 a coll. Elems a coll => coll -> [a] elems instance RenderIntrospection (FieldDefinition IN VALID) where render :: FieldDefinition IN VALID -> m (ResolverValue m) render FieldDefinition {[Directive VALID] Maybe Token Maybe (FieldContent TRUE IN VALID) TypeRef FieldName fieldDirectives :: [Directive VALID] fieldContent :: Maybe (FieldContent TRUE IN VALID) fieldType :: TypeRef fieldName :: FieldName fieldDescription :: Maybe Token fieldDescription :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> Maybe Token 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 -> [Directive 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 Token -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => Maybe Token -> (FieldName, m (ResolverValue m)) description Maybe Token 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 Token enumDescription :: forall (s :: Stage). DataEnumValue s -> Maybe Token enumDescription :: Maybe Token enumDescription, [Directive VALID] enumDirectives :: forall (s :: Stage). DataEnumValue s -> [Directive s] enumDirectives :: [Directive 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 Token -> ResolverEntry m forall (m :: * -> *). (Monad m, WithSchema m) => Maybe Token -> (FieldName, m (ResolverValue m)) description Maybe Token enumDescription ] [ResolverEntry m] -> [ResolverEntry m] -> [ResolverEntry m] forall a. Semigroup a => a -> a -> a <> [Directive VALID] -> [ResolverEntry m] forall (m :: * -> *) (s :: Stage). (Monad m, WithSchema m) => Directives s -> [(FieldName, m (ResolverValue m))] renderDeprecated [Directive 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} = 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 let currentType :: ResolverValue m currentType = TypeKind -> TypeName -> Maybe Token -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => TypeKind -> name -> Maybe Token -> [(FieldName, m (ResolverValue m))] -> ResolverValue m mkType TypeKind kind TypeName typeConName Maybe Token forall a. Maybe a Nothing [] 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 $ (DataTypeWrapper -> ResolverValue m -> ResolverValue m) -> ResolverValue m -> [DataTypeWrapper] -> ResolverValue m forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr' DataTypeWrapper -> ResolverValue m -> ResolverValue m forall (m :: * -> *). (Monad m, WithSchema m) => DataTypeWrapper -> ResolverValue m -> ResolverValue m wrap ResolverValue m currentType ([TypeWrapper] -> [DataTypeWrapper] toGQLWrapper [TypeWrapper] typeWrappers) where wrap :: ( Monad m, WithSchema m ) => DataTypeWrapper -> ResolverValue m -> ResolverValue m wrap :: DataTypeWrapper -> ResolverValue m -> ResolverValue m wrap DataTypeWrapper wrapper 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 (DataTypeWrapper -> TypeKind wrapperKind DataTypeWrapper wrapper), (FieldName "ofType", ResolverValue m -> m (ResolverValue m) forall (f :: * -> *) a. Applicative f => a -> f a pure ResolverValue m contentType) ] wrapperKind :: DataTypeWrapper -> TypeKind wrapperKind DataTypeWrapper ListType = TypeKind KindList wrapperKind DataTypeWrapper NonNullType = TypeKind KindNonNull 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). [Directive s] -> Maybe (Directive s) lookupDeprecated Directives s dirs)), (FieldName "deprecationReason", Maybe Token -> 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). [Directive s] -> Maybe (Directive s) lookupDeprecated Directives s dirs Maybe (Directive s) -> (Directive s -> Maybe Token) -> Maybe Token forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Directive s -> Maybe Token forall (s :: Stage). Directive s -> Maybe Token lookupDeprecatedReason)) ] description :: ( Monad m, WithSchema m ) => Maybe Description -> (FieldName, m (ResolverValue m)) description :: Maybe Token -> (FieldName, m (ResolverValue m)) description = (FieldName "description",) (m (ResolverValue m) -> (FieldName, m (ResolverValue m))) -> (Maybe Token -> m (ResolverValue m)) -> Maybe Token -> (FieldName, m (ResolverValue m)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Maybe Token -> 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 Token -> [(FieldName, m (ResolverValue m))] -> ResolverValue m mkType TypeKind kind name name Maybe Token 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 Token -> (FieldName, m (ResolverValue m)) forall (m :: * -> *). (Monad m, WithSchema m) => Maybe Token -> (FieldName, m (ResolverValue m)) description Maybe Token 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 Token -> [TypeName] -> FieldsDefinition OUT VALID -> ResolverValue m createObjectType TypeName name Maybe Token desc [TypeName] interfaces FieldsDefinition OUT VALID fields = TypeKind -> TypeName -> Maybe Token -> [(FieldName, m (ResolverValue m))] -> ResolverValue m forall name (m :: * -> *). (RenderIntrospection name, Monad m, WithSchema m) => TypeKind -> name -> Maybe Token -> [(FieldName, m (ResolverValue m))] -> ResolverValue m mkType (Maybe OperationType -> TypeKind KindObject Maybe OperationType forall a. Maybe a Nothing) TypeName name Maybe Token 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 _ = Message -> m (ResolverValue m) forall error (f :: * -> *) v. Failure error f => error -> f v failure (Message "Type " Message -> Message -> Message forall a. Semigroup a => a -> a -> a <> TypeName -> Message forall a. Msg a => a -> Message msg TypeName name Message -> Message -> Message forall a. Semigroup a => a -> a -> a <> Message " must be an Interface" :: Message) 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