Log unhandled exceptions

CHANGELOG.md

@@ -1,3 +1,6 @@
+# log-effectful-1.2.0.0 (2025-06-23)
+* Log any uncaught exception
+
 # log-effectful-1.0.1.0 (2024-11-07)
 * Convert `Log` into a dynamically dispatched effect.
 

log-effectful.cabal

@@ -1,7 +1,7 @@
 cabal-version:      3.0
 build-type:         Simple
 name:               log-effectful
-version:            1.0.1.0
+version:            1.2.0.0
 license:            BSD-3-Clause
 license-file:       LICENSE
 category:           System
@@ -41,6 +41,7 @@ common language
                       LambdaCase
                       MultiParamTypeClasses
                       NoStarIsType
+                      OverloadedStrings
                       RankNTypes
                       RoleAnnotations
                       ScopedTypeVariables
@@ -56,6 +57,7 @@ library
   build-depends:     base            <5
                    , aeson           >=2.0.0.0
                    , effectful-core  >=1.0.0.0    && <3.0.0.0
+                   , lifted-base
                    , log-base        >=0.12.0.0
                    , text
                    , time

src/Effectful/Log.hs

@@ -16,6 +16,7 @@ import Data.Aeson.Types
 import Data.Text (Text)
 import Data.Time.Clock
 import Effectful.Dispatch.Dynamic
+import Effectful.Exception
 import Effectful.Reader.Static
 import Effectful
 import Log
@@ -44,18 +45,8 @@ runLog
   -> Eff (Log : es) a
   -- ^ The computation to run.
   -> Eff es a
-runLog component logger maxLogLevel = reinterpret reader $ \env -> \case
-  LogMessageOp level message data_ -> do
-    time <- liftIO getCurrentTime
-    logEnv <- ask
-    liftIO $ logMessageIO logEnv time level message data_
-  LocalData data_ action -> localSeqUnlift env $ \unlift -> do
-    (`local` unlift action) $ \logEnv -> logEnv { leData = data_ ++ leData logEnv }
-  LocalDomain domain action -> localSeqUnlift env $ \unlift -> do
-    (`local` unlift action) $ \logEnv -> logEnv { leDomain = leDomain logEnv ++ [domain] }
-  LocalMaxLogLevel level action -> localSeqUnlift env $ \unlift -> do
-    (`local` unlift action) $ \logEnv -> logEnv { leMaxLogLevel = level }
-  GetLoggerEnv -> ask
+runLog component logger maxLogLevel =
+  reinterpret reader effectHandler . handle logException
   where
     reader = runReader LoggerEnv
       { leLogger = logger
@@ -64,6 +55,23 @@ runLog component logger maxLogLevel = reinterpret reader $ \env -> \case
       , leData = []
       , leMaxLogLevel = maxLogLevel
       }
+    effectHandler :: (IOE :> handlerEs, Reader LoggerEnv :> handlerEs) => EffectHandler Log handlerEs
+    effectHandler env = \case
+      LogMessageOp level message data_ -> do
+        time <- liftIO getCurrentTime
+        logEnv <- ask
+        liftIO $ logMessageIO logEnv time level message data_
+      LocalData data_ action -> localSeqUnlift env $ \unlift -> do
+        (`local` unlift action) $ \logEnv -> logEnv { leData = data_ ++ leData logEnv }
+      LocalDomain domain action -> localSeqUnlift env $ \unlift -> do
+        (`local` unlift action) $ \logEnv -> logEnv { leDomain = leDomain logEnv ++ [domain] }
+      LocalMaxLogLevel level action -> localSeqUnlift env $ \unlift -> do
+        (`local` unlift action) $ \logEnv -> logEnv { leMaxLogLevel = level }
+      GetLoggerEnv -> ask
+    logException :: (IOE :> es, Log :> es) => SomeException -> Eff es a
+    logException (SomeException e) = do
+      logAttention "Uncaught exception" $ object ["error" .= show e]
+      throwIO e
 
 -- | Orphan, canonical instance.
 instance Log :> es => MonadLog (Eff es) where