{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Morpheus.Error.Fragment
( cannotSpreadWithinItself
, unusedFragment
, unknownFragment
, cannotBeSpreadOnType
, fragmentNameCollision
)
where
import Data.Semigroup ( (<>) )
import Data.Text ( Text
, intercalate
)
import qualified Data.Text as T
import Data.Morpheus.Error.Utils ( errorMessage )
import Data.Morpheus.Types.Internal.AST.Base
( Ref(..)
, Position
)
import Data.Morpheus.Types.Internal.Resolving.Core
( GQLError(..)
, GQLErrors
)
fragmentNameCollision :: [Ref] -> GQLErrors
fragmentNameCollision = map toError
where
toError Ref { refName, refPosition } = GQLError
{ message = "There can be only one fragment named \"" <> refName <> "\"."
, locations = [refPosition]
}
unusedFragment :: [Ref] -> GQLErrors
unusedFragment = map toError
where
toError Ref { refName, refPosition } = GQLError
{ message = "Fragment \"" <> refName <> "\" is never used."
, locations = [refPosition]
}
cannotSpreadWithinItself :: [Ref] -> GQLErrors
cannotSpreadWithinItself fragments =
[GQLError { message = text, locations = map refPosition fragments }]
where
text = T.concat
[ "Cannot spread fragment \""
, refName $ head fragments
, "\" within itself via "
, T.intercalate ", " (map refName fragments)
, "."
]
unknownFragment :: Text -> Position -> GQLErrors
unknownFragment key' position' = errorMessage position' text
where text = T.concat ["Unknown Fragment \"", key', "\"."]
cannotBeSpreadOnType :: Maybe Text -> Text -> Position -> [Text] -> GQLErrors
cannotBeSpreadOnType key fragmentType position typeMembers = errorMessage
position
message
where
message =
"Fragment "
<> getName key
<> "cannot be spread here as objects of type \""
<> intercalate ", " typeMembers
<> "\" can never be of type \""
<> fragmentType
<> "\"."
getName (Just x) = "\"" <> x <> "\" "
getName Nothing = ""