From f50c38e3e716bccaa7114c0f24158ad50e40ce56 Mon Sep 17 00:00:00 2001 From: Raveline Date: Tue, 3 Jun 2025 09:21:17 +0200 Subject: [PATCH 1/3] Log unhandled exceptions --- log-effectful.cabal | 2 ++ src/Effectful/Log.hs | 35 ++++++++++++++++++++++------------- 2 files changed, 24 insertions(+), 13 deletions(-) diff --git a/log-effectful.cabal b/log-effectful.cabal index 103a056..20c0ccf 100644 --- a/log-effectful.cabal +++ b/log-effectful.cabal @@ -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 diff --git a/src/Effectful/Log.hs b/src/Effectful/Log.hs index ee4d755..1018f94 100644 --- a/src/Effectful/Log.hs +++ b/src/Effectful/Log.hs @@ -12,8 +12,9 @@ module Effectful.Log , module Log ) where +import Control.Exception.Lifted import Data.Aeson.Types -import Data.Text (Text) +import Data.Text (Text, pack) import Data.Time.Clock import Effectful.Dispatch.Dynamic import Effectful.Reader.Static @@ -44,18 +45,19 @@ 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 (\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) . handle logException where reader = runReader LoggerEnv { leLogger = logger @@ -64,6 +66,13 @@ runLog component logger maxLogLevel = reinterpret reader $ \env -> \case , leData = [] , leMaxLogLevel = maxLogLevel } + logException :: (IOE :> es, Log :> es) => SomeException -> Eff es a + logException (SomeException e) = do + time <- liftIO getCurrentTime + logEnv <- getLoggerEnv + liftIO $ + logMessageIO logEnv time LogAttention "Uncaught exception" $ object ["error" .= (pack . show $ e)] + throw e -- | Orphan, canonical instance. instance Log :> es => MonadLog (Eff es) where From a7799bed88e305355d38ac14bd5f95104d651f5f Mon Sep 17 00:00:00 2001 From: Raveline Date: Mon, 23 Jun 2025 16:52:35 +0200 Subject: [PATCH 2/3] Apply PR suggestions --- src/Effectful/Log.hs | 37 ++++++++++++++++++------------------- 1 file changed, 18 insertions(+), 19 deletions(-) diff --git a/src/Effectful/Log.hs b/src/Effectful/Log.hs index 1018f94..fc94460 100644 --- a/src/Effectful/Log.hs +++ b/src/Effectful/Log.hs @@ -12,11 +12,11 @@ module Effectful.Log , module Log ) where -import Control.Exception.Lifted import Data.Aeson.Types -import Data.Text (Text, pack) +import Data.Text (Text) import Data.Time.Clock import Effectful.Dispatch.Dynamic +import Effectful.Exception import Effectful.Reader.Static import Effectful import Log @@ -46,18 +46,7 @@ runLog -- ^ 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) . handle logException + reinterpret reader effectHandler . handle logException where reader = runReader LoggerEnv { leLogger = logger @@ -66,13 +55,23 @@ runLog component logger maxLogLevel = , 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 - time <- liftIO getCurrentTime - logEnv <- getLoggerEnv - liftIO $ - logMessageIO logEnv time LogAttention "Uncaught exception" $ object ["error" .= (pack . show $ e)] - throw e + logAttention "Uncaught exception" $ object ["error" .= show e] + throwIO e -- | Orphan, canonical instance. instance Log :> es => MonadLog (Eff es) where From 8249a1c3940fa9c79532f32ec7721b7590b06086 Mon Sep 17 00:00:00 2001 From: Raveline Date: Mon, 23 Jun 2025 17:08:42 +0200 Subject: [PATCH 3/3] Bump version and update changelog --- CHANGELOG.md | 3 +++ log-effectful.cabal | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d2fbd4d..e62a338 100644 --- a/CHANGELOG.md +++ b/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. diff --git a/log-effectful.cabal b/log-effectful.cabal index 20c0ccf..10319d1 100644 --- a/log-effectful.cabal +++ b/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