{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      :  Data.GraphQL.Error
Maintainer  :  Brandon Chinn <brandon@leapyear.io>
Stability   :  experimental
Portability :  portable

Definitions for GraphQL errors and exceptions.
-}
module Data.GraphQL.Error (
  GraphQLError (..),
  GraphQLErrorLoc (..),
  GraphQLException (..),
) where

import Control.Exception (Exception)
import Data.Aeson (FromJSON (..), ToJSON, Value, withObject, (.:))
import Data.Text (Text)
import GHC.Generics (Generic)

-- | An error in a GraphQL query.
data GraphQLError = GraphQLError
  { GraphQLError -> Text
message :: Text
  , GraphQLError -> Maybe [GraphQLErrorLoc]
locations :: Maybe [GraphQLErrorLoc]
  , GraphQLError -> Maybe [Value]
path :: Maybe [Value]
  }
  deriving (Int -> GraphQLError -> ShowS
[GraphQLError] -> ShowS
GraphQLError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphQLError] -> ShowS
$cshowList :: [GraphQLError] -> ShowS
show :: GraphQLError -> String
$cshow :: GraphQLError -> String
showsPrec :: Int -> GraphQLError -> ShowS
$cshowsPrec :: Int -> GraphQLError -> ShowS
Show, GraphQLError -> GraphQLError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphQLError -> GraphQLError -> Bool
$c/= :: GraphQLError -> GraphQLError -> Bool
== :: GraphQLError -> GraphQLError -> Bool
$c== :: GraphQLError -> GraphQLError -> Bool
Eq, forall x. Rep GraphQLError x -> GraphQLError
forall x. GraphQLError -> Rep GraphQLError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GraphQLError x -> GraphQLError
$cfrom :: forall x. GraphQLError -> Rep GraphQLError x
Generic, [GraphQLError] -> Encoding
[GraphQLError] -> Value
GraphQLError -> Encoding
GraphQLError -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GraphQLError] -> Encoding
$ctoEncodingList :: [GraphQLError] -> Encoding
toJSONList :: [GraphQLError] -> Value
$ctoJSONList :: [GraphQLError] -> Value
toEncoding :: GraphQLError -> Encoding
$ctoEncoding :: GraphQLError -> Encoding
toJSON :: GraphQLError -> Value
$ctoJSON :: GraphQLError -> Value
ToJSON, Value -> Parser [GraphQLError]
Value -> Parser GraphQLError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GraphQLError]
$cparseJSONList :: Value -> Parser [GraphQLError]
parseJSON :: Value -> Parser GraphQLError
$cparseJSON :: Value -> Parser GraphQLError
FromJSON)

-- | A location in an error in a GraphQL query.
data GraphQLErrorLoc = GraphQLErrorLoc
  { GraphQLErrorLoc -> Int
errorLine :: Int
  , GraphQLErrorLoc -> Int
errorCol :: Int
  }
  deriving (Int -> GraphQLErrorLoc -> ShowS
[GraphQLErrorLoc] -> ShowS
GraphQLErrorLoc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphQLErrorLoc] -> ShowS
$cshowList :: [GraphQLErrorLoc] -> ShowS
show :: GraphQLErrorLoc -> String
$cshow :: GraphQLErrorLoc -> String
showsPrec :: Int -> GraphQLErrorLoc -> ShowS
$cshowsPrec :: Int -> GraphQLErrorLoc -> ShowS
Show, GraphQLErrorLoc -> GraphQLErrorLoc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphQLErrorLoc -> GraphQLErrorLoc -> Bool
$c/= :: GraphQLErrorLoc -> GraphQLErrorLoc -> Bool
== :: GraphQLErrorLoc -> GraphQLErrorLoc -> Bool
$c== :: GraphQLErrorLoc -> GraphQLErrorLoc -> Bool
Eq, forall x. Rep GraphQLErrorLoc x -> GraphQLErrorLoc
forall x. GraphQLErrorLoc -> Rep GraphQLErrorLoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GraphQLErrorLoc x -> GraphQLErrorLoc
$cfrom :: forall x. GraphQLErrorLoc -> Rep GraphQLErrorLoc x
Generic, [GraphQLErrorLoc] -> Encoding
[GraphQLErrorLoc] -> Value
GraphQLErrorLoc -> Encoding
GraphQLErrorLoc -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GraphQLErrorLoc] -> Encoding
$ctoEncodingList :: [GraphQLErrorLoc] -> Encoding
toJSONList :: [GraphQLErrorLoc] -> Value
$ctoJSONList :: [GraphQLErrorLoc] -> Value
toEncoding :: GraphQLErrorLoc -> Encoding
$ctoEncoding :: GraphQLErrorLoc -> Encoding
toJSON :: GraphQLErrorLoc -> Value
$ctoJSON :: GraphQLErrorLoc -> Value
ToJSON)

instance FromJSON GraphQLErrorLoc where
  parseJSON :: Value -> Parser GraphQLErrorLoc
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GraphQLErrorLoc" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Int -> Int -> GraphQLErrorLoc
GraphQLErrorLoc
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"line"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"column"

-- | An exception thrown as a result of an error in a GraphQL query.
newtype GraphQLException = GraphQLException [GraphQLError]
  deriving (Int -> GraphQLException -> ShowS
[GraphQLException] -> ShowS
GraphQLException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphQLException] -> ShowS
$cshowList :: [GraphQLException] -> ShowS
show :: GraphQLException -> String
$cshow :: GraphQLException -> String
showsPrec :: Int -> GraphQLException -> ShowS
$cshowsPrec :: Int -> GraphQLException -> ShowS
Show, Show GraphQLException
Typeable GraphQLException
SomeException -> Maybe GraphQLException
GraphQLException -> String
GraphQLException -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: GraphQLException -> String
$cdisplayException :: GraphQLException -> String
fromException :: SomeException -> Maybe GraphQLException
$cfromException :: SomeException -> Maybe GraphQLException
toException :: GraphQLException -> SomeException
$ctoException :: GraphQLException -> SomeException
Exception, GraphQLException -> GraphQLException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphQLException -> GraphQLException -> Bool
$c/= :: GraphQLException -> GraphQLException -> Bool
== :: GraphQLException -> GraphQLException -> Bool
$c== :: GraphQLException -> GraphQLException -> Bool
Eq)