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

module Data.Morpheus.Error.Fragment
  ( cannotSpreadWithinItself,
    cannotBeSpreadOnType,
  )
where

-- MORPHEUS
import Data.Morpheus.Types.Internal.AST.Base
  ( Position,
    Ref (..),
  )
import Data.Morpheus.Types.Internal.AST.Error
  ( GQLError,
    at,
    atPositions,
    manyMsg,
    msg,
  )
import Data.Morpheus.Types.Internal.AST.Name
  ( FragmentName,
    TypeName,
  )
import Relude

{-
  FRAGMENT:
    type Experience {
        experience ( lang: LANGUAGE ) : String ,
        date: String
    }
    fragment type mismatch -> "Fragment \"H\" cannot be spread here as objects of type \"Hobby\" can never be of type \"Experience\"."
    fragment H on T1 { ...A} , fragment A on T { ...H } -> "Cannot spread fragment \"H\" within itself via A."
    fragment H on D {...}  ->  "Unknown type \"D\"."
    {...H} -> "Unknown fragment \"H\"."
-}

cannotSpreadWithinItself :: NonEmpty (Ref FragmentName) -> GQLError
cannotSpreadWithinItself :: NonEmpty (Ref FragmentName) -> GQLError
cannotSpreadWithinItself (Ref FragmentName
fr :| [Ref FragmentName]
frs) =
  ( GQLError
"Cannot spread fragment "
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> FragmentName -> GQLError
forall a. Msg a => a -> GQLError
msg (Ref FragmentName -> FragmentName
forall name. Ref name -> name
refName Ref FragmentName
fr)
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" within itself via "
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> [FragmentName] -> GQLError
forall (t :: * -> *) a. (Foldable t, Msg a) => t a -> GQLError
manyMsg (Ref FragmentName -> FragmentName
forall name. Ref name -> name
refName (Ref FragmentName -> FragmentName)
-> [Ref FragmentName] -> [FragmentName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ref FragmentName
fr Ref FragmentName -> [Ref FragmentName] -> [Ref FragmentName]
forall a. a -> [a] -> [a]
: [Ref FragmentName]
frs))
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"."
  )
    GQLError -> [Position] -> GQLError
forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` (Ref FragmentName -> Position) -> [Ref FragmentName] -> [Position]
forall a b. (a -> b) -> [a] -> [b]
map Ref FragmentName -> Position
forall name. Ref name -> Position
refPosition (Ref FragmentName
fr Ref FragmentName -> [Ref FragmentName] -> [Ref FragmentName]
forall a. a -> [a] -> [a]
: [Ref FragmentName]
frs)

-- Fragment type mismatch -> "Fragment \"H\" cannot be spread here as objects of type \"Hobby\" can never be of type \"Experience\"."
cannotBeSpreadOnType :: Maybe FragmentName -> TypeName -> Position -> [TypeName] -> GQLError
cannotBeSpreadOnType :: Maybe FragmentName
-> TypeName -> Position -> [TypeName] -> GQLError
cannotBeSpreadOnType Maybe FragmentName
key TypeName
fragmentType Position
position [TypeName]
typeMembers =
  ( GQLError
"Fragment "
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> Maybe FragmentName -> GQLError
forall a. Msg a => Maybe a -> GQLError
getName Maybe FragmentName
key
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"cannot be spread here as objects of type "
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> [TypeName] -> GQLError
forall (t :: * -> *) a. (Foldable t, Msg a) => t a -> GQLError
manyMsg [TypeName]
typeMembers
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" can never be of type "
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeName -> GQLError
forall a. Msg a => a -> GQLError
msg TypeName
fragmentType
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"."
  )
    GQLError -> Position -> GQLError
`at` Position
position
  where
    getName :: Maybe a -> GQLError
getName (Just a
x) = a -> GQLError
forall a. Msg a => a -> GQLError
msg a
x GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" "
    getName Maybe a
Nothing = GQLError
""