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 103a056..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 @@ -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..fc94460 100644 --- a/src/Effectful/Log.hs +++ b/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