{-# 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 name = "Unknown Interface " <> msgValidation name <> "."
data ImplementsError
= UnexpectedType
{ expectedType :: TypeRef,
foundType :: TypeRef
}
| Missing
data Place = Place
{ fieldname :: TypeName,
typename :: FieldName,
fieldArg :: Maybe (FieldName, TypeName)
}
class PartialImplements ctx where
partialImplements :: ctx -> ImplementsError -> ValidationError
instance PartialImplements (Interface, FieldName) where
partialImplements (Interface interfaceName typename, fieldname) errorType =
"Interface field "
<> renderField interfaceName fieldname Nothing
<> detailedMessage errorType
where
detailedMessage UnexpectedType {expectedType, foundType} =
" expects type "
<> msgValidation expectedType
<> " but "
<> renderField typename fieldname Nothing
<> " is type "
<> msgValidation foundType
<> "."
detailedMessage Missing =
" expected but "
<> msgValidation typename
<> " does not provide it."
instance PartialImplements (Interface, Field) where
partialImplements (Interface interfaceName typename, Field fieldname argName) errorType =
"Interface field argument "
<> renderField interfaceName fieldname (Just argName)
<> detailedMessage errorType
where
detailedMessage UnexpectedType {expectedType, foundType} =
" expects type"
<> msgValidation expectedType
<> " but "
<> renderField typename fieldname (Just argName)
<> " is type "
<> msgValidation foundType
<> "."
detailedMessage Missing =
" expected but "
<> renderField typename fieldname Nothing
<> " does not provide it."