{-# 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 :: forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> Variable s -> GQLError
unused
    OperationContext {Maybe FieldName
operationName :: forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> Maybe FieldName
operationName :: Maybe FieldName
operationName}
    Variable {FieldName
variableName :: forall (stage :: Stage). Variable stage -> FieldName
variableName :: FieldName
variableName, 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
" is never used in operation "
          forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (Maybe FieldName -> TypeName
getOperationName Maybe FieldName
operationName)
          forall a. Semigroup a => a -> a -> a
<> GQLError
"."
      )
        GQLError -> Position -> GQLError
`at` Position
variablePosition

instance Unused (Fragment s) where
  unused :: forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> Fragment s -> GQLError
unused
    OperationContext s1 s2
_
    Fragment {FragmentName
fragmentName :: forall (stage :: Stage). Fragment stage -> FragmentName
fragmentName :: FragmentName
fragmentName, Position
fragmentPosition :: forall (stage :: Stage). Fragment stage -> Position
fragmentPosition :: Position
fragmentPosition} =
      ( GQLError
"Fragment "
          forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FragmentName
fragmentName
          forall a. Semigroup a => a -> a -> a
<> GQLError
" is never used."
      )
        GQLError -> Position -> GQLError
`at` Position
fragmentPosition

class MissingRequired c ctx where
  missingRequired :: Scope -> ctx -> Ref FieldName -> c -> GQLError

instance MissingRequired (Arguments s) ctx where
  missingRequired :: Scope -> ctx -> Ref FieldName -> Arguments s -> GQLError
missingRequired
    Scope {Maybe Position
position :: Scope -> Maybe Position
position :: Maybe Position
position, ScopeKind
kind :: Scope -> ScopeKind
kind :: ScopeKind
kind, FieldName
fieldName :: Scope -> FieldName
fieldName :: FieldName
fieldName, [PropName]
path :: Scope -> [PropName]
path :: [PropName]
path}
    ctx
_
    Ref {FieldName
refName :: forall name. Ref name -> name
refName :: FieldName
refName}
    Arguments s
_ =
      ( ( ScopeKind -> GQLError
inScope ScopeKind
kind
            forall a. Semigroup a => a -> a -> a
<> GQLError
" argument "
            forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
refName
            forall a. Semigroup a => a -> a -> a
<> GQLError
" is required but not provided."
        )
          forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` Maybe Position
position
      )
        GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path
      where
        inScope :: ScopeKind -> GQLError
inScope ScopeKind
DIRECTIVE = GQLError
"Directive " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
fieldName
        inScope ScopeKind
_ = GQLError
"Field " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
fieldName

instance MissingRequired (Object s) (InputContext ctx) where
  missingRequired :: Scope -> InputContext ctx -> Ref FieldName -> Object s -> GQLError
missingRequired
    Scope {Maybe Position
position :: Maybe Position
position :: Scope -> Maybe Position
position, [PropName]
path :: [PropName]
path :: Scope -> [PropName]
path}
    InputContext ctx
ctx
    Ref {FieldName
refName :: FieldName
refName :: forall name. Ref name -> name
refName}
    Object s
_ =
      ( ( forall c. InputContext c -> GQLError
renderInputPrefix
            InputContext ctx
ctx
            forall a. Semigroup a => a -> a -> a
<> GQLError
"Undefined Field "
            forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
refName
            forall a. Semigroup a => a -> a -> a
<> GQLError
"."
        )
          forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` Maybe Position
position
      )
        GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path

instance MissingRequired (VariableDefinitions s) (OperationContext s1 s2) where
  missingRequired :: Scope
-> OperationContext s1 s2
-> Ref FieldName
-> VariableDefinitions s
-> GQLError
missingRequired
    Scope {[PropName]
path :: [PropName]
path :: Scope -> [PropName]
path}
    OperationContext
      { Maybe FieldName
operationName :: Maybe FieldName
operationName :: forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> Maybe FieldName
operationName
      }
    Ref {FieldName
refName :: FieldName
refName :: forall name. Ref name -> name
refName, Position
refPosition :: forall name. Ref name -> Position
refPosition :: Position
refPosition}
    VariableDefinitions s
_ =
      ( ( GQLError
"Variable "
            forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
refName
            forall a. Semigroup a => a -> a -> a
<> GQLError
" is not defined by operation "
            forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (Maybe FieldName -> TypeName
getOperationName Maybe FieldName
operationName)
            forall a. Semigroup a => a -> a -> a
<> GQLError
"."
        )
          GQLError -> Position -> GQLError
`at` Position
refPosition
      )
        GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path

class Unknown ref ctx where
  unknown :: Scope -> ctx -> ref -> GQLError

-- {...H} -> "Unknown fragment \"H\"."
instance Unknown (Ref FragmentName) ctx where
  unknown :: Scope -> ctx -> Ref FragmentName -> GQLError
unknown Scope {[PropName]
path :: [PropName]
path :: Scope -> [PropName]
path} ctx
_ Ref {FragmentName
refName :: FragmentName
refName :: forall name. Ref name -> name
refName, Position
refPosition :: Position
refPosition :: forall name. Ref name -> Position
refPosition} =
    ((GQLError
"Unknown Fragment " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FragmentName
refName forall a. Semigroup a => a -> a -> a
<> GQLError
".") GQLError -> Position -> GQLError
`at` Position
refPosition) GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path

instance Unknown (Ref TypeName) ctx where
  unknown :: Scope -> ctx -> Ref TypeName -> GQLError
unknown Scope {[PropName]
path :: [PropName]
path :: Scope -> [PropName]
path} ctx
_ Ref {TypeName
refName :: TypeName
refName :: forall name. Ref name -> name
refName, Position
refPosition :: Position
refPosition :: forall name. Ref name -> Position
refPosition} =
    ((GQLError
"Unknown type " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeName
refName forall a. Semigroup a => a -> a -> a
<> GQLError
".") GQLError -> Position -> GQLError
`at` Position
refPosition) GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path

instance Unknown (Argument s') ctx where
  unknown :: Scope -> ctx -> Argument s' -> GQLError
unknown Scope {ScopeKind
kind :: ScopeKind
kind :: Scope -> ScopeKind
kind, [PropName]
path :: [PropName]
path :: Scope -> [PropName]
path, FieldName
fieldName :: FieldName
fieldName :: Scope -> FieldName
fieldName} ctx
_ Argument {FieldName
argumentName :: forall (valid :: Stage). Argument valid -> FieldName
argumentName :: FieldName
argumentName, Position
argumentPosition :: forall (valid :: Stage). Argument valid -> Position
argumentPosition :: Position
argumentPosition} =
    ( ( GQLError
"Unknown Argument "
          forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
argumentName
          forall a. Semigroup a => a -> a -> a
<> GQLError
" on "
          forall a. Semigroup a => a -> a -> a
<> forall {a}. IsString a => ScopeKind -> a
scope ScopeKind
kind
          forall a. Semigroup a => a -> a -> a
<> GQLError
" "
          forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
fieldName
          forall a. Semigroup a => a -> a -> a
<> GQLError
"."
      )
        GQLError -> Position -> GQLError
`at` Position
argumentPosition
    )
      GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path
    where
      scope :: ScopeKind -> a
scope ScopeKind
DIRECTIVE = a
"Directive"
      scope ScopeKind
_ = a
"Field"

instance Unknown (Ref FieldName) ctx where
  unknown :: Scope -> ctx -> Ref FieldName -> GQLError
unknown Scope {TypeName
currentTypeName :: Scope -> TypeName
currentTypeName :: TypeName
currentTypeName, [PropName]
path :: [PropName]
path :: Scope -> [PropName]
path} ctx
_ Ref FieldName
ref =
    TypeName -> Ref FieldName -> GQLError
unknownSelectionField TypeName
currentTypeName Ref FieldName
ref GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path

instance Unknown (ObjectEntry valueS) (InputContext ctx) where
  unknown :: Scope -> InputContext ctx -> ObjectEntry valueS -> GQLError
unknown
    Scope {Maybe Position
position :: Maybe Position
position :: Scope -> Maybe Position
position, [PropName]
path :: [PropName]
path :: Scope -> [PropName]
path}
    InputContext ctx
ctx
    ObjectEntry {FieldName
entryName :: forall (s :: Stage). ObjectEntry s -> FieldName
entryName :: FieldName
entryName} =
      ( ( forall c. InputContext c -> GQLError
renderInputPrefix InputContext ctx
ctx
            forall a. Semigroup a => a -> a -> a
<> GQLError
"Unknown Field "
            forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
entryName
            forall a. Semigroup a => a -> a -> a
<> GQLError
"."
        )
          forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` Maybe Position
position
      )
        GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path

instance Unknown (Directive s') ctx where
  unknown :: Scope -> ctx -> Directive s' -> GQLError
unknown Scope {[PropName]
path :: [PropName]
path :: Scope -> [PropName]
path} ctx
_ Directive {FieldName
directiveName :: forall (s :: Stage). Directive s -> FieldName
directiveName :: FieldName
directiveName, Position
directivePosition :: forall (s :: Stage). Directive s -> Position
directivePosition :: Position
directivePosition} =
    ((GQLError
"Unknown Directive " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
directiveName forall a. Semigroup a => a -> a -> a
<> GQLError
".") GQLError -> Position -> GQLError
`at` Position
directivePosition) GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path

class KindViolation (t :: TypeCategory) ctx where
  kindViolation :: c t -> ctx -> GQLError

instance KindViolation IMPLEMENTABLE (Fragment s) where
  kindViolation :: forall (c :: TypeCategory -> *).
c IMPLEMENTABLE -> Fragment s -> GQLError
kindViolation c IMPLEMENTABLE
_ Fragment {FragmentName
fragmentName :: FragmentName
fragmentName :: forall (stage :: Stage). Fragment stage -> FragmentName
fragmentName, TypeName
fragmentType :: forall (stage :: Stage). Fragment stage -> TypeName
fragmentType :: TypeName
fragmentType, Position
fragmentPosition :: Position
fragmentPosition :: forall (stage :: Stage). Fragment stage -> Position
fragmentPosition} =
    ( GQLError
"Fragment "
        forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FragmentName
fragmentName
        forall a. Semigroup a => a -> a -> a
<> GQLError
" cannot condition on non composite type "
        forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeName
fragmentType
        forall a. Semigroup a => a -> a -> a
<> GQLError
"."
    )
      GQLError -> Position -> GQLError
`at` Position
fragmentPosition

instance KindViolation IN (Variable s) where
  kindViolation :: forall (c :: TypeCategory -> *). c IN -> Variable s -> GQLError
kindViolation
    c IN
_
    Variable
      { FieldName
variableName :: FieldName
variableName :: forall (stage :: Stage). Variable stage -> FieldName
variableName,
        Position
variablePosition :: Position
variablePosition :: forall (stage :: Stage). Variable stage -> Position
variablePosition,
        variableType :: forall (stage :: Stage). Variable stage -> TypeRef
variableType = TypeRef {TypeName
typeConName :: TypeRef -> TypeName
typeConName :: TypeName
typeConName}
      } =
      ( 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
" cannot be non-input type "
          forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeName
typeConName
          forall a. Semigroup a => a -> a -> a
<> GQLError
"."
      )
        GQLError -> Position -> GQLError
`at` Position
variablePosition