{-# 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
{ beErrorClass :: Text
, beMessage :: Maybe Text
, beStacktrace :: [BugsnagStackFrame]
, beOriginalException :: Maybe SomeException
}
deriving stock (Generic, Show)
instance ToJSON BugsnagException where
toJSON BugsnagException {..} = object
[ "errorClass" .= beErrorClass
, "message" .= beMessage
, "stacktrace" .= beStacktrace
]
instance Exception BugsnagException
bugsnagException :: Text -> Text -> [BugsnagStackFrame] -> BugsnagException
bugsnagException errorClass message stacktrace = BugsnagException
{ beErrorClass = errorClass
, beMessage = Just message
, beStacktrace = stacktrace
, beOriginalException = Nothing
}
bugsnagExceptionFromSomeException :: SomeException -> BugsnagException
bugsnagExceptionFromSomeException ex = foldr go seed exCasters
where
go :: Caster -> BugsnagException -> BugsnagException
go (Caster caster) res = maybe res caster $ fromException ex
seed = (bugsnagExceptionWithParser parseStringException ex)
{ beErrorClass = (\(SomeException e) -> exErrorClass e) ex
}
exCasters :: [Caster]
exCasters = [Caster id, Caster $ bugsnagExceptionWithParser parseErrorCall]
bugsnagExceptionWithParser
:: Exception e
=> (e -> Either String MessageWithStackFrames)
-> e
-> BugsnagException
bugsnagExceptionWithParser p ex = case p ex of
Left _ -> bugsnagExceptionFromException ex
Right (MessageWithStackFrames message stacktrace) ->
bugsnagException (exErrorClass ex) message stacktrace
bugsnagExceptionFromException :: Exception e => e -> BugsnagException
bugsnagExceptionFromException ex =
(bugsnagException (exErrorClass ex) (T.pack $ displayException ex) [])
{ beOriginalException = Just $ toException ex
}
exErrorClass :: forall e . Exception e => e -> Text
exErrorClass _ = T.pack $ show $ typeRep $ Proxy @e