{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Error.Document.Interface
( unknownInterface,
PartialImplements (..),
ImplementsError (..),
Place (..),
)
where
import Data.Maybe (Maybe (..))
import Data.Morpheus.Types.Internal.AST.Base
( FieldName (..),
TypeName (..),
TypeRef,
ValidationError,
msgValidation,
)
import Data.Morpheus.Types.Internal.Validation.SchemaValidator
( Field (..),
Interface (..),
renderField,
)
import Data.Semigroup ((<>))
unknownInterface :: TypeName -> ValidationError
unknownInterface :: TypeName -> ValidationError
unknownInterface TypeName
name = ValidationError
"Unknown Interface " ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation TypeName
name ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
"."
data ImplementsError
= UnexpectedType
{ ImplementsError -> TypeRef
expectedType :: TypeRef,
ImplementsError -> TypeRef
foundType :: TypeRef
}
| Missing
data Place = Place
{ Place -> TypeName
fieldname :: TypeName,
Place -> FieldName
typename :: FieldName,
Place -> Maybe (FieldName, TypeName)
fieldArg :: Maybe (FieldName, TypeName)
}
class PartialImplements ctx where
partialImplements :: ctx -> ImplementsError -> ValidationError
instance PartialImplements (Interface, FieldName) where
partialImplements :: (Interface, FieldName) -> ImplementsError -> ValidationError
partialImplements (Interface TypeName
interfaceName TypeName
typename, FieldName
fieldname) ImplementsError
errorType =
ValidationError
"Interface field "
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> FieldName -> Maybe FieldName -> ValidationError
renderField TypeName
interfaceName FieldName
fieldname Maybe FieldName
forall a. Maybe a
Nothing
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ImplementsError -> ValidationError
detailedMessage ImplementsError
errorType
where
detailedMessage :: ImplementsError -> ValidationError
detailedMessage UnexpectedType {TypeRef
expectedType :: TypeRef
expectedType :: ImplementsError -> TypeRef
expectedType, TypeRef
foundType :: TypeRef
foundType :: ImplementsError -> TypeRef
foundType} =
ValidationError
" expects type "
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeRef -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation TypeRef
expectedType
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
" but "
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> FieldName -> Maybe FieldName -> ValidationError
renderField TypeName
typename FieldName
fieldname Maybe FieldName
forall a. Maybe a
Nothing
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
" is type "
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeRef -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation TypeRef
foundType
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
"."
detailedMessage ImplementsError
Missing =
ValidationError
" expected but "
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation TypeName
typename
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
" does not provide it."
instance PartialImplements (Interface, Field) where
partialImplements :: (Interface, Field) -> ImplementsError -> ValidationError
partialImplements (Interface TypeName
interfaceName TypeName
typename, Field FieldName
fieldname FieldName
argName) ImplementsError
errorType =
ValidationError
"Interface field argument "
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> FieldName -> Maybe FieldName -> ValidationError
renderField TypeName
interfaceName FieldName
fieldname (FieldName -> Maybe FieldName
forall a. a -> Maybe a
Just FieldName
argName)
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ImplementsError -> ValidationError
detailedMessage ImplementsError
errorType
where
detailedMessage :: ImplementsError -> ValidationError
detailedMessage UnexpectedType {TypeRef
expectedType :: TypeRef
expectedType :: ImplementsError -> TypeRef
expectedType, TypeRef
foundType :: TypeRef
foundType :: ImplementsError -> TypeRef
foundType} =
ValidationError
" expects type"
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeRef -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation TypeRef
expectedType
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
" but "
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> FieldName -> Maybe FieldName -> ValidationError
renderField TypeName
typename FieldName
fieldname (FieldName -> Maybe FieldName
forall a. a -> Maybe a
Just FieldName
argName)
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
" is type "
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeRef -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation TypeRef
foundType
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
"."
detailedMessage ImplementsError
Missing =
ValidationError
" expected but "
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> FieldName -> Maybe FieldName -> ValidationError
renderField TypeName
typename FieldName
fieldname Maybe FieldName
forall a. Maybe a
Nothing
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
" does not provide it."