{-# 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 forall (s :: Stage). Schema s
internalSchema forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> Schema CONST
schema
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema CONST
schema
    forall (s :: Stage) a.
Validator s (TypeSystemContext ()) a
-> Config -> Schema s -> GQLResult a
runSchemaValidator (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
_ = 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
      } =
      forall (s :: Stage).
TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s
Schema
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck TypeDefinitions CONST
types
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck TypeDefinition OBJECT CONST
query
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck Maybe (TypeDefinition OBJECT CONST)
mutation
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck Maybe (TypeDefinition OBJECT CONST)
subscription
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: 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
      } =
      forall v.
TypeName
-> SchemaValidator (TypeEntity ON_TYPE) v -> SchemaValidator () v
inType TypeName
typeName forall a b. (a -> b) -> a -> b
$
        forall (a :: TypeCategory) (s :: Stage).
Maybe Description
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition
          Maybe Description
typeDescription
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (t :: NAME).
MonadError GQLError f =>
Name t -> f (Name t)
checkName TypeName
typeName
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall ctx (schemaS :: Stage) (s :: Stage).
ArgumentsConstraints ctx schemaS s =>
DirectiveLocation
-> Directives s -> Validator schemaS ctx (Directives VALID)
validateDirectives (forall (a :: Bool) (b :: TypeCategory) (c :: Stage).
TypeContent a b c -> DirectiveLocation
typeDirectiveLocation TypeContent TRUE cat CONST
typeContent) Directives CONST
typeDirectives
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
  | forall (t :: NAME). Name t -> Bool
isValidName Name t
name = forall (f :: * -> *) a. Applicative f => a -> f a
pure Name t
name
  | Bool
otherwise = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError
"Invalid Name:" forall a. Semigroup a => a -> a -> a
<> 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
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 (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> [TypeName]
objectImplements :: [TypeName]
objectImplements, FieldsDefinition OUT CONST
objectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT CONST
objectFields} =
    forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (OBJECT <=? a) a s
DataObject
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeName]
-> FieldsDefinition OUT CONST
-> SchemaValidator (TypeEntity ON_TYPE) [TypeName]
validateImplements [TypeName]
objectImplements FieldsDefinition OUT CONST
objectFields
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck FieldsDefinition OUT CONST
objectFields
  typeCheck DataInputObject {FieldsDefinition IN CONST
inputObjectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN CONST
inputObjectFields} =
    forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition IN s -> TypeContent (INPUT_OBJECT <=? a) a s
DataInputObject forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: 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
..} = forall (f :: * -> *) a. Applicative f => a -> f a
pure DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
  typeCheck DataEnum {DataEnum CONST
enumMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent LEAF a s -> DataEnum s
enumMembers :: DataEnum CONST
enumMembers} = forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> TypeContent (LEAF <=? a) a s
DataEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck DataEnum CONST
enumMembers
  typeCheck DataInputUnion {UnionTypeDefinition IN CONST
inputUnionMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent IN a s -> UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN CONST
inputUnionMembers} =
    forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition IN s -> TypeContent (IN <=? a) a s
DataInputUnion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck UnionTypeDefinition IN CONST
inputUnionMembers
  typeCheck DataUnion {UnionTypeDefinition OUT CONST
unionMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OUT a s -> UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT CONST
unionMembers} = forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition OUT s -> TypeContent (OUT <=? a) a s
DataUnion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck UnionTypeDefinition OUT CONST
unionMembers
  typeCheck (DataInterface FieldsDefinition OUT CONST
fields) = forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> TypeContent (IMPLEMENTABLE <=? a) a s
DataInterface forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: 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
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 -> FieldName
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
fieldDirectives :: Directives CONST
fieldContent :: Maybe (FieldContent TRUE cat CONST)
fieldType :: TypeRef
fieldName :: FieldName
fieldDescription :: Maybe Description
..} =
    forall (p :: PLACE) v.
FieldName
-> SchemaValidator (Field p) v -> SchemaValidator (TypeEntity p) v
inField
      FieldName
fieldName
      ( 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
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldContent TRUE cat CONST
-> SchemaValidator (Field ON_TYPE) (FieldContent TRUE cat VALID)
checkFieldContent Maybe (FieldContent TRUE cat CONST)
fieldContent
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall ctx (schemaS :: Stage) (s :: Stage).
ArgumentsConstraints ctx schemaS s =>
DirectiveLocation
-> Directives s -> Validator schemaS ctx (Directives VALID)
validateDirectives (forall (cat :: TypeCategory).
FieldDirectiveLocation cat =>
Proxy cat -> DirectiveLocation
directiveLocation (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
-> SchemaValidator (Field ON_TYPE) (FieldContent TRUE cat VALID)
checkFieldContent (FieldArgs ArgumentsDefinition CONST
args) = forall (s :: Stage) (cat :: TypeCategory).
ArgumentsDefinition s -> FieldContent (OUT <=? cat) cat s
FieldArgs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck ArgumentsDefinition CONST
args
      checkFieldContent (DefaultInputValue Value CONST
value) = forall (s :: Stage) (cat :: TypeCategory).
Value s -> FieldContent (IN <=? cat) cat s
DefaultInputValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRef
-> Maybe FieldName
-> Value CONST
-> SchemaValidator (Field ON_TYPE) (Value VALID)
validateDefaultValue TypeRef
fieldType 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
FieldName
directiveDefinitionLocations :: forall (s :: Stage). DirectiveDefinition s -> [DirectiveLocation]
directiveDefinitionDescription :: forall (s :: Stage). DirectiveDefinition s -> Maybe Description
directiveDefinitionName :: forall (s :: Stage). DirectiveDefinition s -> FieldName
directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionDescription :: Maybe Description
directiveDefinitionName :: FieldName
..} =
    forall v.
TypeName
-> SchemaValidator (TypeEntity ON_TYPE) v -> SchemaValidator () v
inType TypeName
"Directive" forall a b. (a -> b) -> a -> b
$
      forall (p :: PLACE) v.
FieldName
-> SchemaValidator (Field p) v -> SchemaValidator (TypeEntity p) v
inField FieldName
directiveDefinitionName forall a b. (a -> b) -> a -> b
$ do
        OrdMap FieldName (ArgumentDefinition VALID)
directiveDefinitionArgs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: Stage -> *).
TypeCheck a =>
a CONST -> SchemaValidator (TypeContext a) (a VALID)
typeCheck ArgumentsDefinition CONST
arguments
        forall (f :: * -> *) a. Applicative f => a -> f a
pure DirectiveDefinition {[DirectiveLocation]
Maybe Description
OrdMap FieldName (ArgumentDefinition VALID)
FieldName
directiveDefinitionArgs :: OrdMap FieldName (ArgumentDefinition VALID)
directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionDescription :: Maybe Description
directiveDefinitionName :: FieldName
directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionDescription :: Maybe Description
directiveDefinitionName :: FieldName
directiveDefinitionArgs :: OrdMap FieldName (ArgumentDefinition 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
fieldDirectives :: Directives CONST
fieldContent :: Maybe (FieldContent TRUE IN CONST)
fieldType :: TypeRef
fieldName :: FieldName
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 -> FieldName
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
..}) =
    forall (s :: Stage). FieldDefinition IN s -> ArgumentDefinition s
ArgumentDefinition
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( 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
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldContent TRUE IN CONST
-> Validator
     CONST
     (TypeSystemContext (Field ON_TYPE))
     (FieldContent TRUE IN VALID)
checkArgumentDefaultValue Maybe (FieldContent TRUE IN CONST)
fieldContent
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
        forall (s :: Stage) (cat :: TypeCategory).
Value s -> FieldContent (IN <=? cat) cat s
DefaultInputValue
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRef
-> Maybe FieldName
-> Value CONST
-> SchemaValidator (Field ON_TYPE) (Value VALID)
validateDefaultValue TypeRef
fieldType (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
-> SchemaValidator (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) <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall c. TypeSystemContext c -> c
local forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage) ctx. ValidatorContext s ctx -> ctx
localContext)
  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) (forall c (schemaS :: Stage) (s :: Stage).
ValidateWithDefault c schemaS s =>
Typed IN schemaS TypeRef
-> Value s -> Validator schemaS (InputContext c) (Value VALID)
validateInputByTypeRef (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
..} =
    forall (s :: Stage).
Maybe Description -> TypeName -> Directives s -> DataEnumValue s
DataEnumValue Maybe Description
enumDescription TypeName
enumName
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
..} = forall (f :: * -> *) a. Applicative f => a -> f a
pure UnionMember {Bool
TypeName
nullary :: Bool
memberName :: TypeName
nullary :: Bool
memberName :: TypeName
..}