[CORE-7914] Log an unhandled exception or a user abort before the computation ends (#97)

* [CORE-7914] Log an unhandled exception or a user abort before the computation ends

* Apply PR suggestions

* [EXPERIMENT] Try with catch

* Trying something

* Have a dedicated runner that logs on exception

* Retrying with MonadMask

* Use MonadBaseControl IO

* Apply PR suggestions

* Bump version and update changelog

* Provide exceptions logging as a function

Rather than patching runLogT directly, add a composable utility

* Apply PR suggestions

* Add missing dots

* Change error to exception

* fix changelog

---------

Co-authored-by: Andrzej Rybczak <[email protected]>

Author: Raveline

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.
 

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

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