{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.App.RenderIntrospection
  ( renderI,
  )
where

import Control.Monad.Except (MonadError (throwError))
import Data.Morpheus.App.Internal.Resolving.MonadResolver
  ( MonadResolver,
    ResolverContext (..),
  )
import Data.Morpheus.App.Internal.Resolving.Types
  ( ResolverValue,
    mkBoolean,
    mkList,
    mkNull,
    mkObject,
    mkString,
  )
import Data.Morpheus.Core (render)
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),
    Name,
    OUT,
    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

iError :: GQLError -> GQLError
iError :: GQLError -> GQLError
iError GQLError
x = GQLError -> GQLError
internal (GQLError
"INTROSPECTION" forall a. Semigroup a => a -> a -> a
<> GQLError
x)

getType :: MonadResolver m => TypeName -> m TypeDef
getType :: forall (m :: * -> *). MonadResolver m => TypeName -> m TypeDef
getType TypeName
name =
  forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ResolverContext -> Schema VALID
schema
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e (m :: * -> *) k (c :: * -> *) a.
(MonadError e m, IsMap k c, Monad m) =>
e -> k -> c a -> m a
selectBy (GQLError -> GQLError
iError forall a b. (a -> b) -> a -> b
$ GQLError
"type \"" forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeName
name forall a. Semigroup a => a -> a -> a
<> GQLError
"\" not found!") TypeName
name
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage).
Schema s -> HashMap TypeName (TypeDefinition ANY s)
typeDefinitions

assertINTERFACE :: MonadResolver m => TypeDef -> m TypeDef
assertINTERFACE :: forall (m :: * -> *). MonadResolver m => TypeDef -> m TypeDef
assertINTERFACE t :: TypeDef
t@TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataInterface {}} = forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeDef
t
assertINTERFACE TypeDef
t = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ GQLError -> GQLError
iError forall a b. (a -> b) -> a -> b
$ GQLError
"Type " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDef
t) forall a. Semigroup a => a -> a -> a
<> GQLError
" must be an Interface!"

type TypeDef = TypeDefinition ANY VALID

type IValue m = m (ResolverValue m)

type IField m = (FieldName, IValue m)

class RenderI a where
  renderI :: MonadResolver m => a -> IValue m

instance RenderI (Name t) where
  renderI :: forall (m :: * -> *). MonadResolver m => Name t -> IValue m
renderI = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Text -> ResolverValue m
mkString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: NAME). NamePacking a => Name t -> a
unpackName

instance RenderI Description where
  renderI :: forall (m :: * -> *). MonadResolver m => Text -> IValue m
renderI = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Text -> ResolverValue m
mkString

instance RenderI a => RenderI [a] where
  renderI :: forall (m :: * -> *). MonadResolver m => [a] -> IValue m
renderI [a]
ls = forall (m :: * -> *). [ResolverValue m] -> ResolverValue m
mkList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI [a]
ls

instance RenderI a => RenderI (Maybe a) where
  renderI :: forall (m :: * -> *). MonadResolver m => Maybe a -> IValue m
renderI (Just a
value) = forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI a
value
  renderI Maybe a
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *). ResolverValue m
mkNull

instance RenderI Bool where
  renderI :: forall (m :: * -> *). MonadResolver m => Bool -> IValue m
renderI = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Bool -> ResolverValue m
mkBoolean

instance RenderI TypeKind where
  renderI :: forall (m :: * -> *). MonadResolver m => TypeKind -> IValue m
renderI = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Text -> ResolverValue m
mkString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
fromLBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RenderGQL a => a -> ByteString
render

instance RenderI (DirectiveDefinition VALID) where
  renderI :: forall (m :: * -> *).
MonadResolver m =>
DirectiveDefinition VALID -> IValue m
renderI DirectiveDefinition {[DirectiveLocation]
Maybe Text
FieldName
ArgumentsDefinition VALID
directiveDefinitionName :: forall (s :: Stage). DirectiveDefinition s -> FieldName
directiveDefinitionDescription :: forall (s :: Stage). DirectiveDefinition s -> Maybe Text
directiveDefinitionArgs :: forall (s :: Stage). DirectiveDefinition s -> ArgumentsDefinition s
directiveDefinitionLocations :: forall (s :: Stage). DirectiveDefinition s -> [DirectiveLocation]
directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionArgs :: ArgumentsDefinition VALID
directiveDefinitionDescription :: Maybe Text
directiveDefinitionName :: FieldName
..} =
    forall (m :: * -> *). Monad m => TypeName -> [IField m] -> IValue m
object
      TypeName
"__Directive"
      [ forall (m :: * -> *) (t :: NAME).
MonadResolver m =>
Name t -> IField m
fName FieldName
directiveDefinitionName,
        forall (m :: * -> *). MonadResolver m => Maybe Text -> IField m
fDescription Maybe Text
directiveDefinitionDescription,
        (FieldName
"locations", forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI [DirectiveLocation]
directiveDefinitionLocations),
        (FieldName
"args", forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI ArgumentsDefinition VALID
directiveDefinitionArgs)
      ]

instance RenderI DirectiveLocation where
  renderI :: forall (m :: * -> *).
MonadResolver m =>
DirectiveLocation -> IValue m
renderI DirectiveLocation
locations = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Text -> ResolverValue m
mkString (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show DirectiveLocation
locations)

instance RenderI (TypeDefinition c VALID) where
  renderI :: forall (m :: * -> *).
MonadResolver m =>
TypeDefinition c VALID -> IValue m
renderI TypeDefinition {Maybe Text
TypeContent TRUE c VALID
TypeName
Directives VALID
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Text
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeContent :: TypeContent TRUE c VALID
typeDirectives :: Directives VALID
typeName :: TypeName
typeDescription :: Maybe Text
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
..} = forall (m :: * -> *) (bool :: Bool) (a :: TypeCategory).
MonadResolver m =>
TypeContent bool a VALID -> IValue m
renderContent TypeContent TRUE c VALID
typeContent
    where
      __type :: MonadResolver m => TypeKind -> [IField m] -> IValue m
      __type :: forall (m :: * -> *).
MonadResolver m =>
TypeKind -> [IField m] -> IValue m
__type TypeKind
kind = forall (m :: * -> *) (t :: NAME).
MonadResolver m =>
TypeKind -> Name t -> Maybe Text -> [IField m] -> IValue m
__Type TypeKind
kind TypeName
typeName Maybe Text
typeDescription
      renderContent :: MonadResolver m => TypeContent bool a VALID -> IValue m
      renderContent :: forall (m :: * -> *) (bool :: Bool) (a :: TypeCategory).
MonadResolver m =>
TypeContent bool a VALID -> IValue m
renderContent DataScalar {} = forall (m :: * -> *).
MonadResolver m =>
TypeKind -> [IField m] -> IValue m
__type TypeKind
KIND_SCALAR []
      renderContent (DataEnum DataEnum VALID
enums) = forall (m :: * -> *).
MonadResolver m =>
TypeKind -> [IField m] -> IValue m
__type TypeKind
KIND_ENUM [(FieldName
"enumValues", forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI DataEnum VALID
enums)]
      renderContent (DataInputObject FieldsDefinition IN VALID
inputFields) =
        forall (m :: * -> *).
MonadResolver m =>
TypeKind -> [IField m] -> IValue m
__type
          TypeKind
KIND_INPUT_OBJECT
          [(FieldName
"inputFields", forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI FieldsDefinition IN VALID
inputFields)]
      renderContent DataObject {[TypeName]
objectImplements :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> [TypeName]
objectImplements :: [TypeName]
objectImplements, FieldsDefinition OUT VALID
objectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT VALID
objectFields} =
        forall (m :: * -> *) (t :: NAME).
MonadResolver m =>
TypeKind -> Name t -> Maybe Text -> [IField m] -> IValue m
__Type
          (Maybe OperationType -> TypeKind
KIND_OBJECT forall a. Maybe a
Nothing)
          TypeName
typeName
          Maybe Text
typeDescription
          [ (FieldName
"fields", forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI FieldsDefinition OUT VALID
objectFields),
            (FieldName
"interfaces", forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). MonadResolver m => TypeName -> m TypeDef
getType forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *). MonadResolver m => TypeDef -> m TypeDef
assertINTERFACE) [TypeName]
objectImplements forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI)
          ]
      renderContent (DataUnion UnionTypeDefinition OUT VALID
union) =
        forall (m :: * -> *).
MonadResolver m =>
TypeKind -> [IField m] -> IValue m
__type
          TypeKind
KIND_UNION
          [(FieldName
"possibleTypes", forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList UnionTypeDefinition OUT VALID
union)]
      renderContent (DataInputUnion UnionTypeDefinition IN VALID
members) =
        forall (m :: * -> *) (t :: NAME).
MonadResolver m =>
TypeKind -> Name t -> Maybe Text -> [IField m] -> IValue m
__Type
          TypeKind
KIND_INPUT_OBJECT
          TypeName
typeName
          ( forall a. a -> Maybe a
Just
              ( Text
"Note! This input is an exclusive object,\n"
                  forall a. Semigroup a => a -> a -> a
<> Text
"i.e., the customer can provide a value for only one field."
              )
              forall a. Semigroup a => a -> a -> a
<> Maybe Text
typeDescription
          )
          [ ( FieldName
"inputFields",
              forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI (forall (t :: * -> *) (s :: Stage).
Foldable t =>
t (UnionMember IN s) -> FieldsDefinition IN s
mkInputUnionFields UnionTypeDefinition IN VALID
members)
            )
          ]
      renderContent (DataInterface FieldsDefinition OUT VALID
fields) =
        forall (m :: * -> *).
MonadResolver m =>
TypeKind -> [IField m] -> IValue m
__type
          TypeKind
KIND_INTERFACE
          [ (FieldName
"fields", forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI FieldsDefinition OUT VALID
fields),
            (FieldName
"possibleTypes", forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ResolverContext -> Schema VALID
schema forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). TypeName -> Schema s -> [TypeDefinition ANY s]
possibleInterfaceTypes TypeName
typeName)
          ]

instance RenderI (UnionMember OUT s) where
  renderI :: forall (m :: * -> *).
MonadResolver m =>
UnionMember OUT s -> IValue m
renderI UnionMember {TypeName
memberName :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
memberName :: TypeName
memberName} = forall (m :: * -> *). MonadResolver m => TypeName -> m TypeDef
getType TypeName
memberName forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI

instance RenderI (FieldDefinition cat s) => RenderI (FieldsDefinition cat s) where
  renderI :: forall (m :: * -> *).
MonadResolver m =>
FieldsDefinition cat s -> IValue m
renderI = forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Bool
fieldVisibility forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance RenderI (FieldContent TRUE IN VALID) where
  renderI :: forall (m :: * -> *).
MonadResolver m =>
FieldContent TRUE IN VALID -> IValue m
renderI = forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage) (cat :: TypeCategory).
FieldContent (IN <=? cat) cat s -> Value s
defaultInputValue

instance RenderI (Value VALID) where
  renderI :: forall (m :: * -> *). MonadResolver m => Value VALID -> IValue m
renderI Value VALID
Null = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *). ResolverValue m
mkNull
  renderI Value VALID
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Text -> ResolverValue m
mkString forall a b. (a -> b) -> a -> b
$ ByteString -> Text
fromLBS forall a b. (a -> b) -> a -> b
$ forall a. RenderGQL a => a -> ByteString
render Value VALID
x

instance RenderI (FieldDefinition OUT VALID) where
  renderI :: forall (m :: * -> *).
MonadResolver m =>
FieldDefinition OUT VALID -> IValue m
renderI 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
..} =
    forall (m :: * -> *). Monad m => TypeName -> [IField m] -> IValue m
object TypeName
"__Field" forall a b. (a -> b) -> a -> b
$
      [ forall (m :: * -> *) (t :: NAME).
MonadResolver m =>
Name t -> IField m
fName FieldName
fieldName,
        forall (m :: * -> *). MonadResolver m => Maybe Text -> IField m
fDescription Maybe Text
fieldDescription,
        forall (m :: * -> *). MonadResolver m => TypeRef -> IField m
fType TypeRef
fieldType,
        (FieldName
"args", forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). [ResolverValue m] -> ResolverValue m
mkList []) forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI Maybe (FieldContent TRUE OUT VALID)
fieldContent)
      ]
        forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *) (s :: Stage).
MonadResolver m =>
Directives s -> [IField m]
fDeprecated Directives VALID
fieldDirectives

instance RenderI (FieldContent TRUE OUT VALID) where
  renderI :: forall (m :: * -> *).
MonadResolver m =>
FieldContent TRUE OUT VALID -> IValue m
renderI (FieldArgs ArgumentsDefinition VALID
args) = forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI ArgumentsDefinition VALID
args

instance RenderI (ArgumentsDefinition VALID) where
  renderI :: forall (m :: * -> *).
MonadResolver m =>
ArgumentsDefinition VALID -> IValue m
renderI = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *). [ResolverValue m] -> ResolverValue m
mkList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). ArgumentDefinition s -> FieldDefinition IN s
argument) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance RenderI (FieldDefinition IN VALID) where
  renderI :: forall (m :: * -> *).
MonadResolver m =>
FieldDefinition IN VALID -> IValue m
renderI 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
..} =
    forall (m :: * -> *). Monad m => TypeName -> [IField m] -> IValue m
object
      TypeName
"__InputValue"
      [ forall (m :: * -> *) (t :: NAME).
MonadResolver m =>
Name t -> IField m
fName FieldName
fieldName,
        forall (m :: * -> *). MonadResolver m => Maybe Text -> IField m
fDescription Maybe Text
fieldDescription,
        forall (m :: * -> *). MonadResolver m => TypeRef -> IField m
fType TypeRef
fieldType,
        forall (m :: * -> *).
MonadResolver m =>
Maybe (FieldContent TRUE IN VALID) -> IField m
fDefaultValue Maybe (FieldContent TRUE IN VALID)
fieldContent
      ]

instance RenderI (DataEnumValue VALID) where
  renderI :: forall (m :: * -> *).
MonadResolver m =>
DataEnumValue VALID -> IValue m
renderI DataEnumValue {Maybe Text
TypeName
Directives VALID
enumDescription :: forall (s :: Stage). DataEnumValue s -> Maybe Text
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumDirectives :: forall (s :: Stage). DataEnumValue s -> Directives s
enumDirectives :: Directives VALID
enumName :: TypeName
enumDescription :: Maybe Text
..} =
    forall (m :: * -> *). Monad m => TypeName -> [IField m] -> IValue m
object TypeName
"__EnumValue" forall a b. (a -> b) -> a -> b
$
      [ forall (m :: * -> *) (t :: NAME).
MonadResolver m =>
Name t -> IField m
fName TypeName
enumName,
        forall (m :: * -> *). MonadResolver m => Maybe Text -> IField m
fDescription Maybe Text
enumDescription
      ]
        forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *) (s :: Stage).
MonadResolver m =>
Directives s -> [IField m]
fDeprecated Directives VALID
enumDirectives

instance RenderI TypeRef where
  renderI :: forall (m :: * -> *). MonadResolver m => TypeRef -> IValue m
renderI TypeRef {TypeWrapper
TypeName
typeConName :: TypeRef -> TypeName
typeWrappers :: TypeRef -> TypeWrapper
typeWrappers :: TypeWrapper
typeConName :: TypeName
..} = TypeWrapper -> IValue m
renderWrapper TypeWrapper
typeWrappers
    where
      renderWrapper :: TypeWrapper -> IValue m
renderWrapper (TypeList TypeWrapper
nextWrapper Bool
isNonNull) =
        forall (m :: * -> *).
MonadResolver m =>
Bool -> IValue m -> IValue m
withNonNull Bool
isNonNull forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadResolver m =>
TypeKind -> IValue m -> IValue m
wrapper TypeKind
KIND_LIST (TypeWrapper -> IValue m
renderWrapper TypeWrapper
nextWrapper)
      renderWrapper (BaseType Bool
isNonNull) =
        forall (m :: * -> *).
MonadResolver m =>
Bool -> IValue m -> IValue m
withNonNull Bool
isNonNull forall a b. (a -> b) -> a -> b
$ do
          TypeKind
kind <- forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeKind
kindOf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadResolver m => TypeName -> m TypeDef
getType TypeName
typeConName
          forall (m :: * -> *) (t :: NAME).
MonadResolver m =>
TypeKind -> Name t -> Maybe Text -> [IField m] -> IValue m
__Type TypeKind
kind TypeName
typeConName forall a. Maybe a
Nothing []

withNonNull :: MonadResolver m => Bool -> IValue m -> IValue m
withNonNull :: forall (m :: * -> *).
MonadResolver m =>
Bool -> IValue m -> IValue m
withNonNull Bool
True = forall (m :: * -> *).
MonadResolver m =>
TypeKind -> IValue m -> IValue m
wrapper TypeKind
KIND_NON_NULL
withNonNull Bool
False = forall a. a -> a
id

__Type ::
  MonadResolver m =>
  TypeKind ->
  Name t ->
  Maybe Description ->
  [IField m] ->
  IValue m
__Type :: forall (m :: * -> *) (t :: NAME).
MonadResolver m =>
TypeKind -> Name t -> Maybe Text -> [IField m] -> IValue m
__Type TypeKind
kind Name t
name Maybe Text
desc [IField m]
etc =
  forall (m :: * -> *). Monad m => TypeName -> [IField m] -> IValue m
object
    TypeName
"__Type"
    ( [ forall (m :: * -> *). MonadResolver m => TypeKind -> IField m
fKind TypeKind
kind,
        forall (m :: * -> *) (t :: NAME).
MonadResolver m =>
Name t -> IField m
fName Name t
name,
        forall (m :: * -> *). MonadResolver m => Maybe Text -> IField m
fDescription Maybe Text
desc
      ]
        forall a. Semigroup a => a -> a -> a
<> [IField m]
etc
    )

wrapper :: MonadResolver m => TypeKind -> IValue m -> IValue m
wrapper :: forall (m :: * -> *).
MonadResolver m =>
TypeKind -> IValue m -> IValue m
wrapper TypeKind
k IValue m
t =
  forall (m :: * -> *). Monad m => TypeName -> [IField m] -> IValue m
object
    TypeName
"__Type"
    [ forall (m :: * -> *). MonadResolver m => TypeKind -> IField m
fKind TypeKind
k,
      (FieldName
"ofType", IValue m
t)
    ]

object :: Monad m => TypeName -> [IField m] -> IValue m
object :: forall (m :: * -> *). Monad m => TypeName -> [IField m] -> IValue m
object TypeName
name = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
TypeName -> [ResolverEntry m] -> ResolverValue m
mkObject TypeName
name

fDeprecated :: MonadResolver m => Directives s -> [IField m]
fDeprecated :: forall (m :: * -> *) (s :: Stage).
MonadResolver m =>
Directives s -> [IField m]
fDeprecated Directives s
dirs =
  [ (FieldName
"isDeprecated", forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI (forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (s :: Stage). Directives s -> Maybe (Directive s)
lookupDeprecated Directives s
dirs)),
    (FieldName
"deprecationReason", forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI (forall (s :: Stage). Directives s -> Maybe (Directive s)
lookupDeprecated Directives s
dirs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (s :: Stage). Directive s -> Maybe Text
lookupDeprecatedReason))
  ]

fDescription :: MonadResolver m => Maybe Description -> IField m
fDescription :: forall (m :: * -> *). MonadResolver m => Maybe Text -> IField m
fDescription = (FieldName
"description",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI

fName :: MonadResolver m => Name t -> IField m
fName :: forall (m :: * -> *) (t :: NAME).
MonadResolver m =>
Name t -> IField m
fName = (FieldName
"name",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI

fKind :: MonadResolver m => TypeKind -> IField m
fKind :: forall (m :: * -> *). MonadResolver m => TypeKind -> IField m
fKind = (FieldName
"kind",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI

fType :: MonadResolver m => TypeRef -> IField m
fType :: forall (m :: * -> *). MonadResolver m => TypeRef -> IField m
fType = (FieldName
"type",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI

fDefaultValue :: MonadResolver m => Maybe (FieldContent TRUE IN VALID) -> IField m
fDefaultValue :: forall (m :: * -> *).
MonadResolver m =>
Maybe (FieldContent TRUE IN VALID) -> IField m
fDefaultValue = (FieldName
"defaultValue",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *).
(RenderI a, MonadResolver m) =>
a -> IValue m
renderI