| Safe Haskell | Safe-Inferred |
|---|---|
| Language | Haskell2010 |
Freckle.App.Bugsnag
Synopsis
- data Settings
- class HasBugsnagSettings env where
- bugsnagSettingsL :: Lens' env Settings
- notifyBugsnag :: (MonadIO m, MonadReader env m, HasBugsnagSettings env, Exception e) => e -> m ()
- notifyBugsnagWith :: (MonadIO 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
- sqlErrorGroupingHash :: SqlError -> Maybe Text
- class Monad m => MonadReader r (m :: Type -> Type) | m -> r
- runReaderT :: ReaderT r m a -> r -> m a
- setInfoSeverity :: BeforeNotify
- setWarningSeverity :: BeforeNotify
- setErrorSeverity :: BeforeNotify
- setDevice :: Device -> BeforeNotify
- setRequest :: Request -> BeforeNotify
- setContext :: Text -> BeforeNotify
- setGroupingHashBy :: (Event -> Maybe Text) -> BeforeNotify
- setGroupingHash :: Text -> BeforeNotify
- updateEventFromOriginalException :: Exception e => (e -> BeforeNotify) -> BeforeNotify
- updateEvent :: (Event -> Event) -> BeforeNotify
- setStackFramesInProjectBy :: (StackFrame -> Bool) -> BeforeNotify
- setStackFramesInProjectByFile :: (FilePath -> Bool) -> BeforeNotify
- setStackFramesInProject :: Bool -> BeforeNotify
- setStackFramesCode :: CodeIndex -> BeforeNotify
- filterStackFrames :: (StackFrame -> Bool) -> BeforeNotify
- updateStackFrames :: (StackFrame -> StackFrame) -> BeforeNotify
- filterExceptions :: (Exception -> Bool) -> BeforeNotify
- updateExceptions :: (Exception -> Exception) -> BeforeNotify
- runBeforeNotify :: Exception e => BeforeNotify -> e -> Event -> Event
- beforeNotify :: (forall e. Exception e => e -> Event -> Event) -> BeforeNotify
- data 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 :: (MonadIO 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.forkIO
notifyBugsnagWith :: (MonadIO 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
Exported for testing
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 #
setInfoSeverity :: BeforeNotify #
Set to InfoSeverity
setWarningSeverity :: BeforeNotify #
Set to WarningSeverity
setErrorSeverity :: BeforeNotify #
Set to ErrorSeverity
setDevice :: Device -> BeforeNotify #
Set the Event's Device
See bugsnagDeviceFromWaiRequest
setRequest :: Request -> BeforeNotify #
Set the Event's Request
See bugsnagRequestFromWaiRequest
setContext :: Text -> BeforeNotify #
Set the Event's Context
setGroupingHashBy :: (Event -> Maybe Text) -> BeforeNotify #
setGroupingHash :: Text -> 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.
updateEvent :: (Event -> Event) -> BeforeNotify #
setStackFramesInProjectBy :: (StackFrame -> Bool) -> BeforeNotify #
setStackFramesInProjectByFile :: (FilePath -> Bool) -> BeforeNotify #
filterStackFrames :: (StackFrame -> Bool) -> BeforeNotify #
updateStackFrames :: (StackFrame -> StackFrame) -> BeforeNotify #
filterExceptions :: (Exception -> Bool) -> BeforeNotify #
updateExceptions :: (Exception -> Exception) -> BeforeNotify #
runBeforeNotify :: Exception e => BeforeNotify -> e -> Event -> Event #
beforeNotify :: (forall e. Exception e => e -> Event -> Event) -> BeforeNotify #
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 BeforeNotifys use updateEvent,
which discards it.
BeforeNotify implements Semigroup and Monoid, which means the /do
nothing/ BeforeNotify is mempty and two BeforeNotifys 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 # | |