{-# 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 = 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 = 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)} = forall a. a -> Maybe a
Just Text
customError
getCustomErrorType GQLError
_ = forall a. Maybe a
Nothing
at :: GQLError -> Position -> GQLError
at :: GQLError -> Position -> GQLError
at GQLError
err Position
pos = forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
atPositions GQLError
err [Position
pos]
{-# INLINE at #-}
atPositions :: Foldable t => GQLError -> t Position -> GQLError
atPositions :: forall (t :: * -> *).
Foldable t =>
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 forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Position
pos of
[] -> 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 {locations :: Maybe [Position]
locations = Maybe [Position]
locations forall a. Semigroup a => a -> a -> a
<> 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 = 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 = forall a. a -> Maybe a
Just [PropName]
path}
manyMsg :: (Foldable t, Msg a) => t a -> GQLError
manyMsg :: forall (t :: * -> *) a. (Foldable t, Msg a) => t a -> GQLError
manyMsg =
forall a. Msg a => a -> GQLError
msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
", "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GQLError -> Text
message forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Msg a => a -> GQLError
msg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
data ErrorType
= Internal
| Custom Text
deriving
( Int -> ErrorType -> ShowS
[ErrorType] -> ShowS
ErrorType -> String
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
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. 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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ErrorType
Custom Text
customError
parseJSON Value
_ = 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 forall a b. (a -> b) -> a -> b
$ Text
customError forall a. Semigroup a => a -> a -> a
<> 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
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
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. 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
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
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. 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 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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> PropName
PropName Text
name)
parseJSON (Number Scientific
v) = case forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
v of
Left Double
fl -> forall (m :: * -> *) a. MonadFail m => Double -> m a
invalidIndex Double
fl
Right Int
index -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> PropName
PropIndex Int
index)
parseJSON Value
_ = 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 :: forall (m :: * -> *) a. MonadFail m => Double -> m a
invalidIndex Double
i = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Property Name must be a either Name or Index. it can't be " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Double
i forall a. Semigroup a => a -> a -> a
<> String
"."
instance ToJSON PropName where
toJSON :: PropName -> Value
toJSON (PropName Text
name) = forall a. ToJSON a => a -> Value
toJSON Text
name
toJSON (PropIndex Int
index) = forall a. ToJSON a => a -> Value
toJSON Int
index
instance Ord GQLError where
compare :: GQLError -> GQLError -> Ordering
compare GQLError
x GQLError
y = forall a. Ord a => a -> a -> Ordering
compare (GQLError -> Maybe [Position]
locations GQLError
x) (GQLError -> Maybe [Position]
locations GQLError
y) forall a. Semigroup a => a -> a -> a
<> 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 = 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 = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions
instance FromJSON GQLError where
parseJSON :: Value -> Parser GQLError
parseJSON = 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 forall a. Semigroup a => a -> a -> a
<> Text
m2) (Maybe [Position]
l1 forall a. Semigroup a => a -> a -> a
<> Maybe [Position]
l2) (Maybe [PropName]
p1 forall a. Semigroup a => a -> a -> a
<> Maybe [PropName]
p2) (Maybe ErrorType
t1 forall a. Semigroup a => a -> a -> a
<> Maybe ErrorType
t2) (Maybe (Map Text Value)
e1 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 = forall a. a -> a
id
instance Msg String where
msg :: String -> GQLError
msg = forall a. Msg a => a -> GQLError
msg 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
message :: Text
message :: Text
message,
locations :: Maybe [Position]
locations = forall a. Maybe a
Nothing,
errorType :: Maybe ErrorType
errorType = forall a. Maybe a
Nothing,
extensions :: Maybe (Map Text Value)
extensions = forall a. Maybe a
Nothing,
path :: Maybe [PropName]
path = forall a. Maybe a
Nothing
}
instance Msg ByteString where
msg :: ByteString -> GQLError
msg = forall a. Msg a => a -> GQLError
msg forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8
instance Msg Value where
msg :: Value -> GQLError
msg = forall a. Msg a => a -> GQLError
msg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode