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

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

import Data.Morpheus.Error.Utils (validationErrorMessage)
import Data.Morpheus.Types.Internal.AST
  ( Ref (..),
    TypeRef,
    ValidationError,
    Variable (..),
    msg,
  )
import Relude

-- query M ( $v : String ) { a(p:$v) } -> "Variable \"$v\" of type \"String\" used in position expecting type \"LANGUAGE\"."
incompatibleVariableType :: Ref -> Variable s -> TypeRef -> ValidationError
incompatibleVariableType :: Ref -> Variable s -> TypeRef -> ValidationError
incompatibleVariableType
  (Ref FieldName
variableName Position
argPosition)
  Variable {TypeRef
variableType :: forall (stage :: Stage). Variable stage -> TypeRef
variableType :: TypeRef
variableType}
  TypeRef
argumentType =
    Maybe Position -> Message -> ValidationError
validationErrorMessage (Position -> Maybe Position
forall a. a -> Maybe a
Just Position
argPosition) Message
text
    where
      text :: Message
text =
        Message
"Variable "
          Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg (FieldName
"$" FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
variableName)
          Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" of type "
          Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> TypeRef -> Message
forall a. Msg a => a -> Message
msg TypeRef
variableType
          Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" used in position expecting type "
          Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> TypeRef -> Message
forall a. Msg a => a -> Message
msg TypeRef
argumentType
          Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
"."

uninitializedVariable :: Variable s -> ValidationError
uninitializedVariable :: Variable s -> ValidationError
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} =
  Maybe Position -> Message -> ValidationError
validationErrorMessage
    (Position -> Maybe Position
forall a. a -> Maybe a
Just Position
variablePosition)
    (Message -> ValidationError) -> Message -> ValidationError
forall a b. (a -> b) -> a -> b
$ Message
"Variable "
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg (FieldName
"$" FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
variableName)
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" of required type "
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> TypeRef -> Message
forall a. Msg a => a -> Message
msg TypeRef
variableType
      Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" was not provided."