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

{-|
Module      :  Data.GraphQL.Error
Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com>
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
(Int -> GraphQLError -> ShowS)
-> (GraphQLError -> String)
-> ([GraphQLError] -> ShowS)
-> Show GraphQLError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GraphQLError -> ShowS
showsPrec :: Int -> GraphQLError -> ShowS
$cshow :: GraphQLError -> String
show :: GraphQLError -> String
$cshowList :: [GraphQLError] -> ShowS
showList :: [GraphQLError] -> ShowS
Show, GraphQLError -> GraphQLError -> Bool
(GraphQLError -> GraphQLError -> Bool)
-> (GraphQLError -> GraphQLError -> Bool) -> Eq GraphQLError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GraphQLError -> GraphQLError -> Bool
== :: GraphQLError -> GraphQLError -> Bool
$c/= :: GraphQLError -> GraphQLError -> Bool
/= :: GraphQLError -> GraphQLError -> Bool
Eq, (forall x. GraphQLError -> Rep GraphQLError x)
-> (forall x. Rep GraphQLError x -> GraphQLError)
-> Generic GraphQLError
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
$cfrom :: forall x. GraphQLError -> Rep GraphQLError x
from :: forall x. GraphQLError -> Rep GraphQLError x
$cto :: forall x. Rep GraphQLError x -> GraphQLError
to :: forall x. Rep GraphQLError x -> GraphQLError
Generic, [GraphQLError] -> Value
[GraphQLError] -> Encoding
GraphQLError -> Bool
GraphQLError -> Value
GraphQLError -> Encoding
(GraphQLError -> Value)
-> (GraphQLError -> Encoding)
-> ([GraphQLError] -> Value)
-> ([GraphQLError] -> Encoding)
-> (GraphQLError -> Bool)
-> ToJSON GraphQLError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GraphQLError -> Value
toJSON :: GraphQLError -> Value
$ctoEncoding :: GraphQLError -> Encoding
toEncoding :: GraphQLError -> Encoding
$ctoJSONList :: [GraphQLError] -> Value
toJSONList :: [GraphQLError] -> Value
$ctoEncodingList :: [GraphQLError] -> Encoding
toEncodingList :: [GraphQLError] -> Encoding
$comitField :: GraphQLError -> Bool
omitField :: GraphQLError -> Bool
ToJSON, Maybe GraphQLError
Value -> Parser [GraphQLError]
Value -> Parser GraphQLError
(Value -> Parser GraphQLError)
-> (Value -> Parser [GraphQLError])
-> Maybe GraphQLError
-> FromJSON GraphQLError
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GraphQLError
parseJSON :: Value -> Parser GraphQLError
$cparseJSONList :: Value -> Parser [GraphQLError]
parseJSONList :: Value -> Parser [GraphQLError]
$comittedField :: Maybe GraphQLError
omittedField :: Maybe 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
(Int -> GraphQLErrorLoc -> ShowS)
-> (GraphQLErrorLoc -> String)
-> ([GraphQLErrorLoc] -> ShowS)
-> Show GraphQLErrorLoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GraphQLErrorLoc -> ShowS
showsPrec :: Int -> GraphQLErrorLoc -> ShowS
$cshow :: GraphQLErrorLoc -> String
show :: GraphQLErrorLoc -> String
$cshowList :: [GraphQLErrorLoc] -> ShowS
showList :: [GraphQLErrorLoc] -> ShowS
Show, GraphQLErrorLoc -> GraphQLErrorLoc -> Bool
(GraphQLErrorLoc -> GraphQLErrorLoc -> Bool)
-> (GraphQLErrorLoc -> GraphQLErrorLoc -> Bool)
-> Eq GraphQLErrorLoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GraphQLErrorLoc -> GraphQLErrorLoc -> Bool
== :: GraphQLErrorLoc -> GraphQLErrorLoc -> Bool
$c/= :: GraphQLErrorLoc -> GraphQLErrorLoc -> Bool
/= :: GraphQLErrorLoc -> GraphQLErrorLoc -> Bool
Eq, (forall x. GraphQLErrorLoc -> Rep GraphQLErrorLoc x)
-> (forall x. Rep GraphQLErrorLoc x -> GraphQLErrorLoc)
-> Generic GraphQLErrorLoc
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
$cfrom :: forall x. GraphQLErrorLoc -> Rep GraphQLErrorLoc x
from :: forall x. GraphQLErrorLoc -> Rep GraphQLErrorLoc x
$cto :: forall x. Rep GraphQLErrorLoc x -> GraphQLErrorLoc
to :: forall x. Rep GraphQLErrorLoc x -> GraphQLErrorLoc
Generic, [GraphQLErrorLoc] -> Value
[GraphQLErrorLoc] -> Encoding
GraphQLErrorLoc -> Bool
GraphQLErrorLoc -> Value
GraphQLErrorLoc -> Encoding
(GraphQLErrorLoc -> Value)
-> (GraphQLErrorLoc -> Encoding)
-> ([GraphQLErrorLoc] -> Value)
-> ([GraphQLErrorLoc] -> Encoding)
-> (GraphQLErrorLoc -> Bool)
-> ToJSON GraphQLErrorLoc
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GraphQLErrorLoc -> Value
toJSON :: GraphQLErrorLoc -> Value
$ctoEncoding :: GraphQLErrorLoc -> Encoding
toEncoding :: GraphQLErrorLoc -> Encoding
$ctoJSONList :: [GraphQLErrorLoc] -> Value
toJSONList :: [GraphQLErrorLoc] -> Value
$ctoEncodingList :: [GraphQLErrorLoc] -> Encoding
toEncodingList :: [GraphQLErrorLoc] -> Encoding
$comitField :: GraphQLErrorLoc -> Bool
omitField :: GraphQLErrorLoc -> Bool
ToJSON)

instance FromJSON GraphQLErrorLoc where
  parseJSON :: Value -> Parser GraphQLErrorLoc
parseJSON = String
-> (Object -> Parser GraphQLErrorLoc)
-> Value
-> Parser GraphQLErrorLoc
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GraphQLErrorLoc" ((Object -> Parser GraphQLErrorLoc)
 -> Value -> Parser GraphQLErrorLoc)
-> (Object -> Parser GraphQLErrorLoc)
-> Value
-> Parser GraphQLErrorLoc
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Int -> Int -> GraphQLErrorLoc
GraphQLErrorLoc
      (Int -> Int -> GraphQLErrorLoc)
-> Parser Int -> Parser (Int -> GraphQLErrorLoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"line"
      Parser (Int -> GraphQLErrorLoc)
-> Parser Int -> Parser GraphQLErrorLoc
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
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
(Int -> GraphQLException -> ShowS)
-> (GraphQLException -> String)
-> ([GraphQLException] -> ShowS)
-> Show GraphQLException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GraphQLException -> ShowS
showsPrec :: Int -> GraphQLException -> ShowS
$cshow :: GraphQLException -> String
show :: GraphQLException -> String
$cshowList :: [GraphQLException] -> ShowS
showList :: [GraphQLException] -> ShowS
Show, Show GraphQLException
Typeable GraphQLException
(Typeable GraphQLException, Show GraphQLException) =>
(GraphQLException -> SomeException)
-> (SomeException -> Maybe GraphQLException)
-> (GraphQLException -> String)
-> Exception GraphQLException
SomeException -> Maybe GraphQLException
GraphQLException -> String
GraphQLException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: GraphQLException -> SomeException
toException :: GraphQLException -> SomeException
$cfromException :: SomeException -> Maybe GraphQLException
fromException :: SomeException -> Maybe GraphQLException
$cdisplayException :: GraphQLException -> String
displayException :: GraphQLException -> String
Exception, GraphQLException -> GraphQLException -> Bool
(GraphQLException -> GraphQLException -> Bool)
-> (GraphQLException -> GraphQLException -> Bool)
-> Eq GraphQLException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GraphQLException -> GraphQLException -> Bool
== :: GraphQLException -> GraphQLException -> Bool
$c/= :: GraphQLException -> GraphQLException -> Bool
/= :: GraphQLException -> GraphQLException -> Bool
Eq)