polysemy-log-co 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+66/−16 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• lib/Polysemy/Log/Colog.hs +5/−3
• lib/Polysemy/Log/Colog/Colog.hs +51/−5
• lib/Polysemy/Log/Colog/Conc.hs +7/−5
• polysemy-log-co.cabal +1/−1
• test/Polysemy/Log/Colog/Test/ConcTest.hs +2/−2

@@ -5,24 +5,26 @@    -- * Interpreters   interpretLogStdout,+  interpretLogStdoutConc,   interpretLogStdoutAsNative,   interpretLogColog,   interpretLogColog',   interpretDataLogColog,-  interpretCologConc,-  interpretCologConcWith,+  interpretCologConcNative,+  interpretCologConcNativeWith,   interpretCologAtomic,   interpretCologAtomic' ) where  import Polysemy.Log.Colog.Colog (   interpretLogStdout,+  interpretLogStdoutConc,   interpretLogColog,   interpretLogStdoutAsNative,   interpretLogColog',   interpretDataLogColog,   )-import Polysemy.Log.Colog.Conc (interpretCologConc, interpretCologConcWith)+import Polysemy.Log.Colog.Conc (interpretCologConcNative, interpretCologConcNativeWith) import Polysemy.Log.Colog.Atomic (interpretCologAtomic, interpretCologAtomic')  -- $intro

@@ -4,10 +4,15 @@ import qualified Colog (Message, Msg(Msg), Severity(..), logTextStdout, richMessageAction) import qualified Colog.Polysemy as Colog import Colog.Polysemy (runLogAction)+import Polysemy (interpretH, runT)+import Polysemy.Async (Async) import Polysemy.Internal (InterpretersFor)+import Polysemy.Internal.Tactics (liftT)+import Polysemy.Resource (Resource) import Polysemy.Time (GhcTime, interpretTimeGhc) -import Polysemy.Log.Data.DataLog (DataLog(DataLog))+import Polysemy.Log.Conc (interceptDataLogConc)+import Polysemy.Log.Data.DataLog (DataLog(DataLog, Local)) import Polysemy.Log.Data.Log (Log) import Polysemy.Log.Data.LogEntry (LogEntry (LogEntry)) import Polysemy.Log.Data.LogMessage (LogMessage(..))@@ -37,13 +42,29 @@ {-# INLINE toColog #-}  -- |Reinterpret 'DataLog' as 'Colog.Log'.+-- Maintains a context function as state that is applied to each logged message, allowing the context of a block to be+-- modified.+interpretDataLogCologLocal ::+  ∀ a b r .+  Member (Colog.Log b) r =>+  (a -> b) ->+  (a -> a) ->+  InterpreterFor (DataLog a) r+interpretDataLogCologLocal convert context =+  interpretH \case+    DataLog msg ->+      liftT (Colog.log (convert (context msg)))+    Local f ma ->+      raise . interpretDataLogCologLocal convert (f . context) =<< runT ma+{-# INLINE interpretDataLogCologLocal #-}++-- |Reinterpret 'DataLog' as 'Colog.Log'. interpretDataLogColog ::   ∀ a r .   Member (Colog.Log a) r =>   InterpreterFor (DataLog a) r interpretDataLogColog =-  interpret \case-    DataLog msg -> Colog.log msg+  interpretDataLogCologLocal id id {-# INLINE interpretDataLogColog #-}  -- |Reinterpret 'DataLog', specialized to the default message, as 'Colog.Log'.@@ -51,8 +72,7 @@   Member (Colog.Log Colog.Message) r =>   InterpreterFor (DataLog (LogEntry LogMessage)) r interpretDataLogNative =-  interpret \case-    DataLog msg -> Colog.log (toColog msg)+  interpretDataLogCologLocal toColog id {-# INLINE interpretDataLogNative #-}  -- |Reinterpret 'Log' as 'Colog.Log', using the /polysemy-log/ default message.@@ -109,6 +129,19 @@   raiseUnder3 {-# INLINE interpretLogStdout #-} +-- |Like 'interpretLogStdout', but process messages concurrently.+interpretLogStdoutConc ::+  Members [Resource, Async, Embed IO] r =>+  InterpreterFor Log r+interpretLogStdoutConc =+  interpretCologStdout @IO .+  interpretTimeGhc .+  interpretDataLogColog @(LogEntry LogMessage) .+  interceptDataLogConc @(LogEntry LogMessage) 64 .+  interpretLogDataLog .+  raiseUnder3+{-# INLINE interpretLogStdoutConc #-}+ -- |Interpret 'Colog.Log' with the /co-log/ message protocol by printing to stdout, using /co-log/'s rich message -- formatter. interpretCologStdoutNative ::@@ -140,3 +173,16 @@   interpretLogCologAsNative .   raiseUnder {-# INLINE interpretLogStdoutAsNative #-}++-- |Interpret 'Log' fully in terms of 'Colog.Log', using /co-log/'s message protocol and stdout.+interpretLogStdoutAsNativeConc ::+  Members [Resource, Async, Embed IO] r =>+  InterpretersFor [Log, Colog.Log Colog.Message] r+interpretLogStdoutAsNativeConc =+  interpretCologStdoutNative @IO .+  interpretTimeGhc .+  interpretDataLogNative .+  interceptDataLogConc @(LogEntry LogMessage) 64 .+  interpretLogDataLog .+  raiseUnder2+{-# INLINE interpretLogStdoutAsNativeConc #-}

@@ -13,21 +13,23 @@ import Polysemy.Log.Format (formatLogEntry)  -- |Interpret 'Colog.Log' using /co-log/'s concurrent logger with the provided 'LogAction'.-interpretCologConcWith ::+interpretCologConcNativeWith ::   ∀ msg r .   Members [Resource, Embed IO] r =>   Capacity ->   LogAction IO msg ->   InterpreterFor (Colog.Log msg) r-interpretCologConcWith capacity action sem = do+interpretCologConcNativeWith capacity action sem = do   bracket (embed (forkBackgroundLogger capacity action)) (embed . killBackgroundLogger) run   where     run worker =       runLogAction (convertToLogAction @IO worker) sem+{-# INLINE interpretCologConcNativeWith #-}  -- |Interpret 'Colog.Log' using /co-log/'s concurrent logger with the default message and formatting.-interpretCologConc ::+interpretCologConcNative ::   Members [Resource, Embed IO] r =>   InterpreterFor (Colog.Log (LogEntry LogMessage)) r-interpretCologConc =-  interpretCologConcWith defCapacity (contramap formatLogEntry Colog.logTextStdout)+interpretCologConcNative =+  interpretCologConcNativeWith defCapacity (contramap formatLogEntry Colog.logTextStdout)+{-# INLINE interpretCologConcNative #-}

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-log-co-version:        0.1.0.0+version:        0.2.0.0 synopsis:       polysemy-log interpreter for co-log description:    See <https://hackage.haskell.org/package/polysemy-log-co/docs/Polysemy-Log-Colog.html> category:       Logging

@@ -4,7 +4,7 @@ import Polysemy.Test (UnitTest, assertEq, runTestAuto)  import Polysemy.Log.Colog.Colog (interpretLogColog')-import Polysemy.Log.Colog.Conc (interpretCologConcWith)+import Polysemy.Log.Colog.Conc (interpretCologConcNativeWith) import qualified Polysemy.Log.Data.Log as Log import Polysemy.Log.Data.Log (Log) import qualified Polysemy.Log.Data.LogEntry as LogEntry@@ -28,6 +28,6 @@   runTestAuto do     tv <- newTVarIO []     let action msg = atomically (modifyTVar' tv (msg :))-    interpretCologConcWith @(LogEntry LogMessage) defCapacity (LogAction action) (interpretLogColog' prog)+    interpretCologConcNativeWith @(LogEntry LogMessage) defCapacity (LogAction action) (interpretLogColog' prog)     msgs <- readTVarIO tv     assertEq @_ @IO target (LogEntry.message <$> msgs)