module Patrol.Type.Exception where

import qualified Control.Monad.Catch as Catch
import qualified Data.Aeson as Aeson
import qualified Data.Text as Text
import qualified Data.Typeable as Typeable
import qualified Patrol.Extra.Aeson as Aeson
import qualified Patrol.Type.Mechanism as Mechanism
import qualified Patrol.Type.Stacktrace as Stacktrace

-- | <https://develop.sentry.dev/sdk/event-payloads/types/#valueclass>
data Exception = Exception
  { Exception -> Maybe Mechanism
mechanism :: Maybe Mechanism.Mechanism,
    Exception -> Text
module_ :: Text.Text,
    Exception -> Maybe Stacktrace
stacktrace :: Maybe Stacktrace.Stacktrace,
    Exception -> Text
threadId :: Text.Text,
    Exception -> Text
type_ :: Text.Text,
    Exception -> Text
value :: Text.Text
  }
  deriving (Exception -> Exception -> Bool
(Exception -> Exception -> Bool)
-> (Exception -> Exception -> Bool) -> Eq Exception
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Exception -> Exception -> Bool
== :: Exception -> Exception -> Bool
$c/= :: Exception -> Exception -> Bool
/= :: Exception -> Exception -> Bool
Eq, Int -> Exception -> ShowS
[Exception] -> ShowS
Exception -> String
(Int -> Exception -> ShowS)
-> (Exception -> String)
-> ([Exception] -> ShowS)
-> Show Exception
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Exception -> ShowS
showsPrec :: Int -> Exception -> ShowS
$cshow :: Exception -> String
show :: Exception -> String
$cshowList :: [Exception] -> ShowS
showList :: [Exception] -> ShowS
Show)

instance Aeson.ToJSON Exception where
  toJSON :: Exception -> Value
toJSON Exception
exception =
    [Pair] -> Value
Aeson.intoObject
      [ String -> Maybe Mechanism -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"mechanism" (Maybe Mechanism -> Pair) -> Maybe Mechanism -> Pair
forall a b. (a -> b) -> a -> b
$ Exception -> Maybe Mechanism
mechanism Exception
exception,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"module" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ Exception -> Text
module_ Exception
exception,
        String -> Maybe Stacktrace -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"stacktrace" (Maybe Stacktrace -> Pair) -> Maybe Stacktrace -> Pair
forall a b. (a -> b) -> a -> b
$ Exception -> Maybe Stacktrace
stacktrace Exception
exception,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"thread_id" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ Exception -> Text
threadId Exception
exception,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"type" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ Exception -> Text
type_ Exception
exception,
        String -> Text -> Pair
forall a. ToJSON a => String -> a -> Pair
Aeson.pair String
"value" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ Exception -> Text
value Exception
exception
      ]

empty :: Exception
empty :: Exception
empty =
  Exception
    { mechanism :: Maybe Mechanism
mechanism = Maybe Mechanism
forall a. Maybe a
Nothing,
      module_ :: Text
module_ = Text
Text.empty,
      stacktrace :: Maybe Stacktrace
stacktrace = Maybe Stacktrace
forall a. Maybe a
Nothing,
      threadId :: Text
threadId = Text
Text.empty,
      type_ :: Text
type_ = Text
Text.empty,
      value :: Text
value = Text
Text.empty
    }

fromSomeException :: Catch.SomeException -> Exception
fromSomeException :: SomeException -> Exception
fromSomeException (Catch.SomeException e
e) =
  Exception
empty
    { type_ = Text.pack . show $ Typeable.typeOf e,
      value = Text.pack $ Catch.displayException e
    }