{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.Internal.AST.Error
( at,
atPositions,
custom,
isCustom,
internal,
isInternal,
getCustomErrorType,
GQLErrors,
GQLError
( message,
locations
),
manyMsg,
Msg (..),
Message,
withPath,
withExtensions,
PropName (..),
)
where
import Data.Aeson
( FromJSON (..),
Options (..),
ToJSON (..),
Value (Null, Number, String),
defaultOptions,
encode,
genericParseJSON,
genericToJSON,
)
import Data.ByteString.Lazy (ByteString)
import Data.Morpheus.Types.Internal.AST.Base
( Position (..),
)
import Data.Scientific (floatingOrInteger)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Encoding (decodeUtf8)
import Relude hiding (ByteString, decodeUtf8)
type Message = Text
internal :: GQLError -> GQLError
internal :: GQLError -> GQLError
internal GQLError
x = GQLError
x {errorType :: Maybe ErrorType
errorType = ErrorType -> Maybe ErrorType
forall a. a -> Maybe a
Just ErrorType
Internal}
isInternal :: GQLError -> Bool
isInternal :: GQLError -> Bool
isInternal GQLError {errorType :: GQLError -> Maybe ErrorType
errorType = Just ErrorType
Internal} = Bool
True
isInternal GQLError
_ = Bool
False
custom :: GQLError -> Text -> GQLError
custom :: GQLError -> Text -> GQLError
custom GQLError
x Text
customError = GQLError
x {errorType :: Maybe ErrorType
errorType = ErrorType -> Maybe ErrorType
forall a. a -> Maybe a
Just (Text -> ErrorType
Custom Text
customError)}
isCustom :: GQLError -> Bool
isCustom :: GQLError -> Bool
isCustom GQLError {errorType :: GQLError -> Maybe ErrorType
errorType = Just (Custom Text
_)} = Bool
True
isCustom GQLError
_ = Bool
False
getCustomErrorType :: GQLError -> Maybe Text
getCustomErrorType :: GQLError -> Maybe Text
getCustomErrorType GQLError {errorType :: GQLError -> Maybe ErrorType
errorType = Just (Custom Text
customError)} = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
customError
getCustomErrorType GQLError
_ = Maybe Text
forall a. Maybe a
Nothing
at :: GQLError -> Position -> GQLError
at :: GQLError -> Position -> GQLError
at GQLError
err Position
pos = GQLError -> [Position] -> GQLError
forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
atPositions GQLError
err [Position
pos]
{-# INLINE at #-}
atPositions :: Foldable t => GQLError -> t Position -> GQLError
atPositions :: GQLError -> t Position -> GQLError
atPositions GQLError {Maybe [Position]
Maybe [PropName]
Maybe (Map Text Value)
Maybe ErrorType
Text
extensions :: GQLError -> Maybe (Map Text Value)
path :: GQLError -> Maybe [PropName]
extensions :: Maybe (Map Text Value)
errorType :: Maybe ErrorType
path :: Maybe [PropName]
locations :: Maybe [Position]
message :: Text
errorType :: GQLError -> Maybe ErrorType
locations :: GQLError -> Maybe [Position]
message :: GQLError -> Text
..} t Position
pos = case t Position -> [Position]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Position
pos of
[] -> GQLError :: Text
-> Maybe [Position]
-> Maybe [PropName]
-> Maybe ErrorType
-> Maybe (Map Text Value)
-> GQLError
GQLError {Maybe [Position]
Maybe [PropName]
Maybe (Map Text Value)
Maybe ErrorType
Text
extensions :: Maybe (Map Text Value)
path :: Maybe [PropName]
extensions :: Maybe (Map Text Value)
errorType :: Maybe ErrorType
path :: Maybe [PropName]
locations :: Maybe [Position]
message :: Text
errorType :: Maybe ErrorType
locations :: Maybe [Position]
message :: Text
..}
[Position]
posList -> GQLError :: Text
-> Maybe [Position]
-> Maybe [PropName]
-> Maybe ErrorType
-> Maybe (Map Text Value)
-> GQLError
GQLError {locations :: Maybe [Position]
locations = Maybe [Position]
locations Maybe [Position] -> Maybe [Position] -> Maybe [Position]
forall a. Semigroup a => a -> a -> a
<> [Position] -> Maybe [Position]
forall a. a -> Maybe a
Just [Position]
posList, Maybe [PropName]
Maybe (Map Text Value)
Maybe ErrorType
Text
extensions :: Maybe (Map Text Value)
path :: Maybe [PropName]
extensions :: Maybe (Map Text Value)
errorType :: Maybe ErrorType
path :: Maybe [PropName]
message :: Text
errorType :: Maybe ErrorType
message :: Text
..}
{-# INLINE atPositions #-}
withExtensions :: GQLError -> Map Text Value -> GQLError
withExtensions :: GQLError -> Map Text Value -> GQLError
withExtensions GQLError
gqlerr Map Text Value
ext = GQLError
gqlerr { extensions :: Maybe (Map Text Value)
extensions = Map Text Value -> Maybe (Map Text Value)
forall a. a -> Maybe a
Just Map Text Value
ext }
withPath :: GQLError -> [PropName] -> GQLError
withPath :: GQLError -> [PropName] -> GQLError
withPath GQLError
err [] = GQLError
err
withPath GQLError
err [PropName]
path = GQLError
err {path :: Maybe [PropName]
path = [PropName] -> Maybe [PropName]
forall a. a -> Maybe a
Just [PropName]
path}
manyMsg :: (Foldable t, Msg a) => t a -> GQLError
manyMsg :: t a -> GQLError
manyMsg =
Text -> GQLError
forall a. Msg a => a -> GQLError
msg (Text -> GQLError) -> (t a -> Text) -> t a -> GQLError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
", "
([Text] -> Text) -> (t a -> [Text]) -> t a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GQLError -> Text
message (GQLError -> Text) -> (a -> GQLError) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GQLError
forall a. Msg a => a -> GQLError
msg)
([a] -> [Text]) -> (t a -> [a]) -> t a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
data ErrorType
= Internal
| Custom Text
deriving
( Int -> ErrorType -> ShowS
[ErrorType] -> ShowS
ErrorType -> String
(Int -> ErrorType -> ShowS)
-> (ErrorType -> String)
-> ([ErrorType] -> ShowS)
-> Show ErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorType] -> ShowS
$cshowList :: [ErrorType] -> ShowS
show :: ErrorType -> String
$cshow :: ErrorType -> String
showsPrec :: Int -> ErrorType -> ShowS
$cshowsPrec :: Int -> ErrorType -> ShowS
Show,
ErrorType -> ErrorType -> Bool
(ErrorType -> ErrorType -> Bool)
-> (ErrorType -> ErrorType -> Bool) -> Eq ErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorType -> ErrorType -> Bool
$c/= :: ErrorType -> ErrorType -> Bool
== :: ErrorType -> ErrorType -> Bool
$c== :: ErrorType -> ErrorType -> Bool
Eq,
(forall x. ErrorType -> Rep ErrorType x)
-> (forall x. Rep ErrorType x -> ErrorType) -> Generic ErrorType
forall x. Rep ErrorType x -> ErrorType
forall x. ErrorType -> Rep ErrorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorType x -> ErrorType
$cfrom :: forall x. ErrorType -> Rep ErrorType x
Generic
)
instance ToJSON ErrorType where
toJSON :: ErrorType -> Value
toJSON (Custom Text
customError) = Text -> Value
String Text
customError
toJSON ErrorType
Internal = Value
Null
instance FromJSON ErrorType where
parseJSON :: Value -> Parser ErrorType
parseJSON (String Text
customError) = ErrorType -> Parser ErrorType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorType -> Parser ErrorType) -> ErrorType -> Parser ErrorType
forall a b. (a -> b) -> a -> b
$ Text -> ErrorType
Custom Text
customError
parseJSON Value
_ = String -> Parser ErrorType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected custom error type"
instance Semigroup ErrorType where
ErrorType
Internal <> :: ErrorType -> ErrorType -> ErrorType
<> ErrorType
_ = ErrorType
Internal
ErrorType
_ <> ErrorType
Internal = ErrorType
Internal
Custom Text
customError <> Custom Text
customError' = Text -> ErrorType
Custom (Text -> ErrorType) -> Text -> ErrorType
forall a b. (a -> b) -> a -> b
$ Text
customError Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
customError'
data GQLError = GQLError
{ GQLError -> Text
message :: Message,
GQLError -> Maybe [Position]
locations :: Maybe [Position],
GQLError -> Maybe [PropName]
path :: Maybe [PropName],
GQLError -> Maybe ErrorType
errorType :: Maybe ErrorType,
GQLError -> Maybe (Map Text Value)
extensions :: Maybe (Map Text Value)
}
deriving
( Int -> GQLError -> ShowS
[GQLError] -> ShowS
GQLError -> String
(Int -> GQLError -> ShowS)
-> (GQLError -> String) -> ([GQLError] -> ShowS) -> Show GQLError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GQLError] -> ShowS
$cshowList :: [GQLError] -> ShowS
show :: GQLError -> String
$cshow :: GQLError -> String
showsPrec :: Int -> GQLError -> ShowS
$cshowsPrec :: Int -> GQLError -> ShowS
Show,
GQLError -> GQLError -> Bool
(GQLError -> GQLError -> Bool)
-> (GQLError -> GQLError -> Bool) -> Eq GQLError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GQLError -> GQLError -> Bool
$c/= :: GQLError -> GQLError -> Bool
== :: GQLError -> GQLError -> Bool
$c== :: GQLError -> GQLError -> Bool
Eq,
(forall x. GQLError -> Rep GQLError x)
-> (forall x. Rep GQLError x -> GQLError) -> Generic GQLError
forall x. Rep GQLError x -> GQLError
forall x. GQLError -> Rep GQLError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GQLError x -> GQLError
$cfrom :: forall x. GQLError -> Rep GQLError x
Generic
)
data PropName
= PropIndex Int
| PropName Text
deriving (Int -> PropName -> ShowS
[PropName] -> ShowS
PropName -> String
(Int -> PropName -> ShowS)
-> (PropName -> String) -> ([PropName] -> ShowS) -> Show PropName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropName] -> ShowS
$cshowList :: [PropName] -> ShowS
show :: PropName -> String
$cshow :: PropName -> String
showsPrec :: Int -> PropName -> ShowS
$cshowsPrec :: Int -> PropName -> ShowS
Show, PropName -> PropName -> Bool
(PropName -> PropName -> Bool)
-> (PropName -> PropName -> Bool) -> Eq PropName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PropName -> PropName -> Bool
$c/= :: PropName -> PropName -> Bool
== :: PropName -> PropName -> Bool
$c== :: PropName -> PropName -> Bool
Eq, (forall x. PropName -> Rep PropName x)
-> (forall x. Rep PropName x -> PropName) -> Generic PropName
forall x. Rep PropName x -> PropName
forall x. PropName -> Rep PropName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PropName x -> PropName
$cfrom :: forall x. PropName -> Rep PropName x
Generic)
instance IsString PropName where
fromString :: String -> PropName
fromString = Text -> PropName
PropName (Text -> PropName) -> (String -> Text) -> String -> PropName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
instance FromJSON PropName where
parseJSON :: Value -> Parser PropName
parseJSON (String Text
name) = PropName -> Parser PropName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> PropName
PropName Text
name)
parseJSON (Number Scientific
v) = case Scientific -> Either Double Int
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
v of
Left Double
fl -> Double -> Parser PropName
forall (m :: * -> *) a. MonadFail m => Double -> m a
invalidIndex Double
fl
Right Int
index -> PropName -> Parser PropName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> PropName
PropIndex Int
index)
parseJSON Value
_ = String -> Parser PropName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Property Name must be a either Name or Index"
invalidIndex :: MonadFail m => Double -> m a
invalidIndex :: Double -> m a
invalidIndex Double
i = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Property Name must be a either Name or Index. it can't be " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall b a. (Show a, IsString b) => a -> b
show Double
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
instance ToJSON PropName where
toJSON :: PropName -> Value
toJSON (PropName Text
name) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
name
toJSON (PropIndex Int
index) = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
index
instance Ord GQLError where
compare :: GQLError -> GQLError -> Ordering
compare GQLError
x GQLError
y = Maybe [Position] -> Maybe [Position] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (GQLError -> Maybe [Position]
locations GQLError
x) (GQLError -> Maybe [Position]
locations GQLError
y) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (GQLError -> Text
message GQLError
x) (GQLError -> Text
message GQLError
y)
instance IsString GQLError where
fromString :: String -> GQLError
fromString = String -> GQLError
forall a. Msg a => a -> GQLError
msg
stripErrorPrefix :: String -> String
stripErrorPrefix :: ShowS
stripErrorPrefix String
"errorType" = String
"type"
stripErrorPrefix String
other = String
other
aesonOptions :: Options
aesonOptions :: Options
aesonOptions = Options
defaultOptions {omitNothingFields :: Bool
omitNothingFields = Bool
True, fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
stripErrorPrefix}
instance ToJSON GQLError where
toJSON :: GQLError -> Value
toJSON = Options -> GQLError -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions
instance FromJSON GQLError where
parseJSON :: Value -> Parser GQLError
parseJSON = Options -> Value -> Parser GQLError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions
instance Semigroup GQLError where
GQLError Text
m1 Maybe [Position]
l1 Maybe [PropName]
p1 Maybe ErrorType
t1 Maybe (Map Text Value)
e1 <> :: GQLError -> GQLError -> GQLError
<> GQLError Text
m2 Maybe [Position]
l2 Maybe [PropName]
p2 Maybe ErrorType
t2 Maybe (Map Text Value)
e2 = Text
-> Maybe [Position]
-> Maybe [PropName]
-> Maybe ErrorType
-> Maybe (Map Text Value)
-> GQLError
GQLError (Text
m1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
m2) (Maybe [Position]
l1 Maybe [Position] -> Maybe [Position] -> Maybe [Position]
forall a. Semigroup a => a -> a -> a
<> Maybe [Position]
l2) (Maybe [PropName]
p1 Maybe [PropName] -> Maybe [PropName] -> Maybe [PropName]
forall a. Semigroup a => a -> a -> a
<> Maybe [PropName]
p2) (Maybe ErrorType
t1 Maybe ErrorType -> Maybe ErrorType -> Maybe ErrorType
forall a. Semigroup a => a -> a -> a
<> Maybe ErrorType
t2) (Maybe (Map Text Value)
e1 Maybe (Map Text Value)
-> Maybe (Map Text Value) -> Maybe (Map Text Value)
forall a. Semigroup a => a -> a -> a
<> Maybe (Map Text Value)
e2)
type GQLErrors = NonEmpty GQLError
class Msg a where
msg :: a -> GQLError
instance Msg GQLError where
msg :: GQLError -> GQLError
msg = GQLError -> GQLError
forall a. a -> a
id
instance Msg String where
msg :: String -> GQLError
msg = Text -> GQLError
forall a. Msg a => a -> GQLError
msg (Text -> GQLError) -> (String -> Text) -> String -> GQLError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
instance Msg Text where
msg :: Text -> GQLError
msg Text
message =
GQLError :: Text
-> Maybe [Position]
-> Maybe [PropName]
-> Maybe ErrorType
-> Maybe (Map Text Value)
-> GQLError
GQLError
{ Text
message :: Text
message :: Text
message,
locations :: Maybe [Position]
locations = Maybe [Position]
forall a. Maybe a
Nothing,
errorType :: Maybe ErrorType
errorType = Maybe ErrorType
forall a. Maybe a
Nothing,
extensions :: Maybe (Map Text Value)
extensions = Maybe (Map Text Value)
forall a. Maybe a
Nothing,
path :: Maybe [PropName]
path = Maybe [PropName]
forall a. Maybe a
Nothing
}
instance Msg ByteString where
msg :: ByteString -> GQLError
msg = Text -> GQLError
forall a. Msg a => a -> GQLError
msg (Text -> GQLError)
-> (ByteString -> Text) -> ByteString -> GQLError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8
instance Msg Value where
msg :: Value -> GQLError
msg = ByteString -> GQLError
forall a. Msg a => a -> GQLError
msg (ByteString -> GQLError)
-> (Value -> ByteString) -> Value -> GQLError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode