content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  
  module Data.Morpheus.Types.Internal.Validation.Error
    ( MissingRequired (..),
      KindViolation (..),
      Unknown (..),
      Unused (..),
    )
  where
  
  import Data.Morpheus.Error.Selection (unknownSelectionField)
  import Data.Morpheus.Types.Internal.AST
    ( Argument (..),
      Arguments,
      Directive (..),
      FieldName,
      Fragment (..),
      FragmentName,
      GQLError,
      IMPLEMENTABLE,
      IN,
      Object,
      ObjectEntry (..),
      Ref (..),
      TypeCategory,
      TypeName,
      TypeRef (..),
      Variable (..),
      VariableDefinitions,
      at,
      atPositions,
      getOperationName,
      msg,
      withPath,
    )
  import Data.Morpheus.Types.Internal.Validation.Validator
    ( InputContext (..),
      OperationContext (..),
      Scope (..),
      ScopeKind (..),
      renderInputPrefix,
    )
  import Relude
  
  class Unused c where
    unused :: OperationContext s1 s2 -> c -> GQLError
  
  -- query M ( $v : String ) { a } -> "Variable \"$bla\" is never used in operation \"MyMutation\".",
  instance Unused (Variable s) where
    unused
      OperationContext {operationName}
      Variable {variableName, variablePosition} =
        ( "Variable "
            <> msg ("$" <> variableName)
            <> " is never used in operation "
            <> msg (getOperationName operationName)
            <> "."
        )
          `at` variablePosition
  
  instance Unused (Fragment s) where
    unused
      _
      Fragment {fragmentName, fragmentPosition} =
        ( "Fragment "
            <> msg fragmentName
            <> " is never used."
        )
          `at` fragmentPosition
  
  class MissingRequired c ctx where
    missingRequired :: Scope -> ctx -> Ref FieldName -> c -> GQLError
  
  instance MissingRequired (Arguments s) ctx where
    missingRequired
      Scope {position, kind, fieldName, path}
      _
      Ref {refName}
      _ =
        ( ( inScope kind
              <> " argument "
              <> msg refName
              <> " is required but not provided."
          )
            `atPositions` position
        )
          `withPath` path
        where
          inScope DIRECTIVE = "Directive " <> msg fieldName
          inScope _ = "Field " <> msg fieldName
  
  instance MissingRequired (Object s) (InputContext ctx) where
    missingRequired
      Scope {position, path}
      ctx
      Ref {refName}
      _ =
        ( ( renderInputPrefix
              ctx
              <> "Undefined Field "
              <> msg refName
              <> "."
          )
            `atPositions` position
        )
          `withPath` path
  
  instance MissingRequired (VariableDefinitions s) (OperationContext s1 s2) where
    missingRequired
      Scope {path}
      OperationContext
        { operationName
        }
      Ref {refName, refPosition}
      _ =
        ( ( "Variable "
              <> msg refName
              <> " is not defined by operation "
              <> msg (getOperationName operationName)
              <> "."
          )
            `at` refPosition
        )
          `withPath` path
  
  class Unknown ref ctx where
    unknown :: Scope -> ctx -> ref -> GQLError
  
  -- {...H} -> "Unknown fragment \"H\"."
  instance Unknown (Ref FragmentName) ctx where
    unknown Scope {path} _ Ref {refName, refPosition} =
      (("Unknown Fragment " <> msg refName <> ".") `at` refPosition) `withPath` path
  
  instance Unknown (Ref TypeName) ctx where
    unknown Scope {path} _ Ref {refName, refPosition} =
      (("Unknown type " <> msg refName <> ".") `at` refPosition) `withPath` path
  
  instance Unknown (Argument s') ctx where
    unknown Scope {kind, path, fieldName} _ Argument {argumentName, argumentPosition} =
      ( ( "Unknown Argument "
            <> msg argumentName
            <> " on "
            <> scope kind
            <> " "
            <> msg fieldName
            <> "."
        )
          `at` argumentPosition
      )
        `withPath` path
      where
        scope DIRECTIVE = "Directive"
        scope _ = "Field"
  
  instance Unknown (Ref FieldName) ctx where
    unknown Scope {currentTypeName, path} _ ref =
      unknownSelectionField currentTypeName ref `withPath` path
  
  instance Unknown (ObjectEntry valueS) (InputContext ctx) where
    unknown
      Scope {position, path}
      ctx
      ObjectEntry {entryName} =
        ( ( renderInputPrefix ctx
              <> "Unknown Field "
              <> msg entryName
              <> "."
          )
            `atPositions` position
        )
          `withPath` path
  
  instance Unknown (Directive s') ctx where
    unknown Scope {path} _ Directive {directiveName, directivePosition} =
      (("Unknown Directive " <> msg directiveName <> ".") `at` directivePosition) `withPath` path
  
  class KindViolation (t :: TypeCategory) ctx where
    kindViolation :: c t -> ctx -> GQLError
  
  instance KindViolation IMPLEMENTABLE (Fragment s) where
    kindViolation _ Fragment {fragmentName, fragmentType, fragmentPosition} =
      ( "Fragment "
          <> msg fragmentName
          <> " cannot condition on non composite type "
          <> msg fragmentType
          <> "."
      )
        `at` fragmentPosition
  
  instance KindViolation IN (Variable s) where
    kindViolation
      _
      Variable
        { variableName,
          variablePosition,
          variableType = TypeRef {typeConName}
        } =
        ( "Variable "
            <> msg ("$" <> variableName)
            <> " cannot be non-input type "
            <> msg typeConName
            <> "."
        )
          `at` variablePosition
  