module Patrol.Type.Exception
  ( Exception(..)
  , fromSomeException
  ) where

import qualified Control.Exception as Exception
import qualified Data.Aeson as Aeson
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import qualified Data.Typeable as Typeable
import qualified Patrol.Type.StackTrace as StackTrace
import qualified Patrol.Utility.Json as Json

-- | <https://develop.sentry.dev/sdk/event-payloads/exception/>
data Exception = Exception
  { Exception -> Maybe Text
module_ :: Maybe Text.Text
  , Exception -> Maybe StackTrace
stackTrace :: Maybe StackTrace.StackTrace
  , 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
/= :: Exception -> Exception -> Bool
$c/= :: Exception -> Exception -> Bool
== :: Exception -> Exception -> Bool
$c== :: 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
showList :: [Exception] -> ShowS
$cshowList :: [Exception] -> ShowS
show :: Exception -> String
$cshow :: Exception -> String
showsPrec :: Int -> Exception -> ShowS
$cshowsPrec :: Int -> Exception -> ShowS
Show)

instance Aeson.ToJSON Exception where
  toJSON :: Exception -> Value
toJSON Exception
exception = [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
Maybe.catMaybes
    [ String -> Text -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"module" (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exception -> Maybe Text
module_ Exception
exception
    , String -> StackTrace -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stacktrace" (StackTrace -> Pair) -> Maybe StackTrace -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exception -> Maybe StackTrace
stackTrace Exception
exception
    , Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> (Text -> Pair) -> Text -> Maybe Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" (Text -> Maybe Pair) -> Text -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Exception -> Text
type_ Exception
exception
    , Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> (Text -> Pair) -> Text -> Maybe Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"value" (Text -> Maybe Pair) -> Text -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Exception -> Text
value Exception
exception
    ]

fromSomeException :: Exception.SomeException -> Exception
fromSomeException :: SomeException -> Exception
fromSomeException (Exception.SomeException e
x) =
  let tyCon :: TyCon
tyCon = TypeRep -> TyCon
Typeable.typeRepTyCon (TypeRep -> TyCon) -> TypeRep -> TyCon
forall a b. (a -> b) -> a -> b
$ e -> TypeRep
forall a. Typeable a => a -> TypeRep
Typeable.typeOf e
x
  in Exception :: Maybe Text -> Maybe StackTrace -> Text -> Text -> Exception
Exception
  { module_ :: Maybe Text
module_ = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ TyCon -> String
Typeable.tyConPackage TyCon
tyCon String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TyCon -> String
Typeable.tyConModule TyCon
tyCon
  , stackTrace :: Maybe StackTrace
stackTrace = Maybe StackTrace
forall a. Maybe a
Nothing
  , type_ :: Text
type_ = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TyCon -> String
Typeable.tyConName TyCon
tyCon
  , value :: Text
value = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
Exception.displayException e
x
  }