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

module Data.Morpheus.Error.Variable
  ( uninitializedVariable,
    incompatibleVariableType,
  )
where

import Data.Morpheus.Types.Internal.AST
  ( FieldName,
    GQLError,
    Ref (..),
    TypeRef,
    Variable (..),
    at,
    msg,
  )
import Relude

-- query M ( $v : String ) { a(p:$v) } -> "Variable \"$v\" of type \"String\" used in position expecting type \"LANGUAGE\"."
incompatibleVariableType :: Ref FieldName -> Variable s -> TypeRef -> GQLError
incompatibleVariableType :: forall (s :: Stage).
Ref FieldName -> Variable s -> TypeRef -> GQLError
incompatibleVariableType
  (Ref FieldName
variableName Position
argPosition)
  Variable {TypeRef
variableType :: forall (stage :: Stage). Variable stage -> TypeRef
variableType :: TypeRef
variableType}
  TypeRef
argumentType =
    ( 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
" of type "
        forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeRef
variableType
        forall a. Semigroup a => a -> a -> a
<> GQLError
" used in position expecting type "
        forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeRef
argumentType
        forall a. Semigroup a => a -> a -> a
<> GQLError
"."
    )
      GQLError -> Position -> GQLError
`at` Position
argPosition

uninitializedVariable :: Variable s -> GQLError
uninitializedVariable :: forall (s :: Stage). Variable s -> GQLError
uninitializedVariable Variable {FieldName
variableName :: forall (stage :: Stage). Variable stage -> FieldName
variableName :: FieldName
variableName, TypeRef
variableType :: TypeRef
variableType :: forall (stage :: Stage). Variable stage -> TypeRef
variableType, 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
" of required type "
      forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeRef
variableType
      forall a. Semigroup a => a -> a -> a
<> GQLError
" was not provided."
  )
    GQLError -> Position -> GQLError
`at` Position
variablePosition