Safe Haskell | None |
---|---|
Language | GHC2021 |
Freckle.App.Bugsnag
Synopsis
- data Settings
- class HasBugsnagSettings env where
- bugsnagSettingsL :: Lens' env Settings
- notifyBugsnag :: (MonadMask m, MonadUnliftIO m, MonadReader env m, HasBugsnagSettings env, Exception e) => e -> m ()
- notifyBugsnagWith :: (MonadMask m, MonadUnliftIO m, MonadReader env m, HasBugsnagSettings env, Exception e) => BeforeNotify -> e -> m ()
- class HasAppVersion env where
- appVersionL :: Lens' env Text
- setAppVersion :: Text -> BeforeNotify
- envParseBugsnagSettings :: Parser Error Settings
- class Monad m => MonadReader r (m :: Type -> Type) | m -> r
- runReaderT :: ReaderT r m a -> r -> m a
- data BeforeNotify
- beforeNotify :: (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
- runBeforeNotify :: Exception e => BeforeNotify -> e -> Event -> Event
- updateExceptions :: (Exception -> Exception) -> BeforeNotify
- filterExceptions :: (Exception -> Bool) -> BeforeNotify
- updateStackFrames :: (StackFrame -> StackFrame) -> BeforeNotify
- filterStackFrames :: (StackFrame -> Bool) -> BeforeNotify
- setStackFramesCode :: CodeIndex -> BeforeNotify
- setStackFramesInProject :: Bool -> BeforeNotify
- setStackFramesInProjectByFile :: (FilePath -> Bool) -> BeforeNotify
- setStackFramesInProjectBy :: (StackFrame -> Bool) -> BeforeNotify
- updateEvent :: (Event -> Event) -> BeforeNotify
- updateEventFromOriginalException :: Exception e => (e -> BeforeNotify) -> BeforeNotify
- setGroupingHash :: Text -> BeforeNotify
- setGroupingHashBy :: (Event -> Maybe Text) -> BeforeNotify
- setContext :: Text -> BeforeNotify
- setRequest :: Request -> BeforeNotify
- setDevice :: Device -> BeforeNotify
- setErrorSeverity :: BeforeNotify
- setWarningSeverity :: BeforeNotify
- setInfoSeverity :: BeforeNotify
Documentation
Instances
HasBugsnagSettings Settings Source # | |
Defined in Freckle.App.Bugsnag |
class HasBugsnagSettings env where Source #
Methods
bugsnagSettingsL :: Lens' env Settings Source #
Instances
HasBugsnagSettings Settings Source # | |
Defined in Freckle.App.Bugsnag | |
HasBugsnagSettings site => HasBugsnagSettings (HandlerData child site) Source # | |
Defined in Freckle.App.Bugsnag Methods bugsnagSettingsL :: Lens' (HandlerData child site) Settings Source # |
notifyBugsnag :: (MonadMask m, MonadUnliftIO m, MonadReader env m, HasBugsnagSettings env, Exception e) => e -> m () Source #
Notify Bugsnag of an exception
The notification is made asynchronously via a simple
. This is
best-effort and we don't care to keep track of the spawned threads.async
notifyBugsnagWith :: (MonadMask m, MonadUnliftIO m, MonadReader env m, HasBugsnagSettings env, Exception e) => BeforeNotify -> e -> m () Source #
notifyBugsnag
with a BeforeNotify
AppVersion
class HasAppVersion env where Source #
Methods
appVersionL :: Lens' env Text Source #
Instances
HasAppVersion site => HasAppVersion (HandlerData child site) Source # | |
Defined in Freckle.App.Bugsnag Methods appVersionL :: Lens' (HandlerData child site) Text Source # |
setAppVersion :: Text -> BeforeNotify Source #
Loading settings
Re-exports
class Monad m => MonadReader r (m :: Type -> Type) | m -> r #
See examples in Control.Monad.Reader.
Note, the partially applied function type (->) r
is a simple reader monad.
See the instance
declaration below.
Instances
runReaderT :: ReaderT r m a -> r -> m a #
data BeforeNotify #
A function from Event
to Event
that is applied before notifying
The wrapped function also accepts the original exception, for cases in which
that's useful -- but it's often not. Most BeforeNotify
s use updateEvent
,
which discards it.
BeforeNotify
implements Semigroup
and Monoid
, which means the /do
nothing/ BeforeNotify
is mempty
and two BeforeNotify
s doThis
then
doThat
can be implemented as doThat <> doThis
.
Instances
Monoid BeforeNotify | |
Defined in Network.Bugsnag.BeforeNotify Methods mempty :: BeforeNotify # mappend :: BeforeNotify -> BeforeNotify -> BeforeNotify # mconcat :: [BeforeNotify] -> BeforeNotify # | |
Semigroup BeforeNotify | |
Defined in Network.Bugsnag.BeforeNotify Methods (<>) :: BeforeNotify -> BeforeNotify -> BeforeNotify # sconcat :: NonEmpty BeforeNotify -> BeforeNotify # stimes :: Integral b => b -> BeforeNotify -> BeforeNotify # |
beforeNotify :: (forall e. Exception e => e -> Event -> Event) -> BeforeNotify #
runBeforeNotify :: Exception e => BeforeNotify -> e -> Event -> Event #
updateExceptions :: (Exception -> Exception) -> BeforeNotify #
filterExceptions :: (Exception -> Bool) -> BeforeNotify #
updateStackFrames :: (StackFrame -> StackFrame) -> BeforeNotify #
filterStackFrames :: (StackFrame -> Bool) -> BeforeNotify #
setStackFramesInProjectByFile :: (FilePath -> Bool) -> BeforeNotify #
setStackFramesInProjectBy :: (StackFrame -> Bool) -> BeforeNotify #
updateEvent :: (Event -> Event) -> BeforeNotify #
updateEventFromOriginalException :: Exception e => (e -> BeforeNotify) -> BeforeNotify #
Update the Event
based on the original exception
This allows updating the Event after casting to an exception type that this
library doesn't know about (e.g. SqlError
). Because the result of your
function is itself a BeforeNotify
, you can (and should) use other
helpers:
myBeforeNotify =defaultBeforeNotify
<>updateEventFromOriginalException
asSqlError <>updateEventFromOriginalException
asHttpError <> -- ... asSqlError :: SqlError -> BeforeNotify asSqlError SqlError{..} =setGroupingHash
sqlErrorCode <>updateException
(e -> e { exception_errorClass = sqlErrorCode , exception_message = Just sqlErrorMessage })
If the cast fails, the event is unchanged.
The cast will match either e
or
.AnnotatedException
e
setGroupingHash :: Text -> BeforeNotify #
setGroupingHashBy :: (Event -> Maybe Text) -> BeforeNotify #
setContext :: Text -> BeforeNotify #
Set the Event's Context
setRequest :: Request -> BeforeNotify #
Set the Event's Request
See bugsnagRequestFromWaiRequest
setDevice :: Device -> BeforeNotify #
Set the Event's Device
See bugsnagDeviceFromWaiRequest
setErrorSeverity :: BeforeNotify #
Set to ErrorSeverity
setWarningSeverity :: BeforeNotify #
Set to WarningSeverity
setInfoSeverity :: BeforeNotify #
Set to InfoSeverity