{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Validation.Document.Validation
  ( ValidateSchema (..),
  )
where

import Data.Morpheus.Ext.Result
  ( GQLResult,
  )
import Data.Morpheus.Internal.Utils ((<:>))
import Data.Morpheus.Schema.Schema
  ( internalSchema,
  )
import Data.Morpheus.Types.Internal.AST
  ( ArgumentDefinition (..),
    CONST,
    DataEnumValue (..),
    DirectiveDefinition (..),
    DirectiveLocation (..),
    FieldContent (..),
    FieldDefinition (..),
    FieldName,
    IN,
    OUT,
    Schema (..),
    TRUE,
    TypeCategory,
    TypeContent (..),
    TypeDefinition (..),
    TypeRef (..),
    Typed (..),
    UnionMember (..),
    VALID,
    Value,
  )
import Data.Morpheus.Types.Internal.Config (Config (..))
import Data.Morpheus.Types.Internal.Validation
  ( InputSource (..),
    ValidatorContext (localContext),
    startInput,
  )
import Data.Morpheus.Types.Internal.Validation.SchemaValidator
  ( Field (..),
    ON_TYPE,
    SchemaValidator,
    TypeEntity (..),
    TypeSystemContext (..),
    inField,
    inType,
    runSchemaValidator,
  )
import Data.Morpheus.Validation.Document.Interface (validateImplements)
import Data.Morpheus.Validation.Internal.Directive
  ( validateDirectives,
  )
import Data.Morpheus.Validation.Internal.Value
  ( validateInputByTypeRef,
  )
import Relude hiding (empty, local)

class ValidateSchema s where
  validateSchema :: Bool -> Config -> Schema s -> GQLResult (Schema VALID)

instance ValidateSchema CONST where
  validateSchema :: Bool -> Config -> Schema CONST -> GQLResult (Schema VALID)
validateSchema Bool
withSystem Config
config Schema CONST
schema = do
    Schema CONST
sysSchema <-
      if Bool
withSystem
        then Schema CONST
forall (s :: Stage). Schema s
internalSchema Schema CONST -> Schema CONST -> Result GQLError (Schema CONST)
forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> Schema CONST
schema
        else Schema CONST -> Result GQLError (Schema CONST)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema CONST
schema
    Validator CONST (TypeSystemContext ()) (Schema VALID)
-> Config -> Schema CONST -> GQLResult (Schema VALID)
forall (s :: Stage) a.
Validator s (TypeSystemContext ()) a
-> Config -> Schema s -> GQLResult a
runSchemaValidator (Schema CONST -> SchemaValidator (TypeContext Schema) (Schema VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck Schema CONST
schema) Config
config Schema CONST
sysSchema

instance ValidateSchema VALID where
  validateSchema :: Bool -> Config -> Schema VALID -> GQLResult (Schema VALID)
validateSchema Bool
_ Config
_ = Schema VALID -> GQLResult (Schema VALID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

----- TypeCheck -------------------------------
---
---
---
class TypeCheck a where
  type TypeContext a :: Type
  type TypeContext a = ()
  typeCheck :: a CONST -> SchemaValidator (TypeContext a) (a VALID)

instance TypeCheck Schema where
  typeCheck :: Schema CONST -> SchemaValidator (TypeContext Schema) (Schema VALID)
typeCheck
    Schema
      { TypeDefinitions CONST
types :: forall (s :: Stage). Schema s -> TypeDefinitions s
types :: TypeDefinitions CONST
types,
        TypeDefinition OBJECT CONST
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query :: TypeDefinition OBJECT CONST
query,
        Maybe (TypeDefinition OBJECT CONST)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT CONST)
mutation,
        Maybe (TypeDefinition OBJECT CONST)
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT CONST)
subscription,
        DirectivesDefinition CONST
directiveDefinitions :: forall (s :: Stage). Schema s -> DirectivesDefinition s
directiveDefinitions :: DirectivesDefinition CONST
directiveDefinitions
      } =
      TypeDefinitions VALID
-> TypeDefinition OBJECT VALID
-> Maybe (TypeDefinition OBJECT VALID)
-> Maybe (TypeDefinition OBJECT VALID)
-> DirectivesDefinition VALID
-> Schema VALID
forall (s :: Stage).
TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s
Schema
        (TypeDefinitions VALID
 -> TypeDefinition OBJECT VALID
 -> Maybe (TypeDefinition OBJECT VALID)
 -> Maybe (TypeDefinition OBJECT VALID)
 -> DirectivesDefinition VALID
 -> Schema VALID)
-> Validator CONST (TypeSystemContext ()) (TypeDefinitions VALID)
-> Validator
     CONST
     (TypeSystemContext ())
     (TypeDefinition OBJECT VALID
      -> Maybe (TypeDefinition OBJECT VALID)
      -> Maybe (TypeDefinition OBJECT VALID)
      -> DirectivesDefinition VALID
      -> Schema VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeDefinition ANY CONST
 -> Validator
      CONST (TypeSystemContext ()) (TypeDefinition ANY VALID))
-> TypeDefinitions CONST
-> Validator CONST (TypeSystemContext ()) (TypeDefinitions VALID)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TypeDefinition ANY CONST
-> Validator
     CONST (TypeSystemContext ()) (TypeDefinition ANY VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck TypeDefinitions CONST
types
        Validator
  CONST
  (TypeSystemContext ())
  (TypeDefinition OBJECT VALID
   -> Maybe (TypeDefinition OBJECT VALID)
   -> Maybe (TypeDefinition OBJECT VALID)
   -> DirectivesDefinition VALID
   -> Schema VALID)
-> Validator
     CONST (TypeSystemContext ()) (TypeDefinition OBJECT VALID)
-> Validator
     CONST
     (TypeSystemContext ())
     (Maybe (TypeDefinition OBJECT VALID)
      -> Maybe (TypeDefinition OBJECT VALID)
      -> DirectivesDefinition VALID
      -> Schema VALID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeDefinition OBJECT CONST
-> SchemaValidator
     (TypeContext (TypeDefinition OBJECT)) (TypeDefinition OBJECT VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck TypeDefinition OBJECT CONST
query
        Validator
  CONST
  (TypeSystemContext ())
  (Maybe (TypeDefinition OBJECT VALID)
   -> Maybe (TypeDefinition OBJECT VALID)
   -> DirectivesDefinition VALID
   -> Schema VALID)
-> Validator
     CONST (TypeSystemContext ()) (Maybe (TypeDefinition OBJECT VALID))
-> Validator
     CONST
     (TypeSystemContext ())
     (Maybe (TypeDefinition OBJECT VALID)
      -> DirectivesDefinition VALID -> Schema VALID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TypeDefinition OBJECT CONST
 -> Validator
      CONST (TypeSystemContext ()) (TypeDefinition OBJECT VALID))
-> Maybe (TypeDefinition OBJECT CONST)
-> Validator
     CONST (TypeSystemContext ()) (Maybe (TypeDefinition OBJECT VALID))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TypeDefinition OBJECT CONST
-> Validator
     CONST (TypeSystemContext ()) (TypeDefinition OBJECT VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck Maybe (TypeDefinition OBJECT CONST)
mutation
        Validator
  CONST
  (TypeSystemContext ())
  (Maybe (TypeDefinition OBJECT VALID)
   -> DirectivesDefinition VALID -> Schema VALID)
-> Validator
     CONST (TypeSystemContext ()) (Maybe (TypeDefinition OBJECT VALID))
-> Validator
     CONST
     (TypeSystemContext ())
     (DirectivesDefinition VALID -> Schema VALID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TypeDefinition OBJECT CONST
 -> Validator
      CONST (TypeSystemContext ()) (TypeDefinition OBJECT VALID))
-> Maybe (TypeDefinition OBJECT CONST)
-> Validator
     CONST (TypeSystemContext ()) (Maybe (TypeDefinition OBJECT VALID))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TypeDefinition OBJECT CONST
-> Validator
     CONST (TypeSystemContext ()) (TypeDefinition OBJECT VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck Maybe (TypeDefinition OBJECT CONST)
subscription
        Validator
  CONST
  (TypeSystemContext ())
  (DirectivesDefinition VALID -> Schema VALID)
-> Validator
     CONST (TypeSystemContext ()) (DirectivesDefinition VALID)
-> Validator CONST (TypeSystemContext ()) (Schema VALID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DirectiveDefinition CONST
 -> Validator
      CONST (TypeSystemContext ()) (DirectiveDefinition VALID))
-> DirectivesDefinition CONST
-> Validator
     CONST (TypeSystemContext ()) (DirectivesDefinition VALID)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse DirectiveDefinition CONST
-> Validator
     CONST (TypeSystemContext ()) (DirectiveDefinition VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck DirectivesDefinition CONST
directiveDefinitions

instance TypeCheck (TypeDefinition cat) where
  typeCheck :: TypeDefinition cat CONST
-> SchemaValidator
     (TypeContext (TypeDefinition cat)) (TypeDefinition cat VALID)
typeCheck
    TypeDefinition
      { TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName :: TypeName
typeName,
        Maybe Description
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Description
typeDescription :: Maybe Description
typeDescription,
        Directives CONST
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeDirectives :: Directives CONST
typeDirectives,
        TypeContent TRUE cat CONST
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent :: TypeContent TRUE cat CONST
typeContent
      } =
      TypeName
-> SchemaValidator (TypeEntity 'ON_TYPE) (TypeDefinition cat VALID)
-> SchemaValidator () (TypeDefinition cat VALID)
forall v.
TypeName
-> SchemaValidator (TypeEntity 'ON_TYPE) v -> SchemaValidator () v
inType TypeName
typeName (SchemaValidator (TypeEntity 'ON_TYPE) (TypeDefinition cat VALID)
 -> SchemaValidator () (TypeDefinition cat VALID))
-> SchemaValidator (TypeEntity 'ON_TYPE) (TypeDefinition cat VALID)
-> SchemaValidator () (TypeDefinition cat VALID)
forall a b. (a -> b) -> a -> b
$
        Maybe Description
-> TypeName
-> Directives VALID
-> TypeContent TRUE cat VALID
-> TypeDefinition cat VALID
forall (a :: TypeCategory) (s :: Stage).
Maybe Description
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition
          Maybe Description
typeDescription
          TypeName
typeName
          (Directives VALID
 -> TypeContent TRUE cat VALID -> TypeDefinition cat VALID)
-> Validator
     CONST (TypeSystemContext (TypeEntity 'ON_TYPE)) (Directives VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (TypeContent TRUE cat VALID -> TypeDefinition cat VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirectiveLocation
-> Directives CONST
-> Validator
     CONST (TypeSystemContext (TypeEntity 'ON_TYPE)) (Directives VALID)
forall ctx (schemaS :: Stage) (s :: Stage).
ArgumentsConstraints ctx schemaS s =>
DirectiveLocation
-> Directives s -> Validator schemaS ctx (Directives VALID)
validateDirectives (TypeContent TRUE cat CONST -> DirectiveLocation
forall (a :: Bool) (b :: TypeCategory) (c :: Stage).
TypeContent a b c -> DirectiveLocation
typeDirectiveLocation TypeContent TRUE cat CONST
typeContent) Directives CONST
typeDirectives
          Validator
  CONST
  (TypeSystemContext (TypeEntity 'ON_TYPE))
  (TypeContent TRUE cat VALID -> TypeDefinition cat VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (TypeContent TRUE cat VALID)
-> SchemaValidator (TypeEntity 'ON_TYPE) (TypeDefinition cat VALID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeContent TRUE cat CONST
-> SchemaValidator
     (TypeContext (TypeContent TRUE cat)) (TypeContent TRUE cat VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck TypeContent TRUE cat CONST
typeContent

typeDirectiveLocation :: TypeContent a b c -> DirectiveLocation
typeDirectiveLocation :: TypeContent a b c -> DirectiveLocation
typeDirectiveLocation DataObject {} = DirectiveLocation
OBJECT
typeDirectiveLocation DataInputObject {} = DirectiveLocation
INPUT_OBJECT
typeDirectiveLocation DataScalar {} = DirectiveLocation
SCALAR
typeDirectiveLocation DataEnum {} = DirectiveLocation
ENUM
typeDirectiveLocation DataInputUnion {} = DirectiveLocation
OBJECT
typeDirectiveLocation DataUnion {} = DirectiveLocation
UNION
typeDirectiveLocation DataInterface {} = DirectiveLocation
INTERFACE

instance TypeCheck (TypeContent TRUE cat) where
  type TypeContext (TypeContent TRUE cat) = TypeEntity ON_TYPE
  typeCheck :: TypeContent TRUE cat CONST
-> SchemaValidator
     (TypeContext (TypeContent TRUE cat)) (TypeContent TRUE cat VALID)
typeCheck DataObject {[TypeName]
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> [TypeName]
objectImplements :: [TypeName]
objectImplements, FieldsDefinition OUT CONST
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT CONST
objectFields} =
    [TypeName]
-> OrdMap (Name 'FIELD) (FieldDefinition OUT VALID)
-> TypeContent TRUE cat VALID
forall (s :: Stage) (a :: TypeCategory).
[TypeName] -> FieldsDefinition OUT s -> CondTypeContent OBJECT a s
DataObject
      ([TypeName]
 -> OrdMap (Name 'FIELD) (FieldDefinition OUT VALID)
 -> TypeContent TRUE cat VALID)
-> Validator
     CONST (TypeSystemContext (TypeEntity 'ON_TYPE)) [TypeName]
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (OrdMap (Name 'FIELD) (FieldDefinition OUT VALID)
      -> TypeContent TRUE cat VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeName]
-> FieldsDefinition OUT CONST
-> Validator
     CONST (TypeSystemContext (TypeEntity 'ON_TYPE)) [TypeName]
validateImplements [TypeName]
objectImplements FieldsDefinition OUT CONST
objectFields
      Validator
  CONST
  (TypeSystemContext (TypeEntity 'ON_TYPE))
  (OrdMap (Name 'FIELD) (FieldDefinition OUT VALID)
   -> TypeContent TRUE cat VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (OrdMap (Name 'FIELD) (FieldDefinition OUT VALID))
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (TypeContent TRUE cat VALID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FieldDefinition OUT CONST
 -> Validator
      CONST
      (TypeSystemContext (TypeEntity 'ON_TYPE))
      (FieldDefinition OUT VALID))
-> FieldsDefinition OUT CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (OrdMap (Name 'FIELD) (FieldDefinition OUT VALID))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldDefinition OUT CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (FieldDefinition OUT VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck FieldsDefinition OUT CONST
objectFields
  typeCheck DataInputObject {FieldsDefinition IN CONST
inputObjectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN CONST
inputObjectFields} =
    FieldsDefinition IN VALID -> TypeContent TRUE cat VALID
forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition IN s -> CondTypeContent INPUT_OBJECT a s
DataInputObject (FieldsDefinition IN VALID -> TypeContent TRUE cat VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (FieldsDefinition IN VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (TypeContent TRUE cat VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldDefinition IN CONST
 -> Validator
      CONST
      (TypeSystemContext (TypeEntity 'ON_TYPE))
      (FieldDefinition IN VALID))
-> FieldsDefinition IN CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (FieldsDefinition IN VALID)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldDefinition IN CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (FieldDefinition IN VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck FieldsDefinition IN CONST
inputObjectFields
  typeCheck DataScalar {ScalarDefinition
dataScalar :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF a s -> ScalarDefinition
dataScalar :: ScalarDefinition
..} = TypeContent TRUE cat VALID
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (TypeContent TRUE cat VALID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataScalar :: forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> CondTypeContent LEAF a s
DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
  typeCheck DataEnum {DataEnum CONST
enumMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF a s -> DataEnum s
enumMembers :: DataEnum CONST
enumMembers} = DataEnum VALID -> TypeContent TRUE cat VALID
forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> CondTypeContent LEAF a s
DataEnum (DataEnum VALID -> TypeContent TRUE cat VALID)
-> Validator
     CONST (TypeSystemContext (TypeEntity 'ON_TYPE)) (DataEnum VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (TypeContent TRUE cat VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DataEnumValue CONST
 -> Validator
      CONST
      (TypeSystemContext (TypeEntity 'ON_TYPE))
      (DataEnumValue VALID))
-> DataEnum CONST
-> Validator
     CONST (TypeSystemContext (TypeEntity 'ON_TYPE)) (DataEnum VALID)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse DataEnumValue CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (DataEnumValue VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck DataEnum CONST
enumMembers
  typeCheck DataInputUnion {UnionTypeDefinition IN CONST
inputUnionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IN a s -> UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN CONST
inputUnionMembers} =
    UnionTypeDefinition IN VALID -> TypeContent TRUE cat VALID
forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition IN s -> CondTypeContent IN a s
DataInputUnion (UnionTypeDefinition IN VALID -> TypeContent TRUE cat VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (UnionTypeDefinition IN VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (TypeContent TRUE cat VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UnionMember IN CONST
 -> Validator
      CONST
      (TypeSystemContext (TypeEntity 'ON_TYPE))
      (UnionMember IN VALID))
-> UnionTypeDefinition IN CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (UnionTypeDefinition IN VALID)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse UnionMember IN CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (UnionMember IN VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck UnionTypeDefinition IN CONST
inputUnionMembers
  typeCheck DataUnion {UnionTypeDefinition OUT CONST
unionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OUT a s -> UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT CONST
unionMembers} = UnionTypeDefinition OUT VALID -> TypeContent TRUE cat VALID
forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition OUT s -> CondTypeContent OUT a s
DataUnion (UnionTypeDefinition OUT VALID -> TypeContent TRUE cat VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (UnionTypeDefinition OUT VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (TypeContent TRUE cat VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UnionMember OUT CONST
 -> Validator
      CONST
      (TypeSystemContext (TypeEntity 'ON_TYPE))
      (UnionMember OUT VALID))
-> UnionTypeDefinition OUT CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (UnionTypeDefinition OUT VALID)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse UnionMember OUT CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (UnionMember OUT VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck UnionTypeDefinition OUT CONST
unionMembers
  typeCheck (DataInterface FieldsDefinition OUT CONST
fields) = OrdMap (Name 'FIELD) (FieldDefinition OUT VALID)
-> TypeContent TRUE cat VALID
forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> CondTypeContent IMPLEMENTABLE a s
DataInterface (OrdMap (Name 'FIELD) (FieldDefinition OUT VALID)
 -> TypeContent TRUE cat VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (OrdMap (Name 'FIELD) (FieldDefinition OUT VALID))
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (TypeContent TRUE cat VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldDefinition OUT CONST
 -> Validator
      CONST
      (TypeSystemContext (TypeEntity 'ON_TYPE))
      (FieldDefinition OUT VALID))
-> FieldsDefinition OUT CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (OrdMap (Name 'FIELD) (FieldDefinition OUT VALID))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldDefinition OUT CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (FieldDefinition OUT VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck FieldsDefinition OUT CONST
fields

instance FieldDirectiveLocation cat => TypeCheck (FieldDefinition cat) where
  type TypeContext (FieldDefinition cat) = TypeEntity ON_TYPE
  typeCheck :: FieldDefinition cat CONST
-> SchemaValidator
     (TypeContext (FieldDefinition cat)) (FieldDefinition cat VALID)
typeCheck FieldDefinition {Maybe Description
Maybe (FieldContent TRUE cat CONST)
Directives CONST
Name 'FIELD
TypeRef
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives 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 -> Name 'FIELD
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
fieldDirectives :: Directives CONST
fieldContent :: Maybe (FieldContent TRUE cat CONST)
fieldType :: TypeRef
fieldName :: Name 'FIELD
fieldDescription :: Maybe Description
..} =
    Name 'FIELD
-> SchemaValidator (Field 'ON_TYPE) (FieldDefinition cat VALID)
-> SchemaValidator
     (TypeEntity 'ON_TYPE) (FieldDefinition cat VALID)
forall (p :: PLACE) v.
Name 'FIELD
-> SchemaValidator (Field p) v -> SchemaValidator (TypeEntity p) v
inField
      Name 'FIELD
fieldName
      ( Maybe Description
-> Name 'FIELD
-> TypeRef
-> Maybe (FieldContent TRUE cat VALID)
-> Directives VALID
-> FieldDefinition cat VALID
forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> Name 'FIELD
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
          Maybe Description
fieldDescription
          Name 'FIELD
fieldName
          TypeRef
fieldType
          (Maybe (FieldContent TRUE cat VALID)
 -> Directives VALID -> FieldDefinition cat VALID)
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (Maybe (FieldContent TRUE cat VALID))
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (Directives VALID -> FieldDefinition cat VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldContent TRUE cat CONST
 -> Validator
      CONST
      (TypeSystemContext (Field 'ON_TYPE))
      (FieldContent TRUE cat VALID))
-> Maybe (FieldContent TRUE cat CONST)
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (Maybe (FieldContent TRUE cat VALID))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldContent TRUE cat CONST
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (FieldContent TRUE cat VALID)
checkFieldContent Maybe (FieldContent TRUE cat CONST)
fieldContent
          Validator
  CONST
  (TypeSystemContext (Field 'ON_TYPE))
  (Directives VALID -> FieldDefinition cat VALID)
-> Validator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Directives VALID)
-> SchemaValidator (Field 'ON_TYPE) (FieldDefinition cat VALID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DirectiveLocation
-> Directives CONST
-> Validator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Directives VALID)
forall ctx (schemaS :: Stage) (s :: Stage).
ArgumentsConstraints ctx schemaS s =>
DirectiveLocation
-> Directives s -> Validator schemaS ctx (Directives VALID)
validateDirectives (Proxy cat -> DirectiveLocation
forall (cat :: TypeCategory).
FieldDirectiveLocation cat =>
Proxy cat -> DirectiveLocation
directiveLocation (Proxy cat
forall k (t :: k). Proxy t
Proxy @cat)) Directives CONST
fieldDirectives
      )
    where
      checkFieldContent :: FieldContent TRUE cat CONST -> SchemaValidator (Field ON_TYPE) (FieldContent TRUE cat VALID)
      checkFieldContent :: FieldContent TRUE cat CONST
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (FieldContent TRUE cat VALID)
checkFieldContent (FieldArgs ArgumentsDefinition CONST
args) = ArgumentsDefinition VALID -> FieldContent TRUE cat VALID
forall (s :: Stage) (cat :: TypeCategory).
ArgumentsDefinition s -> FieldContent (OUT <=? cat) cat s
FieldArgs (ArgumentsDefinition VALID -> FieldContent TRUE cat VALID)
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (ArgumentsDefinition VALID)
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (FieldContent TRUE cat VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArgumentDefinition CONST
 -> Validator
      CONST
      (TypeSystemContext (Field 'ON_TYPE))
      (ArgumentDefinition VALID))
-> ArgumentsDefinition CONST
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (ArgumentsDefinition VALID)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ArgumentDefinition CONST
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (ArgumentDefinition VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck ArgumentsDefinition CONST
args
      checkFieldContent (DefaultInputValue Value CONST
value) = Value VALID -> FieldContent TRUE cat VALID
forall (s :: Stage) (cat :: TypeCategory).
Value s -> FieldContent (IN <=? cat) cat s
DefaultInputValue (Value VALID -> FieldContent TRUE cat VALID)
-> Validator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Value VALID)
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (FieldContent TRUE cat VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRef
-> Maybe (Name 'FIELD)
-> Value CONST
-> Validator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Value VALID)
validateDefaultValue TypeRef
fieldType Maybe (Name 'FIELD)
forall a. Maybe a
Nothing Value CONST
value

class FieldDirectiveLocation (cat :: TypeCategory) where
  directiveLocation :: Proxy cat -> DirectiveLocation

instance FieldDirectiveLocation OUT where
  directiveLocation :: Proxy OUT -> DirectiveLocation
directiveLocation Proxy OUT
_ = DirectiveLocation
FIELD_DEFINITION

instance FieldDirectiveLocation IN where
  directiveLocation :: Proxy IN -> DirectiveLocation
directiveLocation Proxy IN
_ = DirectiveLocation
INPUT_FIELD_DEFINITION

instance TypeCheck DirectiveDefinition where
  typeCheck :: DirectiveDefinition CONST
-> SchemaValidator
     (TypeContext DirectiveDefinition) (DirectiveDefinition VALID)
typeCheck DirectiveDefinition {directiveDefinitionArgs :: forall (s :: Stage). DirectiveDefinition s -> ArgumentsDefinition s
directiveDefinitionArgs = ArgumentsDefinition CONST
arguments, [DirectiveLocation]
Maybe Description
Name 'FIELD
directiveDefinitionLocations :: forall (s :: Stage). DirectiveDefinition s -> [DirectiveLocation]
directiveDefinitionDescription :: forall (s :: Stage). DirectiveDefinition s -> Maybe Description
directiveDefinitionName :: forall (s :: Stage). DirectiveDefinition s -> Name 'FIELD
directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionDescription :: Maybe Description
directiveDefinitionName :: Name 'FIELD
..} =
    TypeName
-> SchemaValidator
     (TypeEntity 'ON_TYPE) (DirectiveDefinition VALID)
-> Validator
     CONST (TypeSystemContext ()) (DirectiveDefinition VALID)
forall v.
TypeName
-> SchemaValidator (TypeEntity 'ON_TYPE) v -> SchemaValidator () v
inType TypeName
"Directive" (SchemaValidator (TypeEntity 'ON_TYPE) (DirectiveDefinition VALID)
 -> Validator
      CONST (TypeSystemContext ()) (DirectiveDefinition VALID))
-> SchemaValidator
     (TypeEntity 'ON_TYPE) (DirectiveDefinition VALID)
-> Validator
     CONST (TypeSystemContext ()) (DirectiveDefinition VALID)
forall a b. (a -> b) -> a -> b
$
      Name 'FIELD
-> SchemaValidator (Field 'ON_TYPE) (DirectiveDefinition VALID)
-> SchemaValidator
     (TypeEntity 'ON_TYPE) (DirectiveDefinition VALID)
forall (p :: PLACE) v.
Name 'FIELD
-> SchemaValidator (Field p) v -> SchemaValidator (TypeEntity p) v
inField Name 'FIELD
directiveDefinitionName (SchemaValidator (Field 'ON_TYPE) (DirectiveDefinition VALID)
 -> SchemaValidator
      (TypeEntity 'ON_TYPE) (DirectiveDefinition VALID))
-> SchemaValidator (Field 'ON_TYPE) (DirectiveDefinition VALID)
-> SchemaValidator
     (TypeEntity 'ON_TYPE) (DirectiveDefinition VALID)
forall a b. (a -> b) -> a -> b
$ do
        ArgumentsDefinition VALID
directiveDefinitionArgs <- (ArgumentDefinition CONST
 -> Validator
      CONST
      (TypeSystemContext (Field 'ON_TYPE))
      (ArgumentDefinition VALID))
-> ArgumentsDefinition CONST
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (ArgumentsDefinition VALID)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ArgumentDefinition CONST
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (ArgumentDefinition VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck ArgumentsDefinition CONST
arguments
        DirectiveDefinition VALID
-> SchemaValidator (Field 'ON_TYPE) (DirectiveDefinition VALID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DirectiveDefinition :: forall (s :: Stage).
Name 'FIELD
-> Maybe Description
-> ArgumentsDefinition s
-> [DirectiveLocation]
-> DirectiveDefinition s
DirectiveDefinition {[DirectiveLocation]
Maybe Description
ArgumentsDefinition VALID
Name 'FIELD
directiveDefinitionArgs :: ArgumentsDefinition VALID
directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionDescription :: Maybe Description
directiveDefinitionName :: Name 'FIELD
directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionDescription :: Maybe Description
directiveDefinitionName :: Name 'FIELD
directiveDefinitionArgs :: ArgumentsDefinition VALID
..}

instance TypeCheck ArgumentDefinition where
  type TypeContext ArgumentDefinition = Field ON_TYPE
  typeCheck :: ArgumentDefinition CONST
-> SchemaValidator
     (TypeContext ArgumentDefinition) (ArgumentDefinition VALID)
typeCheck (ArgumentDefinition FieldDefinition {Maybe Description
Maybe (FieldContent TRUE IN CONST)
Directives CONST
Name 'FIELD
TypeRef
fieldDirectives :: Directives CONST
fieldContent :: Maybe (FieldContent TRUE IN CONST)
fieldType :: TypeRef
fieldName :: Name 'FIELD
fieldDescription :: Maybe Description
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives 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 -> Name 'FIELD
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
..}) =
    FieldDefinition IN VALID -> ArgumentDefinition VALID
forall (s :: Stage). FieldDefinition IN s -> ArgumentDefinition s
ArgumentDefinition
      (FieldDefinition IN VALID -> ArgumentDefinition VALID)
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (FieldDefinition IN VALID)
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (ArgumentDefinition VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Maybe Description
-> Name 'FIELD
-> TypeRef
-> Maybe (FieldContent TRUE IN VALID)
-> Directives VALID
-> FieldDefinition IN VALID
forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> Name 'FIELD
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
              Maybe Description
fieldDescription
              Name 'FIELD
fieldName
              TypeRef
fieldType
              (Maybe (FieldContent TRUE IN VALID)
 -> Directives VALID -> FieldDefinition IN VALID)
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (Maybe (FieldContent TRUE IN VALID))
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (Directives VALID -> FieldDefinition IN VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldContent TRUE IN CONST
 -> Validator
      CONST
      (TypeSystemContext (Field 'ON_TYPE))
      (FieldContent TRUE IN VALID))
-> Maybe (FieldContent TRUE IN CONST)
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (Maybe (FieldContent TRUE IN VALID))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldContent TRUE IN CONST
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (FieldContent TRUE IN VALID)
checkArgumentDefaultValue Maybe (FieldContent TRUE IN CONST)
fieldContent
              Validator
  CONST
  (TypeSystemContext (Field 'ON_TYPE))
  (Directives VALID -> FieldDefinition IN VALID)
-> Validator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Directives VALID)
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (FieldDefinition IN VALID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DirectiveLocation
-> Directives CONST
-> Validator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Directives VALID)
forall ctx (schemaS :: Stage) (s :: Stage).
ArgumentsConstraints ctx schemaS s =>
DirectiveLocation
-> Directives s -> Validator schemaS ctx (Directives VALID)
validateDirectives DirectiveLocation
ARGUMENT_DEFINITION Directives CONST
fieldDirectives
          )
    where
      checkArgumentDefaultValue :: FieldContent TRUE IN CONST
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (FieldContent TRUE IN VALID)
checkArgumentDefaultValue (DefaultInputValue Value CONST
value) =
        Value VALID -> FieldContent TRUE IN VALID
forall (s :: Stage) (cat :: TypeCategory).
Value s -> FieldContent (IN <=? cat) cat s
DefaultInputValue
          (Value VALID -> FieldContent TRUE IN VALID)
-> Validator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Value VALID)
-> Validator
     CONST
     (TypeSystemContext (Field 'ON_TYPE))
     (FieldContent TRUE IN VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRef
-> Maybe (Name 'FIELD)
-> Value CONST
-> Validator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Value VALID)
validateDefaultValue TypeRef
fieldType (Name 'FIELD -> Maybe (Name 'FIELD)
forall a. a -> Maybe a
Just Name 'FIELD
fieldName) Value CONST
value

validateDefaultValue ::
  TypeRef ->
  Maybe FieldName ->
  Value CONST ->
  SchemaValidator (Field ON_TYPE) (Value VALID)
validateDefaultValue :: TypeRef
-> Maybe (Name 'FIELD)
-> Value CONST
-> Validator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Value VALID)
validateDefaultValue TypeRef
typeRef Maybe (Name 'FIELD)
argName Value CONST
value = do
  Field Name 'FIELD
fName Maybe (Name 'FIELD)
_ (TypeEntity InterfaceName 'ON_TYPE
_ TypeName
typeName) <- (ValidatorContext CONST (TypeSystemContext (Field 'ON_TYPE))
 -> Field 'ON_TYPE)
-> Validator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Field 'ON_TYPE)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (TypeSystemContext (Field 'ON_TYPE) -> Field 'ON_TYPE
forall c. TypeSystemContext c -> c
local (TypeSystemContext (Field 'ON_TYPE) -> Field 'ON_TYPE)
-> (ValidatorContext CONST (TypeSystemContext (Field 'ON_TYPE))
    -> TypeSystemContext (Field 'ON_TYPE))
-> ValidatorContext CONST (TypeSystemContext (Field 'ON_TYPE))
-> Field 'ON_TYPE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatorContext CONST (TypeSystemContext (Field 'ON_TYPE))
-> TypeSystemContext (Field 'ON_TYPE)
forall (s :: Stage) ctx. ValidatorContext s ctx -> ctx
localContext)
  InputSource
-> InputValidator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Value VALID)
-> Validator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Value VALID)
forall (s :: Stage) ctx a.
InputSource -> InputValidator s ctx a -> Validator s ctx a
startInput (TypeName -> Name 'FIELD -> Maybe (Name 'FIELD) -> InputSource
SourceInputField TypeName
typeName Name 'FIELD
fName Maybe (Name 'FIELD)
argName) (Typed IN CONST TypeRef
-> Value CONST
-> InputValidator
     CONST (TypeSystemContext (Field 'ON_TYPE)) (Value VALID)
forall c (schemaS :: Stage) (s :: Stage).
ValidateWithDefault c schemaS s =>
Typed IN schemaS TypeRef
-> Value s -> Validator schemaS (InputContext c) (Value VALID)
validateInputByTypeRef (TypeRef -> Typed IN CONST TypeRef
forall (cat :: TypeCategory) (s :: Stage) a. a -> Typed cat s a
Typed TypeRef
typeRef) Value CONST
value)

instance TypeCheck DataEnumValue where
  type TypeContext DataEnumValue = TypeEntity ON_TYPE
  typeCheck :: DataEnumValue CONST
-> SchemaValidator
     (TypeContext DataEnumValue) (DataEnumValue VALID)
typeCheck DataEnumValue {enumDirectives :: forall (s :: Stage). DataEnumValue s -> Directives s
enumDirectives = Directives CONST
directives, Maybe Description
TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumDescription :: forall (s :: Stage). DataEnumValue s -> Maybe Description
enumName :: TypeName
enumDescription :: Maybe Description
..} =
    Maybe Description
-> TypeName -> Directives VALID -> DataEnumValue VALID
forall (s :: Stage).
Maybe Description -> TypeName -> Directives s -> DataEnumValue s
DataEnumValue Maybe Description
enumDescription TypeName
enumName
      (Directives VALID -> DataEnumValue VALID)
-> Validator
     CONST (TypeSystemContext (TypeEntity 'ON_TYPE)) (Directives VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (DataEnumValue VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirectiveLocation
-> Directives CONST
-> Validator
     CONST (TypeSystemContext (TypeEntity 'ON_TYPE)) (Directives VALID)
forall ctx (schemaS :: Stage) (s :: Stage).
ArgumentsConstraints ctx schemaS s =>
DirectiveLocation
-> Directives s -> Validator schemaS ctx (Directives VALID)
validateDirectives DirectiveLocation
ENUM_VALUE Directives CONST
directives

instance TypeCheck (UnionMember cat) where
  type TypeContext (UnionMember cat) = TypeEntity ON_TYPE
  typeCheck :: UnionMember cat CONST
-> SchemaValidator
     (TypeContext (UnionMember cat)) (UnionMember cat VALID)
typeCheck UnionMember {Bool
TypeName
nullary :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> Bool
memberName :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
nullary :: Bool
memberName :: TypeName
..} = UnionMember cat VALID
-> Validator
     CONST
     (TypeSystemContext (TypeEntity 'ON_TYPE))
     (UnionMember cat VALID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnionMember :: forall (cat :: TypeCategory) (s :: Stage).
TypeName -> Bool -> UnionMember cat s
UnionMember {Bool
TypeName
nullary :: Bool
memberName :: TypeName
nullary :: Bool
memberName :: TypeName
..}