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

module Data.Morpheus.Rendering.RenderIntrospection
  ( render,
    createObjectType,
  )
where

import Data.Morpheus.Internal.Utils
  ( Failure,
    elems,
    failure,
    fromLBS,
    selectBy,
  )
import qualified Data.Morpheus.Rendering.RenderGQL as GQL
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    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.Morpheus.Types.Internal.Resolving
  ( ResModel,
    Resolver,
    ResolverContext (..),
    mkBoolean,
    mkList,
    mkNull,
    mkObject,
    mkString,
    unsafeInternalContext,
  )
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) =>
    a ->
    Resolver QUERY e m (ResModel QUERY e m)

instance RenderIntrospection TypeName where
  render :: TypeName -> Resolver QUERY e m (ResModel QUERY e m)
render = ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> (TypeName -> ResModel QUERY e m)
-> TypeName
-> Resolver QUERY e m (ResModel QUERY e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
Token -> ResModel o e m
mkString (Token -> ResModel QUERY e m)
-> (TypeName -> Token) -> TypeName -> ResModel QUERY e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Token
readTypeName

instance RenderIntrospection FieldName where
  render :: FieldName -> Resolver QUERY e m (ResModel QUERY e m)
render = ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> (FieldName -> ResModel QUERY e m)
-> FieldName
-> Resolver QUERY e m (ResModel QUERY e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
Token -> ResModel o e m
mkString (Token -> ResModel QUERY e m)
-> (FieldName -> Token) -> FieldName -> ResModel QUERY e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Token
readName

instance RenderIntrospection Description where
  render :: Token -> Resolver QUERY e m (ResModel QUERY e m)
render = ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> (Token -> ResModel QUERY e m)
-> Token
-> Resolver QUERY e m (ResModel QUERY e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
Token -> ResModel o e m
mkString

instance RenderIntrospection a => RenderIntrospection [a] where
  render :: [a] -> Resolver QUERY e m (ResModel QUERY e m)
render [a]
ls = [ResModel QUERY e m] -> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
[ResModel o e m] -> ResModel o e m
mkList ([ResModel QUERY e m] -> ResModel QUERY e m)
-> Resolver QUERY e m [ResModel QUERY e m]
-> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Resolver QUERY e m (ResModel QUERY e m))
-> [a] -> Resolver QUERY e m [ResModel QUERY e m]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render [a]
ls

instance RenderIntrospection a => RenderIntrospection (Maybe a) where
  render :: Maybe a -> Resolver QUERY e m (ResModel QUERY e m)
render (Just a
value) = a -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render a
value
  render Maybe a
Nothing = ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *). ResModel o e m
mkNull

instance RenderIntrospection Bool where
  render :: Bool -> Resolver QUERY e m (ResModel QUERY e m)
render = ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> (Bool -> ResModel QUERY e m)
-> Bool
-> Resolver QUERY e m (ResModel QUERY e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *). Bool -> ResModel o e m
mkBoolean

instance RenderIntrospection TypeKind where
  render :: TypeKind -> Resolver QUERY e m (ResModel QUERY e m)
render = ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> (TypeKind -> ResModel QUERY e m)
-> TypeKind
-> Resolver QUERY e m (ResModel QUERY e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
Token -> ResModel o e m
mkString (Token -> ResModel QUERY e m)
-> (TypeKind -> Token) -> TypeKind -> ResModel QUERY e 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.renderGQL

instance RenderIntrospection (DirectiveDefinition VALID) where
  render :: DirectiveDefinition VALID
-> Resolver QUERY e m (ResModel QUERY e 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
      } =
      ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall a b. (a -> b) -> a -> b
$
        TypeName
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
mkObject
          TypeName
"__Directive"
          [ FieldName -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall name (m :: * -> *) e.
(RenderIntrospection name, Monad m) =>
name -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
renderName FieldName
directiveDefinitionName,
            Maybe Token -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall (m :: * -> *) e.
Monad m =>
Maybe Token -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
description Maybe Token
directiveDefinitionDescription,
            (FieldName
"locations", [DirectiveLocation] -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render [DirectiveLocation]
directiveDefinitionLocations),
            (FieldName
"args", ArgumentsDefinition VALID
-> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render ArgumentsDefinition VALID
directiveDefinitionArgs)
          ]

instance RenderIntrospection DirectiveLocation where
  render :: DirectiveLocation -> Resolver QUERY e m (ResModel QUERY e m)
render DirectiveLocation
locations = ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall a b. (a -> b) -> a -> b
$ Token -> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
Token -> ResModel o e 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 -> Resolver QUERY e m (ResModel QUERY e 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
      } = ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall a b. (a -> b) -> a -> b
$ TypeContent TRUE cat VALID -> ResModel QUERY e m
forall (m :: * -> *) (bool :: Bool) (a :: TypeCategory) e.
Monad m =>
TypeContent bool a VALID -> ResModel QUERY e m
renderContent TypeContent TRUE cat VALID
typeContent
      where
        __type ::
          Monad m =>
          TypeKind ->
          [(FieldName, Resolver QUERY e m (ResModel QUERY e m))] ->
          ResModel QUERY e m
        __type :: TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
__type TypeKind
kind = TypeKind
-> TypeName
-> Maybe Token
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (m :: * -> *) name e.
(Monad m, RenderIntrospection name) =>
TypeKind
-> name
-> Maybe Token
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
mkType TypeKind
kind TypeName
typeName Maybe Token
typeDescription
        renderContent ::
          Monad m =>
          TypeContent bool a VALID ->
          ResModel QUERY e m
        renderContent :: TypeContent bool a VALID -> ResModel QUERY e m
renderContent DataScalar {} = TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (m :: * -> *) e.
Monad m =>
TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
__type TypeKind
KindScalar []
        renderContent (DataEnum DataEnum VALID
enums) = TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (m :: * -> *) e.
Monad m =>
TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
__type TypeKind
KindEnum [(FieldName
"enumValues", DataEnum VALID -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render DataEnum VALID
enums)]
        renderContent (DataInputObject FieldsDefinition IN VALID
inputFiels) =
          TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (m :: * -> *) e.
Monad m =>
TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
__type
            TypeKind
KindInputObject
            [(FieldName
"inputFields", FieldsDefinition IN VALID
-> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render FieldsDefinition IN VALID
inputFiels)]
        renderContent DataObject {[TypeName]
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> [TypeName]
objectImplements :: [TypeName]
objectImplements, FieldsDefinition OUT VALID
objectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT VALID
objectFields} =
          TypeName
-> Maybe Token
-> [TypeName]
-> FieldsDefinition OUT VALID
-> ResModel QUERY e m
forall (m :: * -> *) e.
Monad m =>
TypeName
-> Maybe Token
-> [TypeName]
-> FieldsDefinition OUT VALID
-> ResModel QUERY e m
createObjectType TypeName
typeName Maybe Token
typeDescription [TypeName]
objectImplements FieldsDefinition OUT VALID
objectFields
        renderContent (DataUnion DataUnion VALID
union) =
          TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (m :: * -> *) e.
Monad m =>
TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
__type
            TypeKind
KindUnion
            [(FieldName
"possibleTypes", DataUnion VALID -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render DataUnion VALID
union)]
        renderContent (DataInputUnion DataInputUnion VALID
members) =
          TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (m :: * -> *) e.
Monad m =>
TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
__type
            TypeKind
KindInputObject
            [ ( FieldName
"inputFields",
                FieldsDefinition IN VALID
-> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render
                  ( TypeName -> DataInputUnion VALID -> FieldsDefinition IN VALID
forall (s :: Stage).
TypeName -> [UnionMember IN s] -> FieldsDefinition IN s
mkInputUnionFields TypeName
typeName (DataInputUnion VALID -> FieldsDefinition IN VALID)
-> DataInputUnion VALID -> FieldsDefinition IN VALID
forall a b. (a -> b) -> a -> b
$
                      (UnionMember IN VALID -> Bool)
-> DataInputUnion VALID -> DataInputUnion VALID
forall a. (a -> Bool) -> [a] -> [a]
filter UnionMember IN VALID -> Bool
forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> Bool
visibility DataInputUnion VALID
members ::
                      FieldsDefinition IN VALID
                  )
              )
            ]
        renderContent (DataInterface FieldsDefinition OUT VALID
fields) =
          TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (m :: * -> *) e.
Monad m =>
TypeKind
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
__type
            TypeKind
KindInterface
            [ (FieldName
"fields", FieldsDefinition OUT VALID
-> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render FieldsDefinition OUT VALID
fields),
              (FieldName
"possibleTypes", TypeName -> Resolver QUERY e m (ResModel QUERY e m)
forall (m :: * -> *) e.
Monad m =>
TypeName -> Resolver QUERY e m (ResModel QUERY e m)
renderPossibleTypes TypeName
typeName)
            ]

instance RenderIntrospection (UnionMember OUT s) where
  render :: UnionMember OUT s -> Resolver QUERY e m (ResModel QUERY e m)
render UnionMember {TypeName
memberName :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
memberName :: TypeName
memberName} = TypeName -> Resolver QUERY e m (TypeDefinition ANY VALID)
forall (m :: * -> *).
WithSchema m =>
TypeName -> m (TypeDefinition ANY VALID)
selectType TypeName
memberName Resolver QUERY e m (TypeDefinition ANY VALID)
-> (TypeDefinition ANY VALID
    -> Resolver QUERY e m (ResModel QUERY e m))
-> Resolver QUERY e m (ResModel QUERY e m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeDefinition ANY VALID -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render

instance
  RenderIntrospection (FieldDefinition cat s) =>
  RenderIntrospection (FieldsDefinition cat s)
  where
  render :: FieldsDefinition cat s -> Resolver QUERY e m (ResModel QUERY e m)
render = [FieldDefinition cat s] -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render ([FieldDefinition cat s]
 -> Resolver QUERY e m (ResModel QUERY e m))
-> (FieldsDefinition cat s -> [FieldDefinition cat s])
-> FieldsDefinition cat s
-> Resolver QUERY e m (ResModel QUERY e 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
-> Resolver QUERY e m (ResModel QUERY e m)
render = Value VALID -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render (Value VALID -> Resolver QUERY e m (ResModel QUERY e m))
-> (FieldContent TRUE IN VALID -> Value VALID)
-> FieldContent TRUE IN VALID
-> Resolver QUERY e m (ResModel QUERY e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldContent TRUE IN VALID -> Value VALID
forall (cat :: TypeCategory) (s :: Stage).
FieldContent (ELEM IN cat) cat s -> Value s
defaultInputValue

instance RenderIntrospection (Value VALID) where
  render :: Value VALID -> Resolver QUERY e m (ResModel QUERY e m)
render Value VALID
Null = ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *). ResModel o e m
mkNull
  render Value VALID
x = ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall a b. (a -> b) -> a -> b
$ Token -> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
Token -> ResModel o e m
mkString (Token -> ResModel QUERY e m) -> Token -> ResModel QUERY e 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.renderGQL Value VALID
x

instance
  RenderIntrospection
    (FieldDefinition OUT VALID)
  where
  render :: FieldDefinition OUT VALID
-> Resolver QUERY e m (ResModel QUERY e m)
render FieldDefinition {[Directive VALID]
Maybe Token
Maybe (FieldContent TRUE OUT VALID)
TypeRef
FieldName
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> [Directive s]
fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Token
fieldDirectives :: [Directive VALID]
fieldContent :: Maybe (FieldContent TRUE OUT VALID)
fieldType :: TypeRef
fieldName :: FieldName
fieldDescription :: Maybe Token
..} =
    ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall a b. (a -> b) -> a -> b
$ TypeName
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
mkObject TypeName
"__Field"
      ([(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
 -> ResModel QUERY e m)
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall a b. (a -> b) -> a -> b
$ [ FieldName -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall name (m :: * -> *) e.
(RenderIntrospection name, Monad m) =>
name -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
renderName FieldName
fieldName,
          Maybe Token -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall (m :: * -> *) e.
Monad m =>
Maybe Token -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
description Maybe Token
fieldDescription,
          TypeRef -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall (m :: * -> *) e.
Monad m =>
TypeRef -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
type' TypeRef
fieldType,
          (FieldName
"args", Resolver QUERY e m (ResModel QUERY e m)
-> (FieldContent TRUE OUT VALID
    -> Resolver QUERY e m (ResModel QUERY e m))
-> Maybe (FieldContent TRUE OUT VALID)
-> Resolver QUERY e m (ResModel QUERY e m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall a b. (a -> b) -> a -> b
$ [ResModel QUERY e m] -> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
[ResModel o e m] -> ResModel o e m
mkList []) FieldContent TRUE OUT VALID
-> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render Maybe (FieldContent TRUE OUT VALID)
fieldContent)
        ]
        [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
forall a. Semigroup a => a -> a -> a
<> [Directive VALID]
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
forall (m :: * -> *) (s :: Stage) e.
Monad m =>
Directives s
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
renderDeprecated [Directive VALID]
fieldDirectives

instance RenderIntrospection (FieldContent TRUE OUT VALID) where
  render :: FieldContent TRUE OUT VALID
-> Resolver QUERY e m (ResModel QUERY e m)
render (FieldArgs ArgumentsDefinition VALID
args) = ArgumentsDefinition VALID
-> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render ArgumentsDefinition VALID
args

instance RenderIntrospection (ArgumentsDefinition VALID) where
  render :: ArgumentsDefinition VALID
-> Resolver QUERY e m (ResModel QUERY e m)
render ArgumentsDefinition {FieldsDefinition IN VALID
arguments :: forall (s :: Stage).
ArgumentsDefinition s -> OrdMap FieldName (ArgumentDefinition s)
arguments :: FieldsDefinition IN VALID
arguments} = [ResModel QUERY e m] -> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
[ResModel o e m] -> ResModel o e m
mkList ([ResModel QUERY e m] -> ResModel QUERY e m)
-> Resolver QUERY e m [ResModel QUERY e m]
-> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldDefinition IN VALID
 -> Resolver QUERY e m (ResModel QUERY e m))
-> [FieldDefinition IN VALID]
-> Resolver QUERY e m [ResModel QUERY e m]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldDefinition IN VALID -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render (FieldsDefinition IN VALID -> [FieldDefinition IN VALID]
forall a coll. Elems a coll => coll -> [a]
elems FieldsDefinition IN VALID
arguments)

instance RenderIntrospection (FieldDefinition IN VALID) where
  render :: FieldDefinition IN VALID -> Resolver QUERY e m (ResModel QUERY e 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
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> [Directive s]
fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Token
..} =
    ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall a b. (a -> b) -> a -> b
$
      TypeName
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
mkObject
        TypeName
"__InputValue"
        [ FieldName -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall name (m :: * -> *) e.
(RenderIntrospection name, Monad m) =>
name -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
renderName FieldName
fieldName,
          Maybe Token -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall (m :: * -> *) e.
Monad m =>
Maybe Token -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
description Maybe Token
fieldDescription,
          TypeRef -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall (m :: * -> *) e.
Monad m =>
TypeRef -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
type' TypeRef
fieldType,
          Maybe (FieldContent TRUE IN VALID)
-> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall (m :: * -> *) e.
Monad m =>
Maybe (FieldContent TRUE IN VALID)
-> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
defaultValue Maybe (FieldContent TRUE IN VALID)
fieldContent
        ]

instance RenderIntrospection (DataEnumValue VALID) where
  render :: DataEnumValue VALID -> Resolver QUERY e m (ResModel QUERY e 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} =
    ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall a b. (a -> b) -> a -> b
$ TypeName
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
mkObject TypeName
"__Field" ([(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
 -> ResModel QUERY e m)
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall a b. (a -> b) -> a -> b
$
      [ TypeName -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall name (m :: * -> *) e.
(RenderIntrospection name, Monad m) =>
name -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
renderName TypeName
enumName,
        Maybe Token -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall (m :: * -> *) e.
Monad m =>
Maybe Token -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
description Maybe Token
enumDescription
      ]
        [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
forall a. Semigroup a => a -> a -> a
<> [Directive VALID]
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
forall (m :: * -> *) (s :: Stage) e.
Monad m =>
Directives s
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
renderDeprecated [Directive VALID]
enumDirectives

instance RenderIntrospection TypeRef where
  render :: TypeRef -> Resolver QUERY e m (ResModel QUERY e 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)
-> Resolver QUERY e m (TypeDefinition ANY VALID)
-> Resolver QUERY e m TypeKind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeName -> Resolver QUERY e m (TypeDefinition ANY VALID)
forall (m :: * -> *).
WithSchema m =>
TypeName -> m (TypeDefinition ANY VALID)
selectType TypeName
typeConName
    let currentType :: ResModel QUERY e m
currentType = TypeKind
-> TypeName
-> Maybe Token
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (m :: * -> *) name e.
(Monad m, RenderIntrospection name) =>
TypeKind
-> name
-> Maybe Token
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
mkType TypeKind
kind TypeName
typeConName Maybe Token
forall a. Maybe a
Nothing []
    ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m))
-> ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall a b. (a -> b) -> a -> b
$ (DataTypeWrapper -> ResModel QUERY e m -> ResModel QUERY e m)
-> ResModel QUERY e m -> [DataTypeWrapper] -> ResModel QUERY e m
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DataTypeWrapper -> ResModel QUERY e m -> ResModel QUERY e m
forall (m :: * -> *) e.
Monad m =>
DataTypeWrapper -> ResModel QUERY e m -> ResModel QUERY e m
wrap ResModel QUERY e m
currentType ([TypeWrapper] -> [DataTypeWrapper]
toGQLWrapper [TypeWrapper]
typeWrappers)
    where
      wrap :: Monad m => DataTypeWrapper -> ResModel QUERY e m -> ResModel QUERY e m
      wrap :: DataTypeWrapper -> ResModel QUERY e m -> ResModel QUERY e m
wrap DataTypeWrapper
wrapper ResModel QUERY e m
contentType =
        TypeName
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
mkObject
          TypeName
"__Type"
          [ TypeKind -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall (m :: * -> *) e.
Monad m =>
TypeKind -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
renderKind (DataTypeWrapper -> TypeKind
wrapperKind DataTypeWrapper
wrapper),
            (FieldName
"ofType", ResModel QUERY e m -> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResModel QUERY e m
contentType)
          ]
      wrapperKind :: DataTypeWrapper -> TypeKind
wrapperKind DataTypeWrapper
ListType = TypeKind
KindList
      wrapperKind DataTypeWrapper
NonNullType = TypeKind
KindNonNull

renderPossibleTypes ::
  (Monad m) =>
  TypeName ->
  Resolver QUERY e m (ResModel QUERY e m)
renderPossibleTypes :: TypeName -> Resolver QUERY e m (ResModel QUERY e m)
renderPossibleTypes TypeName
name =
  [ResModel QUERY e m] -> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
[ResModel o e m] -> ResModel o e m
mkList
    ([ResModel QUERY e m] -> ResModel QUERY e m)
-> Resolver QUERY e m [ResModel QUERY e m]
-> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Resolver QUERY e m (Schema VALID)
forall (m :: * -> *). WithSchema m => m (Schema VALID)
getSchema
            Resolver QUERY e m (Schema VALID)
-> (Schema VALID -> Resolver QUERY e m [ResModel QUERY e m])
-> Resolver QUERY e m [ResModel QUERY e m]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TypeDefinition ANY VALID
 -> Resolver QUERY e m (ResModel QUERY e m))
-> [TypeDefinition ANY VALID]
-> Resolver QUERY e m [ResModel QUERY e m]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TypeDefinition ANY VALID -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render ([TypeDefinition ANY VALID]
 -> Resolver QUERY e m [ResModel QUERY e m])
-> (Schema VALID -> [TypeDefinition ANY VALID])
-> Schema VALID
-> Resolver QUERY e m [ResModel QUERY e 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) =>
  Directives s ->
  [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
renderDeprecated :: Directives s
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
renderDeprecated Directives s
dirs =
  [ (FieldName
"isDeprecated", Bool -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e 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 -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e 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 => Maybe Description -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
description :: Maybe Token -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
description = (FieldName
"description",) (Resolver QUERY e m (ResModel QUERY e m)
 -> (FieldName, Resolver QUERY e m (ResModel QUERY e m)))
-> (Maybe Token -> Resolver QUERY e m (ResModel QUERY e m))
-> Maybe Token
-> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Token -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render

mkType ::
  (Monad m, RenderIntrospection name) =>
  TypeKind ->
  name ->
  Maybe Description ->
  [(FieldName, Resolver QUERY e m (ResModel QUERY e m))] ->
  ResModel QUERY e m
mkType :: TypeKind
-> name
-> Maybe Token
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
mkType TypeKind
kind name
name Maybe Token
desc [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
etc =
  TypeName
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
mkObject
    TypeName
"__Type"
    ( [ TypeKind -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall (m :: * -> *) e.
Monad m =>
TypeKind -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
renderKind TypeKind
kind,
        name -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall name (m :: * -> *) e.
(RenderIntrospection name, Monad m) =>
name -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
renderName name
name,
        Maybe Token -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall (m :: * -> *) e.
Monad m =>
Maybe Token -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
description Maybe Token
desc
      ]
        [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
forall a. Semigroup a => a -> a -> a
<> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
etc
    )

createObjectType ::
  Monad m =>
  TypeName ->
  Maybe Description ->
  [TypeName] ->
  FieldsDefinition OUT VALID ->
  ResModel QUERY e m
createObjectType :: TypeName
-> Maybe Token
-> [TypeName]
-> FieldsDefinition OUT VALID
-> ResModel QUERY e m
createObjectType TypeName
name Maybe Token
desc [TypeName]
interfaces FieldsDefinition OUT VALID
fields =
  TypeKind
-> TypeName
-> Maybe Token
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
forall (m :: * -> *) name e.
(Monad m, RenderIntrospection name) =>
TypeKind
-> name
-> Maybe Token
-> [(FieldName, Resolver QUERY e m (ResModel QUERY e m))]
-> ResModel QUERY e m
mkType (Maybe OperationType -> TypeKind
KindObject Maybe OperationType
forall a. Maybe a
Nothing) TypeName
name Maybe Token
desc [(FieldName
"fields", FieldsDefinition OUT VALID
-> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render FieldsDefinition OUT VALID
fields), (FieldName
"interfaces", [ResModel QUERY e m] -> ResModel QUERY e m
forall (o :: OperationType) e (m :: * -> *).
[ResModel o e m] -> ResModel o e m
mkList ([ResModel QUERY e m] -> ResModel QUERY e m)
-> Resolver QUERY e m [ResModel QUERY e m]
-> Resolver QUERY e m (ResModel QUERY e m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeName -> Resolver QUERY e m (ResModel QUERY e m))
-> [TypeName] -> Resolver QUERY e m [ResModel QUERY e m]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TypeName -> Resolver QUERY e m (ResModel QUERY e m)
forall (m :: * -> *) e.
Monad m =>
TypeName -> Resolver QUERY e m (ResModel QUERY e m)
implementedInterface [TypeName]
interfaces)]

implementedInterface ::
  (Monad m) =>
  TypeName ->
  Resolver QUERY e m (ResModel QUERY e m)
implementedInterface :: TypeName -> Resolver QUERY e m (ResModel QUERY e m)
implementedInterface TypeName
name =
  TypeName -> Resolver QUERY e m (TypeDefinition ANY VALID)
forall (m :: * -> *).
WithSchema m =>
TypeName -> m (TypeDefinition ANY VALID)
selectType TypeName
name
    Resolver QUERY e m (TypeDefinition ANY VALID)
-> (TypeDefinition ANY VALID
    -> Resolver QUERY e m (ResModel QUERY e m))
-> Resolver QUERY e m (ResModel QUERY e m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeDefinition ANY VALID -> Resolver QUERY e m (ResModel QUERY e m)
renderContent
  where
    renderContent :: TypeDefinition ANY VALID -> Resolver QUERY e m (ResModel QUERY e 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 -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render TypeDefinition ANY VALID
typeDef
    renderContent TypeDefinition ANY VALID
_ = Message -> Resolver QUERY e m (ResModel QUERY e 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
  ) =>
  name ->
  (FieldName, Resolver QUERY e m (ResModel QUERY e m))
renderName :: name -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
renderName = (FieldName
"name",) (Resolver QUERY e m (ResModel QUERY e m)
 -> (FieldName, Resolver QUERY e m (ResModel QUERY e m)))
-> (name -> Resolver QUERY e m (ResModel QUERY e m))
-> name
-> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. name -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render

renderKind :: Monad m => TypeKind -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
renderKind :: TypeKind -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
renderKind = (FieldName
"kind",) (Resolver QUERY e m (ResModel QUERY e m)
 -> (FieldName, Resolver QUERY e m (ResModel QUERY e m)))
-> (TypeKind -> Resolver QUERY e m (ResModel QUERY e m))
-> TypeKind
-> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeKind -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render

type' :: Monad m => TypeRef -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
type' :: TypeRef -> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
type' = (FieldName
"type",) (Resolver QUERY e m (ResModel QUERY e m)
 -> (FieldName, Resolver QUERY e m (ResModel QUERY e m)))
-> (TypeRef -> Resolver QUERY e m (ResModel QUERY e m))
-> TypeRef
-> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render

defaultValue ::
  Monad m =>
  Maybe (FieldContent TRUE IN VALID) ->
  ( FieldName,
    Resolver QUERY e m (ResModel QUERY e m)
  )
defaultValue :: Maybe (FieldContent TRUE IN VALID)
-> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
defaultValue = (FieldName
"defaultValue",) (Resolver QUERY e m (ResModel QUERY e m)
 -> (FieldName, Resolver QUERY e m (ResModel QUERY e m)))
-> (Maybe (FieldContent TRUE IN VALID)
    -> Resolver QUERY e m (ResModel QUERY e m))
-> Maybe (FieldContent TRUE IN VALID)
-> (FieldName, Resolver QUERY e m (ResModel QUERY e m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (FieldContent TRUE IN VALID)
-> Resolver QUERY e m (ResModel QUERY e m)
forall a (m :: * -> *) e.
(RenderIntrospection a, Monad m) =>
a -> Resolver QUERY e m (ResModel QUERY e m)
render