{-# 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 Control.Monad.Except (MonadError (..))
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,
    Msg (..),
    OUT,
    Schema (..),
    TRUE,
    TypeCategory,
    TypeContent (..),
    TypeDefinition (..),
    TypeRef (..),
    Typed (..),
    UnionMember (..),
    VALID,
    Value,
  )
import Data.Morpheus.Types.Internal.AST.Error (GQLError)
import Data.Morpheus.Types.Internal.AST.Name (Name, isValidName)
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 a. a -> Result GQLError a
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 a. a -> Result GQLError a
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 :: TypeDefinitions CONST
types :: forall (s :: Stage). Schema s -> TypeDefinitions s
types,
        TypeDefinition OBJECT CONST
query :: TypeDefinition OBJECT CONST
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query,
        Maybe (TypeDefinition OBJECT CONST)
mutation :: Maybe (TypeDefinition OBJECT CONST)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation,
        Maybe (TypeDefinition OBJECT CONST)
subscription :: Maybe (TypeDefinition OBJECT CONST)
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription,
        DirectivesDefinition CONST
directiveDefinitions :: DirectivesDefinition CONST
directiveDefinitions :: forall (s :: Stage). Schema s -> DirectivesDefinition s
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SafeHashMap TypeName a -> f (SafeHashMap TypeName b)
traverse TypeDefinition ANY CONST
-> Validator
     CONST (TypeSystemContext ()) (TypeDefinition ANY VALID)
TypeDefinition ANY CONST
-> SchemaValidator
     (TypeContext (TypeDefinition ANY)) (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 a b.
Validator CONST (TypeSystemContext ()) (a -> b)
-> Validator CONST (TypeSystemContext ()) a
-> Validator CONST (TypeSystemContext ()) b
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 a b.
Validator CONST (TypeSystemContext ()) (a -> b)
-> Validator CONST (TypeSystemContext ()) a
-> Validator CONST (TypeSystemContext ()) b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse TypeDefinition OBJECT CONST
-> Validator
     CONST (TypeSystemContext ()) (TypeDefinition OBJECT VALID)
TypeDefinition OBJECT CONST
-> SchemaValidator
     (TypeContext (TypeDefinition OBJECT)) (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 a b.
Validator CONST (TypeSystemContext ()) (a -> b)
-> Validator CONST (TypeSystemContext ()) a
-> Validator CONST (TypeSystemContext ()) b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse TypeDefinition OBJECT CONST
-> Validator
     CONST (TypeSystemContext ()) (TypeDefinition OBJECT VALID)
TypeDefinition OBJECT CONST
-> SchemaValidator
     (TypeContext (TypeDefinition OBJECT)) (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 a b.
Validator CONST (TypeSystemContext ()) (a -> b)
-> Validator CONST (TypeSystemContext ()) a
-> Validator CONST (TypeSystemContext ()) b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> SafeHashMap FieldName a -> f (SafeHashMap FieldName b)
traverse DirectiveDefinition CONST
-> Validator
     CONST (TypeSystemContext ()) (DirectiveDefinition VALID)
DirectiveDefinition CONST
-> SchemaValidator
     (TypeContext DirectiveDefinition) (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 :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName,
        Maybe Description
typeDescription :: Maybe Description
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Description
typeDescription,
        Directives CONST
typeDirectives :: Directives CONST
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeDirectives,
        TypeContent TRUE cat CONST
typeContent :: TypeContent TRUE cat CONST
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
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
 -> Directives VALID
 -> TypeContent TRUE cat VALID
 -> TypeDefinition cat VALID)
-> Validator
     CONST (TypeSystemContext (TypeEntity ON_TYPE)) TypeName
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (Directives VALID
      -> TypeContent TRUE cat VALID -> TypeDefinition cat VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeName
-> Validator
     CONST (TypeSystemContext (TypeEntity ON_TYPE)) TypeName
forall (f :: * -> *) (t :: NAME).
MonadError GQLError f =>
Name t -> f (Name t)
checkName TypeName
typeName
          Validator
  CONST
  (TypeSystemContext (TypeEntity ON_TYPE))
  (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 a b.
Validator CONST (TypeSystemContext (TypeEntity ON_TYPE)) (a -> b)
-> Validator CONST (TypeSystemContext (TypeEntity ON_TYPE)) a
-> Validator CONST (TypeSystemContext (TypeEntity ON_TYPE)) b
forall (f :: * -> *) a b. Applicative f => 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 a b.
Validator CONST (TypeSystemContext (TypeEntity ON_TYPE)) (a -> b)
-> Validator CONST (TypeSystemContext (TypeEntity ON_TYPE)) a
-> Validator CONST (TypeSystemContext (TypeEntity ON_TYPE)) b
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

checkName :: MonadError GQLError f => Name t -> f (Name t)
checkName :: forall (f :: * -> *) (t :: NAME).
MonadError GQLError f =>
Name t -> f (Name t)
checkName Name t
name
  | Name t -> Bool
forall (t :: NAME). Name t -> Bool
isValidName Name t
name = Name t -> f (Name t)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name t
name
  | Bool
otherwise = GQLError -> f (Name t)
forall a. GQLError -> f a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError
"Invalid Name:" GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> Name t -> GQLError
forall a. Msg a => a -> GQLError
msg Name t
name)

typeDirectiveLocation :: TypeContent a b c -> DirectiveLocation
typeDirectiveLocation :: forall (a :: Bool) (b :: TypeCategory) (c :: Stage).
TypeContent a b c -> DirectiveLocation
typeDirectiveLocation DataObject {} = DirectiveLocation
LOCATION_OBJECT
typeDirectiveLocation DataInputObject {} = DirectiveLocation
LOCATION_INPUT_OBJECT
typeDirectiveLocation DataScalar {} = DirectiveLocation
LOCATION_SCALAR
typeDirectiveLocation DataEnum {} = DirectiveLocation
LOCATION_ENUM
typeDirectiveLocation DataInputUnion {} = DirectiveLocation
LOCATION_OBJECT
typeDirectiveLocation DataUnion {} = DirectiveLocation
LOCATION_UNION
typeDirectiveLocation DataInterface {} = DirectiveLocation
LOCATION_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 :: [TypeName]
objectImplements :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> [TypeName]
objectImplements, FieldsDefinition OUT CONST
objectFields :: FieldsDefinition OUT CONST
objectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields} =
    [TypeName]
-> FieldsDefinition OUT VALID -> TypeContent TRUE cat VALID
[TypeName]
-> FieldsDefinition OUT VALID
-> TypeContent (OBJECT <=? cat) cat VALID
forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (OBJECT <=? a) a s
DataObject
      ([TypeName]
 -> FieldsDefinition OUT VALID -> TypeContent TRUE cat VALID)
-> Validator
     CONST (TypeSystemContext (TypeEntity ON_TYPE)) [TypeName]
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (FieldsDefinition 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))
  (FieldsDefinition OUT VALID -> TypeContent TRUE cat VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (FieldsDefinition OUT VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (TypeContent TRUE cat VALID)
forall a b.
Validator CONST (TypeSystemContext (TypeEntity ON_TYPE)) (a -> b)
-> Validator CONST (TypeSystemContext (TypeEntity ON_TYPE)) a
-> Validator CONST (TypeSystemContext (TypeEntity ON_TYPE)) b
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))
     (FieldsDefinition OUT VALID)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdMap FieldName a -> f (OrdMap FieldName b)
traverse FieldDefinition OUT CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (FieldDefinition OUT VALID)
FieldDefinition OUT CONST
-> SchemaValidator
     (TypeContext (FieldDefinition OUT)) (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 :: FieldsDefinition IN CONST
inputObjectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
inputObjectFields} =
    FieldsDefinition IN VALID -> TypeContent TRUE cat VALID
FieldsDefinition IN VALID
-> TypeContent (INPUT_OBJECT <=? cat) cat VALID
forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition IN s -> TypeContent (INPUT_OBJECT <=? a) 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdMap FieldName a -> f (OrdMap FieldName b)
traverse FieldDefinition IN CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (FieldDefinition IN VALID)
FieldDefinition IN CONST
-> SchemaValidator
     (TypeContext (FieldDefinition IN)) (FieldDefinition IN VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck FieldsDefinition IN CONST
inputObjectFields
  typeCheck DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF a s -> ScalarDefinition
..} = TypeContent TRUE cat VALID
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (TypeContent TRUE cat VALID)
forall a.
a -> Validator CONST (TypeSystemContext (TypeEntity ON_TYPE)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
  typeCheck DataEnum {DataEnum CONST
enumMembers :: DataEnum CONST
enumMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent LEAF a s -> DataEnum s
enumMembers} = DataEnum VALID -> TypeContent TRUE cat VALID
DataEnum VALID -> TypeContent (LEAF <=? cat) cat VALID
forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> TypeContent (LEAF <=? a) 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse DataEnumValue CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (DataEnumValue VALID)
DataEnumValue CONST
-> SchemaValidator
     (TypeContext DataEnumValue) (DataEnumValue VALID)
forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck DataEnum CONST
enumMembers
  typeCheck DataInputUnion {UnionTypeDefinition IN CONST
inputUnionMembers :: UnionTypeDefinition IN CONST
inputUnionMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent IN a s -> UnionTypeDefinition IN s
inputUnionMembers} =
    UnionTypeDefinition IN VALID -> TypeContent TRUE cat VALID
UnionTypeDefinition IN VALID -> TypeContent (IN <=? cat) cat VALID
forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition IN s -> TypeContent (IN <=? a) 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdMap TypeName a -> f (OrdMap TypeName b)
traverse UnionMember IN CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (UnionMember IN VALID)
UnionMember IN CONST
-> SchemaValidator
     (TypeContext (UnionMember IN)) (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 :: UnionTypeDefinition OUT CONST
unionMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OUT a s -> UnionTypeDefinition OUT s
unionMembers} = UnionTypeDefinition OUT VALID -> TypeContent TRUE cat VALID
UnionTypeDefinition OUT VALID
-> TypeContent (OUT <=? cat) cat VALID
forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition OUT s -> TypeContent (OUT <=? a) 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdMap TypeName a -> f (OrdMap TypeName b)
traverse UnionMember OUT CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (UnionMember OUT VALID)
UnionMember OUT CONST
-> SchemaValidator
     (TypeContext (UnionMember OUT)) (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) = FieldsDefinition OUT VALID -> TypeContent TRUE cat VALID
FieldsDefinition OUT VALID
-> TypeContent (IMPLEMENTABLE <=? cat) cat VALID
forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> TypeContent (IMPLEMENTABLE <=? a) a s
DataInterface (FieldsDefinition OUT VALID -> TypeContent TRUE cat VALID)
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (FieldsDefinition 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))
     (FieldsDefinition OUT VALID)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdMap FieldName a -> f (OrdMap FieldName b)
traverse FieldDefinition OUT CONST
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (FieldDefinition OUT VALID)
FieldDefinition OUT CONST
-> SchemaValidator
     (TypeContext (FieldDefinition OUT)) (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
FieldName
TypeRef
fieldDescription :: Maybe Description
fieldName :: FieldName
fieldType :: TypeRef
fieldContent :: Maybe (FieldContent TRUE cat CONST)
fieldDirectives :: Directives CONST
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
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
..} =
    FieldName
-> SchemaValidator (Field ON_TYPE) (FieldDefinition cat VALID)
-> SchemaValidator (TypeEntity ON_TYPE) (FieldDefinition cat VALID)
forall (p :: PLACE) v.
FieldName
-> SchemaValidator (Field p) v -> SchemaValidator (TypeEntity p) v
inField
      FieldName
fieldName
      ( Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat VALID)
-> Directives VALID
-> FieldDefinition cat VALID
forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
          Maybe Description
fieldDescription
          FieldName
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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 a b.
Validator CONST (TypeSystemContext (Field ON_TYPE)) (a -> b)
-> Validator CONST (TypeSystemContext (Field ON_TYPE)) a
-> Validator CONST (TypeSystemContext (Field ON_TYPE)) b
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 (forall {k} (t :: k). Proxy t
forall (t :: TypeCategory). 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
ArgumentsDefinition VALID -> FieldContent (OUT <=? cat) 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdMap FieldName a -> f (OrdMap FieldName b)
traverse ArgumentDefinition CONST
-> Validator
     CONST
     (TypeSystemContext (Field ON_TYPE))
     (ArgumentDefinition VALID)
ArgumentDefinition CONST
-> SchemaValidator
     (TypeContext ArgumentDefinition) (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
Value VALID -> FieldContent (IN <=? cat) 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 FieldName
-> Value CONST
-> Validator
     CONST (TypeSystemContext (Field ON_TYPE)) (Value VALID)
validateDefaultValue TypeRef
fieldType Maybe FieldName
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
LOCATION_FIELD_DEFINITION

instance FieldDirectiveLocation IN where
  directiveLocation :: Proxy IN -> DirectiveLocation
directiveLocation Proxy IN
_ = DirectiveLocation
LOCATION_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
FieldName
directiveDefinitionName :: FieldName
directiveDefinitionDescription :: Maybe Description
directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionName :: forall (s :: Stage). DirectiveDefinition s -> FieldName
directiveDefinitionDescription :: forall (s :: Stage). DirectiveDefinition s -> Maybe Description
directiveDefinitionLocations :: forall (s :: Stage). DirectiveDefinition s -> [DirectiveLocation]
..} =
    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
$
      FieldName
-> SchemaValidator (Field ON_TYPE) (DirectiveDefinition VALID)
-> SchemaValidator (TypeEntity ON_TYPE) (DirectiveDefinition VALID)
forall (p :: PLACE) v.
FieldName
-> SchemaValidator (Field p) v -> SchemaValidator (TypeEntity p) v
inField FieldName
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdMap FieldName a -> f (OrdMap FieldName b)
traverse ArgumentDefinition CONST
-> Validator
     CONST
     (TypeSystemContext (Field ON_TYPE))
     (ArgumentDefinition VALID)
ArgumentDefinition CONST
-> SchemaValidator
     (TypeContext ArgumentDefinition) (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 a.
a -> Validator CONST (TypeSystemContext (Field ON_TYPE)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DirectiveDefinition {[DirectiveLocation]
Maybe Description
ArgumentsDefinition VALID
FieldName
directiveDefinitionArgs :: ArgumentsDefinition VALID
directiveDefinitionName :: FieldName
directiveDefinitionDescription :: Maybe Description
directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionName :: FieldName
directiveDefinitionDescription :: Maybe Description
directiveDefinitionLocations :: [DirectiveLocation]
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
FieldName
TypeRef
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
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
fieldDescription :: Maybe Description
fieldName :: FieldName
fieldType :: TypeRef
fieldContent :: Maybe (FieldContent TRUE IN CONST)
fieldDirectives :: Directives CONST
..}) =
    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
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE IN VALID)
-> Directives VALID
-> FieldDefinition IN VALID
forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
              Maybe Description
fieldDescription
              FieldName
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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 a b.
Validator CONST (TypeSystemContext (Field ON_TYPE)) (a -> b)
-> Validator CONST (TypeSystemContext (Field ON_TYPE)) a
-> Validator CONST (TypeSystemContext (Field ON_TYPE)) b
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
LOCATION_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
Value VALID -> FieldContent (IN <=? IN) 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 FieldName
-> Value CONST
-> Validator
     CONST (TypeSystemContext (Field ON_TYPE)) (Value VALID)
validateDefaultValue TypeRef
fieldType (FieldName -> Maybe FieldName
forall a. a -> Maybe a
Just FieldName
fieldName) Value CONST
value

validateDefaultValue ::
  TypeRef ->
  Maybe FieldName ->
  Value CONST ->
  SchemaValidator (Field ON_TYPE) (Value VALID)
validateDefaultValue :: TypeRef
-> Maybe FieldName
-> Value CONST
-> Validator
     CONST (TypeSystemContext (Field ON_TYPE)) (Value VALID)
validateDefaultValue TypeRef
typeRef Maybe FieldName
argName Value CONST
value = do
  Field FieldName
fName Maybe FieldName
_ (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 -> FieldName -> Maybe FieldName -> InputSource
SourceInputField TypeName
typeName FieldName
fName Maybe FieldName
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
enumDescription :: Maybe Description
enumName :: TypeName
enumDescription :: forall (s :: Stage). DataEnumValue s -> Maybe Description
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
..} =
    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
LOCATION_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
memberName :: TypeName
nullary :: Bool
memberName :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
nullary :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> Bool
..} = UnionMember cat VALID
-> Validator
     CONST
     (TypeSystemContext (TypeEntity ON_TYPE))
     (UnionMember cat VALID)
forall a.
a -> Validator CONST (TypeSystemContext (TypeEntity ON_TYPE)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnionMember {Bool
TypeName
memberName :: TypeName
nullary :: Bool
memberName :: TypeName
nullary :: Bool
..}