{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Network.Bugsnag.Exception
( BugsnagException(..)
, bugsnagException
, bugsnagExceptionFromSomeException
) where
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 (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 (bugsnagExceptionWithParser parseStringException ex) exCasters
where
go :: Caster -> BugsnagException -> BugsnagException
go (Caster caster) res = maybe res caster $ fromException ex
exCasters :: [Caster]
exCasters =
[ Caster id
, Caster $ bugsnagExceptionWithParser parseErrorCall
, Caster $ bugsnagExceptionFromException @IOException
, Caster $ bugsnagExceptionFromException @ArithException
, Caster $ bugsnagExceptionFromException @ArrayException
, Caster $ bugsnagExceptionFromException @AssertionFailed
, Caster $ bugsnagExceptionFromException @SomeAsyncException
, Caster $ bugsnagExceptionFromException @AsyncException
, Caster $ bugsnagExceptionFromException @NonTermination
, Caster $ bugsnagExceptionFromException @NestedAtomically
, Caster $ bugsnagExceptionFromException @BlockedIndefinitelyOnMVar
, Caster $ bugsnagExceptionFromException @BlockedIndefinitelyOnSTM
, Caster $ bugsnagExceptionFromException @AllocationLimitExceeded
, Caster $ bugsnagExceptionFromException @Deadlock
, Caster $ bugsnagExceptionFromException @NoMethodError
, Caster $ bugsnagExceptionFromException @PatternMatchFail
, Caster $ bugsnagExceptionFromException @RecConError
, Caster $ bugsnagExceptionFromException @RecSelError
, Caster $ bugsnagExceptionFromException @RecUpdError
, Caster $ bugsnagExceptionFromException @TypeError
]
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 $ show ex) [])
{ beOriginalException = Just $ toException ex
}
exErrorClass :: forall e. Exception e => e -> Text
exErrorClass _ = T.pack $ show $ typeRep $ Proxy @e