log-effectful 1.0.0.0 → 1.0.1.0

raw patch · 3 files changed

+44/−33 lines, 3 filesdep ~aesonPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• log-effectful.cabal +5/−4
• src/Effectful/Log.hs +36/−29

@@ -1,2 +1,5 @@+# log-effectful-1.0.1.0 (2024-11-07)+* Convert `Log` into a dynamically dispatched effect.+ # log-effectful-1.0.0.0 (2022-10-10) * Initial release.

@@ -1,7 +1,7 @@-cabal-version:      2.4+cabal-version:      3.0 build-type:         Simple name:               log-effectful-version:            1.0.0.0+version:            1.0.1.0 license:            BSD-3-Clause license-file:       LICENSE category:           System@@ -16,7 +16,7 @@   CHANGELOG.md   README.md -tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.2+tested-with: GHC == { 8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.6, 9.8.2, 9.10.1 }  bug-reports: https://github.com/haskell-effectful/log-effectful/issues source-repository head@@ -54,6 +54,7 @@   import:          language    build-depends:     base            <5+                   , aeson           >=2.0.0.0                    , effectful-core  >=1.0.0.0    && <3.0.0.0                    , log-base        >=0.12.0.0                    , text@@ -66,7 +67,7 @@ test-suite test   import:          language -  ghc-options:     -threaded -rtsopts -with-rtsopts=-N4+  ghc-options:     -threaded -rtsopts    build-depends:     base                    , aeson

@@ -3,7 +3,7 @@ -- | Logging via 'MonadLog'. module Effectful.Log   ( -- * Effect-    Log+    Log (..)      -- ** Handlers   , runLog@@ -12,17 +12,23 @@   , module Log   ) where +import Data.Aeson.Types import Data.Text (Text) import Data.Time.Clock-import Effectful.Dispatch.Static+import Effectful.Dispatch.Dynamic+import Effectful.Reader.Static import Effectful import Log  -- | Provide the ability to log messages via 'MonadLog'.-data Log :: Effect+data Log :: Effect where+  LogMessageOp :: LogLevel -> Text -> Value -> Log m ()+  LocalData :: [Pair] -> m a -> Log m a+  LocalDomain :: Text -> m a -> Log m a+  LocalMaxLogLevel :: LogLevel -> m a -> Log m a+  GetLoggerEnv :: Log m LoggerEnv -type instance DispatchOf Log = Static WithSideEffects-newtype instance StaticRep Log = Log LoggerEnv+type instance DispatchOf Log = Dynamic  -- | Run the 'Log' effect. --@@ -38,30 +44,31 @@   -> Eff (Log : es) a   -- ^ The computation to run.   -> Eff es a-runLog component logger maxLogLevel = evalStaticRep $ Log LoggerEnv-  { leLogger = logger-  , leComponent = component-  , leDomain = []-  , leData = []-  , leMaxLogLevel = maxLogLevel-  }+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+  where+    reader = runReader LoggerEnv+      { leLogger = logger+      , leComponent = component+      , leDomain = []+      , leData = []+      , leMaxLogLevel = maxLogLevel+      }  -- | Orphan, canonical instance. instance Log :> es => MonadLog (Eff es) where-  logMessage level message data_ = do-    time <- unsafeEff_ getCurrentTime-    Log logEnv <- getStaticRep-    unsafeEff_ $ logMessageIO logEnv time level message data_--  localData data_ = localStaticRep $ \(Log logEnv) ->-    Log logEnv { leData = data_ ++ leData logEnv }--  localDomain domain = localStaticRep $ \(Log logEnv) ->-    Log logEnv { leDomain = leDomain logEnv ++ [domain] }--  localMaxLogLevel level = localStaticRep $ \(Log logEnv) ->-    Log logEnv { leMaxLogLevel = level }--  getLoggerEnv = do-    Log env <- getStaticRep-    pure env+  logMessage level message data_ = send $ LogMessageOp level message data_+  localData data_ action = send $ LocalData data_ action+  localDomain domain action = send $ LocalDomain domain action+  localMaxLogLevel level action = send $ LocalMaxLogLevel level action+  getLoggerEnv = send GetLoggerEnv