{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.Internal.Validation.Error
( MissingRequired (..),
KindViolation (..),
Unknown (..),
Unused (..),
)
where
import Data.Morpheus.Error.Selection (unknownSelectionField)
import Data.Morpheus.Types.Internal.AST
( Argument (..),
Arguments,
Directive (..),
FieldName,
Fragment (..),
FragmentName,
GQLError,
IMPLEMENTABLE,
IN,
Object,
ObjectEntry (..),
Ref (..),
TypeCategory,
TypeName,
TypeRef (..),
Variable (..),
VariableDefinitions,
at,
atPositions,
getOperationName,
msg,
withPath,
)
import Data.Morpheus.Types.Internal.Validation.Validator
( InputContext (..),
OperationContext (..),
Scope (..),
ScopeKind (..),
renderInputPrefix,
)
import Relude
class Unused c where
unused :: OperationContext s1 s2 -> c -> GQLError
instance Unused (Variable s) where
unused :: forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> Variable s -> GQLError
unused
OperationContext {Maybe FieldName
operationName :: forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> Maybe FieldName
operationName :: Maybe FieldName
operationName}
Variable {FieldName
variableName :: forall (stage :: Stage). Variable stage -> FieldName
variableName :: FieldName
variableName, Position
variablePosition :: forall (stage :: Stage). Variable stage -> Position
variablePosition :: Position
variablePosition} =
( GQLError
"Variable "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (FieldName
"$" forall a. Semigroup a => a -> a -> a
<> FieldName
variableName)
forall a. Semigroup a => a -> a -> a
<> GQLError
" is never used in operation "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (Maybe FieldName -> TypeName
getOperationName Maybe FieldName
operationName)
forall a. Semigroup a => a -> a -> a
<> GQLError
"."
)
GQLError -> Position -> GQLError
`at` Position
variablePosition
instance Unused (Fragment s) where
unused :: forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> Fragment s -> GQLError
unused
OperationContext s1 s2
_
Fragment {FragmentName
fragmentName :: forall (stage :: Stage). Fragment stage -> FragmentName
fragmentName :: FragmentName
fragmentName, Position
fragmentPosition :: forall (stage :: Stage). Fragment stage -> Position
fragmentPosition :: Position
fragmentPosition} =
( GQLError
"Fragment "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FragmentName
fragmentName
forall a. Semigroup a => a -> a -> a
<> GQLError
" is never used."
)
GQLError -> Position -> GQLError
`at` Position
fragmentPosition
class MissingRequired c ctx where
missingRequired :: Scope -> ctx -> Ref FieldName -> c -> GQLError
instance MissingRequired (Arguments s) ctx where
missingRequired :: Scope -> ctx -> Ref FieldName -> Arguments s -> GQLError
missingRequired
Scope {Maybe Position
position :: Scope -> Maybe Position
position :: Maybe Position
position, ScopeKind
kind :: Scope -> ScopeKind
kind :: ScopeKind
kind, FieldName
fieldName :: Scope -> FieldName
fieldName :: FieldName
fieldName, [PropName]
path :: Scope -> [PropName]
path :: [PropName]
path}
ctx
_
Ref {FieldName
refName :: forall name. Ref name -> name
refName :: FieldName
refName}
Arguments s
_ =
( ( ScopeKind -> GQLError
inScope ScopeKind
kind
forall a. Semigroup a => a -> a -> a
<> GQLError
" argument "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
refName
forall a. Semigroup a => a -> a -> a
<> GQLError
" is required but not provided."
)
forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` Maybe Position
position
)
GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path
where
inScope :: ScopeKind -> GQLError
inScope ScopeKind
DIRECTIVE = GQLError
"Directive " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
fieldName
inScope ScopeKind
_ = GQLError
"Field " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
fieldName
instance MissingRequired (Object s) (InputContext ctx) where
missingRequired :: Scope -> InputContext ctx -> Ref FieldName -> Object s -> GQLError
missingRequired
Scope {Maybe Position
position :: Maybe Position
position :: Scope -> Maybe Position
position, [PropName]
path :: [PropName]
path :: Scope -> [PropName]
path}
InputContext ctx
ctx
Ref {FieldName
refName :: FieldName
refName :: forall name. Ref name -> name
refName}
Object s
_ =
( ( forall c. InputContext c -> GQLError
renderInputPrefix
InputContext ctx
ctx
forall a. Semigroup a => a -> a -> a
<> GQLError
"Undefined Field "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
refName
forall a. Semigroup a => a -> a -> a
<> GQLError
"."
)
forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` Maybe Position
position
)
GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path
instance MissingRequired (VariableDefinitions s) (OperationContext s1 s2) where
missingRequired :: Scope
-> OperationContext s1 s2
-> Ref FieldName
-> VariableDefinitions s
-> GQLError
missingRequired
Scope {[PropName]
path :: [PropName]
path :: Scope -> [PropName]
path}
OperationContext
{ Maybe FieldName
operationName :: Maybe FieldName
operationName :: forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> Maybe FieldName
operationName
}
Ref {FieldName
refName :: FieldName
refName :: forall name. Ref name -> name
refName, Position
refPosition :: forall name. Ref name -> Position
refPosition :: Position
refPosition}
VariableDefinitions s
_ =
( ( GQLError
"Variable "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
refName
forall a. Semigroup a => a -> a -> a
<> GQLError
" is not defined by operation "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (Maybe FieldName -> TypeName
getOperationName Maybe FieldName
operationName)
forall a. Semigroup a => a -> a -> a
<> GQLError
"."
)
GQLError -> Position -> GQLError
`at` Position
refPosition
)
GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path
class Unknown ref ctx where
unknown :: Scope -> ctx -> ref -> GQLError
instance Unknown (Ref FragmentName) ctx where
unknown :: Scope -> ctx -> Ref FragmentName -> GQLError
unknown Scope {[PropName]
path :: [PropName]
path :: Scope -> [PropName]
path} ctx
_ Ref {FragmentName
refName :: FragmentName
refName :: forall name. Ref name -> name
refName, Position
refPosition :: Position
refPosition :: forall name. Ref name -> Position
refPosition} =
((GQLError
"Unknown Fragment " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FragmentName
refName forall a. Semigroup a => a -> a -> a
<> GQLError
".") GQLError -> Position -> GQLError
`at` Position
refPosition) GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path
instance Unknown (Ref TypeName) ctx where
unknown :: Scope -> ctx -> Ref TypeName -> GQLError
unknown Scope {[PropName]
path :: [PropName]
path :: Scope -> [PropName]
path} ctx
_ Ref {TypeName
refName :: TypeName
refName :: forall name. Ref name -> name
refName, Position
refPosition :: Position
refPosition :: forall name. Ref name -> Position
refPosition} =
((GQLError
"Unknown type " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeName
refName forall a. Semigroup a => a -> a -> a
<> GQLError
".") GQLError -> Position -> GQLError
`at` Position
refPosition) GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path
instance Unknown (Argument s') ctx where
unknown :: Scope -> ctx -> Argument s' -> GQLError
unknown Scope {ScopeKind
kind :: ScopeKind
kind :: Scope -> ScopeKind
kind, [PropName]
path :: [PropName]
path :: Scope -> [PropName]
path, FieldName
fieldName :: FieldName
fieldName :: Scope -> FieldName
fieldName} ctx
_ Argument {FieldName
argumentName :: forall (valid :: Stage). Argument valid -> FieldName
argumentName :: FieldName
argumentName, Position
argumentPosition :: forall (valid :: Stage). Argument valid -> Position
argumentPosition :: Position
argumentPosition} =
( ( GQLError
"Unknown Argument "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
argumentName
forall a. Semigroup a => a -> a -> a
<> GQLError
" on "
forall a. Semigroup a => a -> a -> a
<> forall {a}. IsString a => ScopeKind -> a
scope ScopeKind
kind
forall a. Semigroup a => a -> a -> a
<> GQLError
" "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
fieldName
forall a. Semigroup a => a -> a -> a
<> GQLError
"."
)
GQLError -> Position -> GQLError
`at` Position
argumentPosition
)
GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path
where
scope :: ScopeKind -> a
scope ScopeKind
DIRECTIVE = a
"Directive"
scope ScopeKind
_ = a
"Field"
instance Unknown (Ref FieldName) ctx where
unknown :: Scope -> ctx -> Ref FieldName -> GQLError
unknown Scope {TypeName
currentTypeName :: Scope -> TypeName
currentTypeName :: TypeName
currentTypeName, [PropName]
path :: [PropName]
path :: Scope -> [PropName]
path} ctx
_ Ref FieldName
ref =
TypeName -> Ref FieldName -> GQLError
unknownSelectionField TypeName
currentTypeName Ref FieldName
ref GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path
instance Unknown (ObjectEntry valueS) (InputContext ctx) where
unknown :: Scope -> InputContext ctx -> ObjectEntry valueS -> GQLError
unknown
Scope {Maybe Position
position :: Maybe Position
position :: Scope -> Maybe Position
position, [PropName]
path :: [PropName]
path :: Scope -> [PropName]
path}
InputContext ctx
ctx
ObjectEntry {FieldName
entryName :: forall (s :: Stage). ObjectEntry s -> FieldName
entryName :: FieldName
entryName} =
( ( forall c. InputContext c -> GQLError
renderInputPrefix InputContext ctx
ctx
forall a. Semigroup a => a -> a -> a
<> GQLError
"Unknown Field "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
entryName
forall a. Semigroup a => a -> a -> a
<> GQLError
"."
)
forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` Maybe Position
position
)
GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path
instance Unknown (Directive s') ctx where
unknown :: Scope -> ctx -> Directive s' -> GQLError
unknown Scope {[PropName]
path :: [PropName]
path :: Scope -> [PropName]
path} ctx
_ Directive {FieldName
directiveName :: forall (s :: Stage). Directive s -> FieldName
directiveName :: FieldName
directiveName, Position
directivePosition :: forall (s :: Stage). Directive s -> Position
directivePosition :: Position
directivePosition} =
((GQLError
"Unknown Directive " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
directiveName forall a. Semigroup a => a -> a -> a
<> GQLError
".") GQLError -> Position -> GQLError
`at` Position
directivePosition) GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path
class KindViolation (t :: TypeCategory) ctx where
kindViolation :: c t -> ctx -> GQLError
instance KindViolation IMPLEMENTABLE (Fragment s) where
kindViolation :: forall (c :: TypeCategory -> *).
c IMPLEMENTABLE -> Fragment s -> GQLError
kindViolation c IMPLEMENTABLE
_ Fragment {FragmentName
fragmentName :: FragmentName
fragmentName :: forall (stage :: Stage). Fragment stage -> FragmentName
fragmentName, TypeName
fragmentType :: forall (stage :: Stage). Fragment stage -> TypeName
fragmentType :: TypeName
fragmentType, Position
fragmentPosition :: Position
fragmentPosition :: forall (stage :: Stage). Fragment stage -> Position
fragmentPosition} =
( GQLError
"Fragment "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FragmentName
fragmentName
forall a. Semigroup a => a -> a -> a
<> GQLError
" cannot condition on non composite type "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeName
fragmentType
forall a. Semigroup a => a -> a -> a
<> GQLError
"."
)
GQLError -> Position -> GQLError
`at` Position
fragmentPosition
instance KindViolation IN (Variable s) where
kindViolation :: forall (c :: TypeCategory -> *). c IN -> Variable s -> GQLError
kindViolation
c IN
_
Variable
{ FieldName
variableName :: FieldName
variableName :: forall (stage :: Stage). Variable stage -> FieldName
variableName,
Position
variablePosition :: Position
variablePosition :: forall (stage :: Stage). Variable stage -> Position
variablePosition,
variableType :: forall (stage :: Stage). Variable stage -> TypeRef
variableType = TypeRef {TypeName
typeConName :: TypeRef -> TypeName
typeConName :: TypeName
typeConName}
} =
( GQLError
"Variable "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (FieldName
"$" forall a. Semigroup a => a -> a -> a
<> FieldName
variableName)
forall a. Semigroup a => a -> a -> a
<> GQLError
" cannot be non-input type "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeName
typeConName
forall a. Semigroup a => a -> a -> a
<> GQLError
"."
)
GQLError -> Position -> GQLError
`at` Position
variablePosition