diff --git a/log-base/CHANGELOG.md b/log-base/CHANGELOG.md index e4bc2a1..e50d4ca 100644 --- a/log-base/CHANGELOG.md +++ b/log-base/CHANGELOG.md @@ -1,3 +1,6 @@ +# log-base-0.12.1.0 (2025-??-??) +* Add utility function to log unhandled exceptions. + # log-base-0.12.0.1 (2023-03-14) * Add support for GHC 9.6. diff --git a/log-base/log-base.cabal b/log-base/log-base.cabal index e355aef..3ca4fda 100644 --- a/log-base/log-base.cabal +++ b/log-base/log-base.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: log-base -version: 0.12.0.1 +version: 0.12.1.0 synopsis: Structured logging solution (base package) description: A library that provides a way to record structured log diff --git a/log-base/src/Log/Monad.hs b/log-base/src/Log/Monad.hs index c656c3b..3aee980 100644 --- a/log-base/src/Log/Monad.hs +++ b/log-base/src/Log/Monad.hs @@ -6,6 +6,7 @@ module Log.Monad ( , InnerLogT , LogT(..) , runLogT + , logExceptions , mapLogT , logMessageIO , getLoggerIO @@ -67,6 +68,25 @@ runLogT component logger maxLogLevel m = runReaderT (unLogT m) LoggerEnv { } -- We can't do synchronisation here, since 'runLogT' can be invoked -- quite often from the application (e.g. on every request). +-- | Ensure uncaught exceptions get logged. +-- Convenient to compose right after `runLogT` so any exception +-- will show up. +logExceptions :: (MonadBaseControl IO m, MonadLog m) => m a -> m a +logExceptions f = + liftedCatch f $ \(SomeException e) -> do + logAttention "Uncaught exception" $ object ["exception" .= show e] + liftBase $ E.throwIO e + +-- Generalized version of catch taken from `lifted-base`. +liftedCatch :: (MonadBaseControl IO m, Exception e) + => m a -- ^ The computation to run. + -> (e -> m a) -- ^ Handler to invoke if an exception is raised. + -> m a +liftedCatch a handler = control $ \runInIO -> + E.catch + (runInIO a) + (runInIO . handler) + -- | Transform the computation inside a 'LogT'. mapLogT :: (m a -> n b) -> LogT m a -> LogT n b mapLogT f = LogT . mapReaderT f . unLogT