{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_HADDOCK not-home #-}
module GraphQL.Internal.Output
( Response(..)
, Errors
, Error(..)
, GraphQLError(..)
, singleError
) where
import Protolude hiding (Location, Map)
import Data.Aeson (ToJSON(..))
import Data.List.NonEmpty (NonEmpty(..))
import GraphQL.Value
( Object
, objectFromList
, Value
, pattern ValueObject
, pattern ValueNull
, NameError(..)
, ToValue(..)
)
import GraphQL.Internal.Name (Name)
data Response
= Success Object
| PreExecutionFailure Errors
| ExecutionFailure Errors
| PartialSuccess Object Errors
deriving (Eq, Ord, Show)
unsafeMakeObject :: HasCallStack => [(Name, Value)] -> Value
unsafeMakeObject fields =
case objectFromList fields of
Nothing -> panic $ "Object has duplicate keys: " <> show fields
Just object -> ValueObject object
instance ToValue Response where
toValue (Success x) = unsafeMakeObject [("data", toValue x)]
toValue (PreExecutionFailure e) = unsafeMakeObject [("errors", toValue e)]
toValue (ExecutionFailure e) = unsafeMakeObject [("data", ValueNull)
,("errors", toValue e)]
toValue (PartialSuccess x e) = unsafeMakeObject [("data", toValue x)
,("errors", toValue e)
]
instance ToJSON Response where
toJSON = toJSON . toValue
type Errors = NonEmpty Error
data Error = Error Text [Location] deriving (Eq, Ord, Show)
instance ToValue Error where
toValue (Error message []) = unsafeMakeObject [("message", toValue message)]
toValue (Error message locations) = unsafeMakeObject [("message", toValue message)
,("locations", toValue locations)
]
singleError :: GraphQLError e => e -> Errors
singleError e = toError e :| []
data Location = Location Line Column deriving (Eq, Ord, Show)
type Line = Int32
type Column = Int32
instance ToValue Location where
toValue (Location line column) = unsafeMakeObject [("line" , toValue line)
,("column", toValue column)
]
class GraphQLError e where
formatError :: e -> Text
toError :: e -> Error
toError e = Error (formatError e) []
instance GraphQLError NameError where
formatError (NameError name) = "Not a valid GraphQL name: " <> show name