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

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

-- MORPHEUS
import Data.Morpheus.Error.Utils (validationErrorMessage)
import Data.Morpheus.Types.Internal.AST.Base
  ( FieldName,
    Position,
    Ref (..),
    TypeName,
    ValidationError (..),
    msg,
    msgSepBy,
  )
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 FieldName) -> ValidationError
cannotSpreadWithinItself :: NonEmpty (Ref FieldName) -> ValidationError
cannotSpreadWithinItself (Ref FieldName
fr :| [Ref FieldName]
frs) = Message -> [Position] -> ValidationError
ValidationError Message
text ((Ref FieldName -> Position) -> [Ref FieldName] -> [Position]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ref FieldName -> Position
forall name. Ref name -> Position
refPosition (Ref FieldName
fr Ref FieldName -> [Ref FieldName] -> [Ref FieldName]
forall a. a -> [a] -> [a]
: [Ref FieldName]
frs))
  where
    text :: Message
text =
      Message
"Cannot spread fragment "
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg (Ref FieldName -> FieldName
forall name. Ref name -> name
refName Ref FieldName
fr)
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" within itself via "
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Text -> [FieldName] -> Message
forall a. Msg a => Text -> [a] -> Message
msgSepBy Text
", " ((Ref FieldName -> FieldName) -> [Ref FieldName] -> [FieldName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ref FieldName -> FieldName
forall name. Ref name -> name
refName (Ref FieldName
fr Ref FieldName -> [Ref FieldName] -> [Ref FieldName]
forall a. a -> [a] -> [a]
: [Ref FieldName]
frs))
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
"."

-- Fragment type mismatch -> "Fragment \"H\" cannot be spread here as objects of type \"Hobby\" can never be of type \"Experience\"."
cannotBeSpreadOnType :: Maybe FieldName -> TypeName -> Position -> [TypeName] -> ValidationError
cannotBeSpreadOnType :: Maybe FieldName
-> TypeName -> Position -> [TypeName] -> ValidationError
cannotBeSpreadOnType Maybe FieldName
key TypeName
fragmentType Position
position [TypeName]
typeMembers =
  Maybe Position -> Message -> ValidationError
validationErrorMessage
    (Position -> Maybe Position
forall a. a -> Maybe a
Just Position
position)
    Message
text
  where
    text :: Message
text =
      Message
"Fragment "
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Maybe FieldName -> Message
forall a. Msg a => Maybe a -> Message
getName Maybe FieldName
key
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
"cannot be spread here as objects of type "
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Text -> [TypeName] -> Message
forall a. Msg a => Text -> [a] -> Message
msgSepBy Text
", " [TypeName]
typeMembers
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" can never be of type "
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> TypeName -> Message
forall a. Msg a => a -> Message
msg TypeName
fragmentType
        Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
"."
    getName :: Maybe a -> Message
getName (Just a
x) = a -> Message
forall a. Msg a => a -> Message
msg a
x Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" "
    getName Maybe a
Nothing = Message
""