{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Error.Document.Interface
  ( unknownInterface,
    ImplementsError (..),
    partialImplements,
  )
where

import Data.Morpheus.Types.Internal.AST.Error
  ( GQLError,
    msg,
  )
import Data.Morpheus.Types.Internal.AST.Name
  ( TypeName,
  )
import Data.Morpheus.Types.Internal.AST.Type (TypeRef)
import Data.Morpheus.Types.Internal.Validation.SchemaValidator
  ( Field (..),
    InterfaceName (..),
    ON_INTERFACE,
    TypeEntity (..),
    renderField,
  )
import Relude

unknownInterface :: TypeName -> GQLError
unknownInterface :: TypeName -> GQLError
unknownInterface TypeName
name = GQLError
"Unknown Interface " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeName -> GQLError
forall a. Msg a => a -> GQLError
msg TypeName
name GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"."

data ImplementsError
  = UnexpectedType
      { ImplementsError -> TypeRef
expectedType :: TypeRef,
        ImplementsError -> TypeRef
foundType :: TypeRef
      }
  | Missing

partialImplements :: Field ON_INTERFACE -> ImplementsError -> GQLError
partialImplements :: Field ON_INTERFACE -> ImplementsError -> GQLError
partialImplements (Field FieldName
fieldName Maybe FieldName
argName (TypeEntity (OnInterface TypeName
interfaceName) TypeName
typename)) ImplementsError
errorType =
  GQLError
"Interface field " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError -> (FieldName -> GQLError) -> Maybe FieldName -> GQLError
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GQLError
"" (GQLError -> FieldName -> GQLError
forall a b. a -> b -> a
const GQLError
"argument ") Maybe FieldName
argName
    GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeName -> FieldName -> Maybe FieldName -> GQLError
renderField TypeName
interfaceName FieldName
fieldName Maybe FieldName
argName
    GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError -> GQLError -> ImplementsError -> GQLError
detailedMessageGen
      (TypeName -> FieldName -> Maybe FieldName -> GQLError
renderField TypeName
typename FieldName
fieldName Maybe FieldName
argName)
      (GQLError -> (FieldName -> GQLError) -> Maybe FieldName -> GQLError
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TypeName -> GQLError
forall a. Msg a => a -> GQLError
msg TypeName
typename) (GQLError -> FieldName -> GQLError
forall a b. a -> b -> a
const (GQLError -> FieldName -> GQLError)
-> GQLError -> FieldName -> GQLError
forall a b. (a -> b) -> a -> b
$ TypeName -> FieldName -> Maybe FieldName -> GQLError
renderField TypeName
typename FieldName
fieldName Maybe FieldName
forall a. Maybe a
Nothing) Maybe FieldName
argName)
      ImplementsError
errorType

-- Interface field TestInterface.name expected but User does not provide it.
-- Interface field TestInterface.name expects type String! but User.name is type Int!.
-- Interface field argument TestInterface.name(id:) expected but User.name does not provide it.
-- Interface field argument TestInterface.name(id:) expects type ID but User.name(id:) is type String.

detailedMessageGen :: GQLError -> GQLError -> ImplementsError -> GQLError
detailedMessageGen :: GQLError -> GQLError -> ImplementsError -> GQLError
detailedMessageGen GQLError
pl1 GQLError
_ UnexpectedType {TypeRef
expectedType :: TypeRef
expectedType :: ImplementsError -> TypeRef
expectedType, TypeRef
foundType :: TypeRef
foundType :: ImplementsError -> TypeRef
foundType} =
  GQLError
" expects type "
    GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeRef -> GQLError
forall a. Msg a => a -> GQLError
msg TypeRef
expectedType
    GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" but "
    GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
pl1
    GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" is type "
    GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeRef -> GQLError
forall a. Msg a => a -> GQLError
msg TypeRef
foundType
    GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"."
detailedMessageGen GQLError
_ GQLError
pl2 ImplementsError
Missing = GQLError
" expected but " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
pl2 GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" does not provide it."