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

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

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

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

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

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