{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Error.Input
  ( typeViolation,
  )
where

import Data.Morpheus.Types.Internal.AST
  ( GQLError,
    TypeRef (..),
    Value,
    msg,
  )
import Data.Semigroup ((<>))

typeViolation :: TypeRef -> Value s -> GQLError
typeViolation :: forall (s :: Stage). TypeRef -> Value s -> GQLError
typeViolation TypeRef
expected Value s
found =
  GQLError
"Expected type "
    forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeRef
expected
    forall a. Semigroup a => a -> a -> a
<> GQLError
" found "
    forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg Value s
found
    forall a. Semigroup a => a -> a -> a
<> GQLError
"."

{-
  ARGUMENTS:
    type Experience {
        experience ( lang: LANGUAGE ) : String ,
        date: String
    }

  - required field !?
  - experience( lang: "bal" ) -> "Expected type LANGUAGE, found \"a\"."
  - experience( lang: Bla ) -> "Expected type LANGUAGE, found Bla."
  - experience( lang: 1 ) -> "Expected type LANGUAGE, found 1."
  - experience( a1 : 1 ) -> "Unknown argument \"a1\" on field \"experience\" of type \"Experience\".",
  - date(name: "name") -> "Unknown argument \"name\" on field \"date\" of type \"Experience\"."
-}