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

module Data.Morpheus.Error.Selection
  ( unknownSelectionField,
    subfieldsNotSelected,
    hasNoSubfields,
  )
where

import Data.Morpheus.Types.Internal.AST
  ( FieldName,
    Position,
    Ref (..),
    TypeDefinition (..),
    TypeName,
    VALID,
    ValidationError (..),
    msg,
  )
import Data.Semigroup ((<>))

-- GQL: "Field \"default\" must not have a selection since type \"String!\" has no subfields."
hasNoSubfields :: Ref FieldName -> TypeDefinition s VALID -> ValidationError
hasNoSubfields :: Ref FieldName -> TypeDefinition s VALID -> ValidationError
hasNoSubfields (Ref FieldName
selectionName Position
position) TypeDefinition {TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName :: TypeName
typeName} = Message -> [Position] -> ValidationError
ValidationError Message
text [Position
position]
  where
    text :: Message
text =
      Message
"Field "
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
selectionName
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" must not have a selection since type "
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> TypeName -> Message
forall a. Msg a => a -> Message
msg TypeName
typeName
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" has no subfields."

unknownSelectionField :: TypeName -> Ref FieldName -> ValidationError
unknownSelectionField :: TypeName -> Ref FieldName -> ValidationError
unknownSelectionField TypeName
typeName Ref {FieldName
refName :: forall name. Ref name -> name
refName :: FieldName
refName, Position
refPosition :: forall name. Ref name -> Position
refPosition :: Position
refPosition} = Message -> [Position] -> ValidationError
ValidationError Message
text [Position
refPosition]
  where
    text :: Message
text =
      Message
"Cannot query field " Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
refName
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" on type "
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> TypeName -> Message
forall a. Msg a => a -> Message
msg TypeName
typeName
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
"."

-- GQL:: Field \"hobby\" of type \"Hobby!\" must have a selection of subfields. Did you mean \"hobby { ... }\"?
subfieldsNotSelected :: FieldName -> TypeName -> Position -> ValidationError
subfieldsNotSelected :: FieldName -> TypeName -> Position -> ValidationError
subfieldsNotSelected FieldName
fieldName TypeName
typeName Position
position = Message -> [Position] -> ValidationError
ValidationError Message
text [Position
position]
  where
    text :: Message
text =
      Message
"Field " Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
fieldName Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" of type "
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> TypeName -> Message
forall a. Msg a => a -> Message
msg TypeName
typeName
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" must have a selection of subfields"