{-# LANGUAGE ExistentialQuantification #-}
module Network.Bugsnag.Exception
( BugsnagException(..)
, bugsnagException
, bugsnagExceptionFromSomeException
)
where
import Prelude
import Control.Exception
import Data.Aeson
import Data.Proxy (Proxy(..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (typeRep)
import GHC.Generics
import Instances.TH.Lift ()
import Network.Bugsnag.Exception.Parse
import Network.Bugsnag.StackFrame
data Caster = forall e. Exception e => Caster (e -> BugsnagException)
data BugsnagException = BugsnagException
{ BugsnagException -> Text
beErrorClass :: Text
, BugsnagException -> Maybe Text
beMessage :: Maybe Text
, BugsnagException -> [BugsnagStackFrame]
beStacktrace :: [BugsnagStackFrame]
, BugsnagException -> Maybe SomeException
beOriginalException :: Maybe SomeException
}
deriving stock ((forall x. BugsnagException -> Rep BugsnagException x)
-> (forall x. Rep BugsnagException x -> BugsnagException)
-> Generic BugsnagException
forall x. Rep BugsnagException x -> BugsnagException
forall x. BugsnagException -> Rep BugsnagException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BugsnagException x -> BugsnagException
$cfrom :: forall x. BugsnagException -> Rep BugsnagException x
Generic, Int -> BugsnagException -> ShowS
[BugsnagException] -> ShowS
BugsnagException -> String
(Int -> BugsnagException -> ShowS)
-> (BugsnagException -> String)
-> ([BugsnagException] -> ShowS)
-> Show BugsnagException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BugsnagException] -> ShowS
$cshowList :: [BugsnagException] -> ShowS
show :: BugsnagException -> String
$cshow :: BugsnagException -> String
showsPrec :: Int -> BugsnagException -> ShowS
$cshowsPrec :: Int -> BugsnagException -> ShowS
Show)
instance ToJSON BugsnagException where
toJSON :: BugsnagException -> Value
toJSON BugsnagException {[BugsnagStackFrame]
Maybe Text
Maybe SomeException
Text
beOriginalException :: Maybe SomeException
beStacktrace :: [BugsnagStackFrame]
beMessage :: Maybe Text
beErrorClass :: Text
beOriginalException :: BugsnagException -> Maybe SomeException
beStacktrace :: BugsnagException -> [BugsnagStackFrame]
beMessage :: BugsnagException -> Maybe Text
beErrorClass :: BugsnagException -> Text
..} = [Pair] -> Value
object
[ Text
"errorClass" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
beErrorClass
, Text
"message" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
beMessage
, Text
"stacktrace" Text -> [BugsnagStackFrame] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BugsnagStackFrame]
beStacktrace
]
instance Exception BugsnagException
bugsnagException :: Text -> Text -> [BugsnagStackFrame] -> BugsnagException
bugsnagException :: Text -> Text -> [BugsnagStackFrame] -> BugsnagException
bugsnagException Text
errorClass Text
message [BugsnagStackFrame]
stacktrace = BugsnagException :: Text
-> Maybe Text
-> [BugsnagStackFrame]
-> Maybe SomeException
-> BugsnagException
BugsnagException
{ beErrorClass :: Text
beErrorClass = Text
errorClass
, beMessage :: Maybe Text
beMessage = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
message
, beStacktrace :: [BugsnagStackFrame]
beStacktrace = [BugsnagStackFrame]
stacktrace
, beOriginalException :: Maybe SomeException
beOriginalException = Maybe SomeException
forall a. Maybe a
Nothing
}
bugsnagExceptionFromSomeException :: SomeException -> BugsnagException
bugsnagExceptionFromSomeException :: SomeException -> BugsnagException
bugsnagExceptionFromSomeException SomeException
ex = (Caster -> BugsnagException -> BugsnagException)
-> BugsnagException -> [Caster] -> BugsnagException
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Caster -> BugsnagException -> BugsnagException
go BugsnagException
seed [Caster]
exCasters
where
go :: Caster -> BugsnagException -> BugsnagException
go :: Caster -> BugsnagException -> BugsnagException
go (Caster e -> BugsnagException
caster) BugsnagException
res = BugsnagException
-> (e -> BugsnagException) -> Maybe e -> BugsnagException
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BugsnagException
res e -> BugsnagException
caster (Maybe e -> BugsnagException) -> Maybe e -> BugsnagException
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex
seed :: BugsnagException
seed = ((SomeException -> Either String MessageWithStackFrames)
-> SomeException -> BugsnagException
forall e.
Exception e =>
(e -> Either String MessageWithStackFrames)
-> e -> BugsnagException
bugsnagExceptionWithParser SomeException -> Either String MessageWithStackFrames
parseStringException SomeException
ex)
{ beErrorClass :: Text
beErrorClass = (\(SomeException e
e) -> e -> Text
forall e. Exception e => e -> Text
exErrorClass e
e) SomeException
ex
}
exCasters :: [Caster]
exCasters :: [Caster]
exCasters = [(BugsnagException -> BugsnagException) -> Caster
forall e. Exception e => (e -> BugsnagException) -> Caster
Caster BugsnagException -> BugsnagException
forall a. a -> a
id, (ErrorCall -> BugsnagException) -> Caster
forall e. Exception e => (e -> BugsnagException) -> Caster
Caster ((ErrorCall -> BugsnagException) -> Caster)
-> (ErrorCall -> BugsnagException) -> Caster
forall a b. (a -> b) -> a -> b
$ (ErrorCall -> Either String MessageWithStackFrames)
-> ErrorCall -> BugsnagException
forall e.
Exception e =>
(e -> Either String MessageWithStackFrames)
-> e -> BugsnagException
bugsnagExceptionWithParser ErrorCall -> Either String MessageWithStackFrames
parseErrorCall]
bugsnagExceptionWithParser
:: Exception e
=> (e -> Either String MessageWithStackFrames)
-> e
-> BugsnagException
bugsnagExceptionWithParser :: (e -> Either String MessageWithStackFrames)
-> e -> BugsnagException
bugsnagExceptionWithParser e -> Either String MessageWithStackFrames
p e
ex = case e -> Either String MessageWithStackFrames
p e
ex of
Left String
_ -> e -> BugsnagException
forall e. Exception e => e -> BugsnagException
bugsnagExceptionFromException e
ex
Right (MessageWithStackFrames Text
message [BugsnagStackFrame]
stacktrace) ->
Text -> Text -> [BugsnagStackFrame] -> BugsnagException
bugsnagException (e -> Text
forall e. Exception e => e -> Text
exErrorClass e
ex) Text
message [BugsnagStackFrame]
stacktrace
bugsnagExceptionFromException :: Exception e => e -> BugsnagException
bugsnagExceptionFromException :: e -> BugsnagException
bugsnagExceptionFromException e
ex =
(Text -> Text -> [BugsnagStackFrame] -> BugsnagException
bugsnagException (e -> Text
forall e. Exception e => e -> Text
exErrorClass e
ex) (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
displayException e
ex) [])
{ beOriginalException :: Maybe SomeException
beOriginalException = SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just (SomeException -> Maybe SomeException)
-> SomeException -> Maybe SomeException
forall a b. (a -> b) -> a -> b
$ e -> SomeException
forall e. Exception e => e -> SomeException
toException e
ex
}
exErrorClass :: forall e . Exception e => e -> Text
exErrorClass :: e -> Text
exErrorClass e
_ = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy e -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy e -> TypeRep) -> Proxy e -> TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy e
forall k (t :: k). Proxy t
Proxy @e