{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Types.Internal.AST.Error
  ( at,
    atPositions,
    internal,
    isInternal,
    GQLErrors,
    GQLError
      ( message,
        locations
      ),
    manyMsg,
    Msg (..),
    Message,
    withPath,
  )
where

import Data.Aeson
  ( FromJSON,
    Options (..),
    ToJSON (..),
    Value,
    defaultOptions,
    encode,
    genericToJSON,
  )
import Data.ByteString.Lazy (ByteString)
import Data.Morpheus.Types.Internal.AST.Base
  ( Position (..),
  )
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

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 [Text]
Maybe [Position]
Maybe (Map Text Value)
Maybe ErrorType
Text
extensions :: GQLError -> Maybe (Map Text Value)
path :: GQLError -> Maybe [Text]
extensions :: Maybe (Map Text Value)
errorType :: Maybe ErrorType
path :: Maybe [Text]
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 [Text]
-> Maybe ErrorType
-> Maybe (Map Text Value)
-> GQLError
GQLError {Maybe [Text]
Maybe [Position]
Maybe (Map Text Value)
Maybe ErrorType
Text
extensions :: Maybe (Map Text Value)
path :: Maybe [Text]
extensions :: Maybe (Map Text Value)
errorType :: Maybe ErrorType
path :: Maybe [Text]
locations :: Maybe [Position]
message :: Text
errorType :: Maybe ErrorType
locations :: Maybe [Position]
message :: Text
..}
  [Position]
posList -> GQLError :: Text
-> Maybe [Position]
-> Maybe [Text]
-> 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 [Text]
Maybe (Map Text Value)
Maybe ErrorType
Text
extensions :: Maybe (Map Text Value)
path :: Maybe [Text]
extensions :: Maybe (Map Text Value)
errorType :: Maybe ErrorType
path :: Maybe [Text]
message :: Text
errorType :: Maybe ErrorType
message :: Text
..}
{-# INLINE atPositions #-}

withPath :: GQLError -> [Text] -> GQLError
withPath :: GQLError -> [Text] -> GQLError
withPath GQLError
err [] = GQLError
err
withPath GQLError
err [Text]
path = GQLError
err {path :: Maybe [Text]
path = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
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
  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,
      Value -> Parser [ErrorType]
Value -> Parser ErrorType
(Value -> Parser ErrorType)
-> (Value -> Parser [ErrorType]) -> FromJSON ErrorType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ErrorType]
$cparseJSONList :: Value -> Parser [ErrorType]
parseJSON :: Value -> Parser ErrorType
$cparseJSON :: Value -> Parser ErrorType
FromJSON,
      [ErrorType] -> Encoding
[ErrorType] -> Value
ErrorType -> Encoding
ErrorType -> Value
(ErrorType -> Value)
-> (ErrorType -> Encoding)
-> ([ErrorType] -> Value)
-> ([ErrorType] -> Encoding)
-> ToJSON ErrorType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ErrorType] -> Encoding
$ctoEncodingList :: [ErrorType] -> Encoding
toJSONList :: [ErrorType] -> Value
$ctoJSONList :: [ErrorType] -> Value
toEncoding :: ErrorType -> Encoding
$ctoEncoding :: ErrorType -> Encoding
toJSON :: ErrorType -> Value
$ctoJSON :: ErrorType -> Value
ToJSON
    )

instance Semigroup ErrorType where
  ErrorType
Internal <> :: ErrorType -> ErrorType -> ErrorType
<> ErrorType
Internal = ErrorType
Internal

data GQLError = GQLError
  { GQLError -> Text
message :: Message,
    GQLError -> Maybe [Position]
locations :: Maybe [Position],
    GQLError -> Maybe [Text]
path :: Maybe [Text],
    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,
      Value -> Parser [GQLError]
Value -> Parser GQLError
(Value -> Parser GQLError)
-> (Value -> Parser [GQLError]) -> FromJSON GQLError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GQLError]
$cparseJSONList :: Value -> Parser [GQLError]
parseJSON :: Value -> Parser GQLError
$cparseJSON :: Value -> Parser GQLError
FromJSON
    )

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

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
defaultOptions {omitNothingFields :: Bool
omitNothingFields = Bool
True})

instance Semigroup GQLError where
  GQLError Text
m1 Maybe [Position]
l1 Maybe [Text]
p1 Maybe ErrorType
t1 Maybe (Map Text Value)
e1 <> :: GQLError -> GQLError -> GQLError
<> GQLError Text
m2 Maybe [Position]
l2 Maybe [Text]
p2 Maybe ErrorType
t2 Maybe (Map Text Value)
e2 = Text
-> Maybe [Position]
-> Maybe [Text]
-> 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 [Text]
p1 Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall a. Semigroup a => a -> a -> a
<> Maybe [Text]
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 [Text]
-> 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 [Text]
path = Maybe [Text]
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