polysemy-log 0.3.0.2 → 0.4.0.0

raw patch · 14 files changed

+188/−58 lines, 14 filesdep −string-interpolatePVP ok

version bump matches the API change (PVP)

Dependencies removed: string-interpolate

API changes (from Hackage documentation)

Files

• changelog.md +2/−0
• lib/Polysemy/Log.hs +19/−4
• lib/Polysemy/Log/Atomic.hs +4/−4
• lib/Polysemy/Log/Conc.hs +3/−3
• lib/Polysemy/Log/Data/Log.hs +7/−7
• lib/Polysemy/Log/Data/Severity.hs +1/−1
• lib/Polysemy/Log/Format.hs +7/−7
• lib/Polysemy/Log/Level.hs +41/−0
• lib/Polysemy/Log/Log.hs +7/−7
• lib/Polysemy/Log/Prelude.hs +0/−8
• lib/Polysemy/Log/Stderr.hs +46/−6
• lib/Polysemy/Log/Stdout.hs +46/−6
• polysemy-log.cabal +4/−4
• readme.md +1/−1

@@ -1,5 +1,7 @@ # Unreleased +* Add interceptors for setting the log level.+ # 0.3.0.0  * Add concurrent interpreters for stdout and stderr.

@@ -33,15 +33,23 @@   crit,   formatLogEntry,   Severity(..),+  setLogLevel,+  setLogLevelWith,    -- ** Interpreters   interpretLogStderrWith,+  interpretLogStderrLevelWith,   interpretLogStderrConc,+  interpretLogStderrLevelConc,   interpretLogStderr,+  interpretLogStderrLevel,   interpretLogStderr',   interpretLogStdoutWith,+  interpretLogStdoutLevelWith,   interpretLogStdoutConc,+  interpretLogStdoutLevelConc,   interpretLogStdout,+  interpretLogStdoutLevel,   interpretLogStdout',   interpretLogDataLog,   interpretLogDataLog',@@ -63,6 +71,7 @@ import Polysemy.Log.Data.LogMessage (LogMessage (LogMessage)) import Polysemy.Log.Data.Severity (Severity (..)) import Polysemy.Log.Format (formatLogEntry)+import Polysemy.Log.Level (setLogLevel, setLogLevelWith) import Polysemy.Log.Log (   interpretLogDataLog,   interpretLogDataLog',@@ -75,6 +84,9 @@   interpretLogStderr,   interpretLogStderr',   interpretLogStderrConc,+  interpretLogStderrLevel,+  interpretLogStderrLevelConc,+  interpretLogStderrLevelWith,   interpretLogStderrWith,   ) import Polysemy.Log.Stdout (@@ -83,6 +95,9 @@   interpretLogStdout,   interpretLogStdout',   interpretLogStdoutConc,+  interpretLogStdoutLevel,+  interpretLogStdoutLevelConc,+  interpretLogStdoutLevelWith,   interpretLogStdoutWith,   ) @@ -93,10 +108,10 @@ -- -- /polysemy-log/ provides an abstraction for this task with interpreter adapters for -- [co-log](https://hackage.haskell.org/package/co-log-polysemy) and--- [di](https://hackage.haskell.org/package/di-polysemy).+-- [di](https://hackage.haskell.org/package/di-polysemy), but the library can be used without those as well. ----- If you're looking for instructions on how to use /polysemy-log/ with a backend, please visit the haddocks of the--- adapter libraries:+-- If you're looking for instructions on how to use /polysemy-log/ with a third-party backend, please visit the haddocks+-- of the adapter libraries: -- --  - [polysemy-log-co for co-log](https://hackage.haskell.org/package/polysemy-log-co) --  - [polysemy-log-di for di](https://hackage.haskell.org/package/polysemy-log-di)@@ -127,7 +142,7 @@  -- $messages -- While it would be quite reasonable to handle any kind of complexly structured logging data ergonomically with--- /polysemy/, most authors probably prefer not to burden their users with this task while still appreciating the+-- /Polysemy/, most authors probably prefer not to burden their users with this task while still appreciating the -- possibility to easily relay debug information in a standardized way. -- -- The default logging effect uses a simple data structure that annotates the given severity and text message with the

@@ -15,7 +15,7 @@   InterpreterFor (DataLog a) r interpretDataLogAtomic' =   interpretDataLog \ msg -> atomicModify' @[a] (msg :)-{-# INLINE interpretDataLogAtomic' #-}+{-# inline interpretDataLogAtomic' #-}  -- |Interpret 'DataLog' by prepending each message to a list in an 'AtomicState', then interpret the 'AtomicState' in a -- 'TVar'.@@ -26,7 +26,7 @@ interpretDataLogAtomic sem = do   tv <- newTVarIO []   runAtomicStateTVar tv (interpretDataLogAtomic' sem)-{-# INLINE interpretDataLogAtomic #-}+{-# inline interpretDataLogAtomic #-}  -- |Interpret 'Log' by prepending each message to a list in an 'AtomicState'. interpretLogAtomic' ::@@ -35,7 +35,7 @@ interpretLogAtomic' =   interpret \case     Log msg -> atomicModify' (msg :)-{-# INLINE interpretLogAtomic' #-}+{-# inline interpretLogAtomic' #-}  -- |Interpret 'Log' by prepending each message to a list in an 'AtomicState', then interpret the 'AtomicState' in a -- 'TVar'.@@ -45,4 +45,4 @@ interpretLogAtomic sem = do   tv <- newTVarIO []   runAtomicStateTVar tv (interpretLogAtomic' sem)-{-# INLINE interpretLogAtomic #-}+{-# inline interpretLogAtomic #-}

@@ -27,7 +27,7 @@       liftT (Queue.write (context msg))     Local f ma ->       raise . interceptDataLogConcWithLocal (f . context) . subsume =<< runT ma-{-# INLINE interceptDataLogConcWithLocal #-}+{-# inline interceptDataLogConcWithLocal #-}  -- |Intercept 'DataLog' for concurrent processing. interceptDataLogConcWith ::@@ -37,7 +37,7 @@   Sem r a interceptDataLogConcWith =   interceptDataLogConcWithLocal @msg id-{-# INLINE interceptDataLogConcWith #-}+{-# inline interceptDataLogConcWith #-}  -- |Part of 'interceptDataLogConc'. -- Loop as long as the proided queue is open and relay all dequeued messages to the ultimate interpreter, thereby@@ -76,4 +76,4 @@   interpretQueueTBM @msg maxQueued do     !_ <- async (loggerThread @msg)     interceptDataLogConcWith @msg (raise sem)-{-# INLINE interceptDataLogConc #-}+{-# inline interceptDataLogConc #-}

@@ -33,7 +33,7 @@ log severity message =   withFrozenCallStack $   send (Log (LogMessage severity message))-{-# INLINE log #-}+{-# inline log #-}  -- |Log a message with the 'Trace' severity. trace ::@@ -44,7 +44,7 @@ trace =   withFrozenCallStack $   log Trace-{-# INLINE trace #-}+{-# inline trace #-}  -- |Log a message with the 'Debug' severity. debug ::@@ -55,7 +55,7 @@ debug =   withFrozenCallStack $   log Debug-{-# INLINE debug #-}+{-# inline debug #-}  -- |Log a message with the 'Info' severity. info ::@@ -66,7 +66,7 @@ info =   withFrozenCallStack $   log Info-{-# INLINE info #-}+{-# inline info #-}  -- |Log a message with the 'Warn' severity. warn ::@@ -77,7 +77,7 @@ warn =   withFrozenCallStack $   log Warn-{-# INLINE warn #-}+{-# inline warn #-}  -- |Log a message with the 'Error' severity. error ::@@ -88,7 +88,7 @@ error =   withFrozenCallStack $   log Error-{-# INLINE error #-}+{-# inline error #-}  -- |Log a message with the 'Crit' severity. crit ::@@ -99,4 +99,4 @@ crit =   withFrozenCallStack $   log Crit-{-# INLINE crit #-}+{-# inline crit #-}

@@ -14,4 +14,4 @@   Error   |   Crit-  deriving (Eq, Show, Enum)+  deriving (Eq, Show, Enum, Ord)

@@ -2,13 +2,13 @@ module Polysemy.Log.Format where  import qualified Data.Text as Text-import GHC.Exception (SrcLoc(..))-import System.Console.ANSI (Color(..), ColorIntensity(Dull), ConsoleLayer(Foreground), SGR (..), setSGRCode)+import GHC.Exception (SrcLoc (..))+import System.Console.ANSI (Color (..), ColorIntensity (Dull), ConsoleLayer (Foreground), SGR (..), setSGRCode) -import Polysemy.Log.Data.LogEntry (LogEntry(LogEntry))+import Polysemy.Log.Data.LogEntry (LogEntry (LogEntry)) import qualified Polysemy.Log.Data.LogMessage as LogMessage-import Polysemy.Log.Data.LogMessage (LogMessage(LogMessage))-import Polysemy.Log.Data.Severity (Severity(..))+import Polysemy.Log.Data.LogMessage (LogMessage (LogMessage))+import Polysemy.Log.Data.Severity (Severity (..))  -- |Create a colored tag with the format @"[tag]"@ for a 'Severity' value. formatSeverity :: Severity -> Text@@ -41,9 +41,9 @@   maybe "<unknown loc>" format . listToMaybe . getCallStack   where     format (_, SrcLoc {..}) =-      [qt|#{shortModule (toText srcLocModule)}\##{srcLocStartLine}|]+      shortModule (toText srcLocModule) <> "#" <> show srcLocStartLine  -- |Default formatter for the default message type. formatLogEntry :: LogEntry LogMessage -> Text formatLogEntry (LogEntry LogMessage {..} _ source) =-  [qt|#{formatSeverity severity} [#{formatCaller source}] #{message}|]+  formatSeverity severity <> " [" <> formatCaller source <> "] " <> message

@@ -0,0 +1,41 @@+-- |Description: Internal+module Polysemy.Log.Level where++import Polysemy (interceptH, runTSimple)++import qualified Polysemy.Log.Data.DataLog as DataLog+import Polysemy.Log.Data.DataLog (DataLog (DataLog, Local))+import qualified Polysemy.Log.Data.LogEntry as LogEntry+import Polysemy.Log.Data.LogEntry (LogEntry)+import qualified Polysemy.Log.Data.LogMessage as LogMessage+import Polysemy.Log.Data.LogMessage (LogMessage)+import Polysemy.Log.Data.Severity (Severity)++-- |Set the minimum severity for messages to be handled, with 'Nothing' meaning no messages are logged.+-- This can be used with arbitrary message types, using the @ex@ argument to extract the severity from the message.+setLogLevelWith ::+  ∀ msg r a .+  Member (DataLog msg) r =>+  (msg -> Severity) ->+  Maybe Severity ->+  Sem r a ->+  Sem r a+setLogLevelWith ex level =+  interceptH @(DataLog msg) \case+    DataLog msg -> do+      when (maybe False (ex msg >=) level) do+        DataLog.dataLog msg+      pureT ()+    Local f mb ->+      DataLog.local f (runTSimple mb)+{-# inline setLogLevelWith #-}++-- |Set the minimum severity for messages to be handled, with 'Nothing' meaning no messages are logged.+setLogLevel ::+  Member (DataLog (LogEntry LogMessage)) r =>+  Maybe Severity ->+  Sem r a ->+  Sem r a+setLogLevel =+  setLogLevelWith (LogMessage.severity . LogEntry.message)+{-# inline setLogLevel #-}

@@ -23,7 +23,7 @@ interpretLogLogMetadata =   interpret \case     Log msg -> annotated msg-{-# INLINE interpretLogLogMetadata #-}+{-# inline interpretLogLogMetadata #-}  -- |Interpret the intermediate internal effect 'LogMetadata' into 'DataLog'. --@@ -36,7 +36,7 @@ interpretLogMetadataDataLog =   interpret \case     Annotated msg -> dataLog =<< annotate msg-{-# INLINE interpretLogMetadataDataLog #-}+{-# inline interpretLogMetadataDataLog #-}  -- |Interpret the intermediate internal effect 'LogMetadata' into 'DataLog'. interpretLogMetadataDataLog' ::@@ -44,7 +44,7 @@   InterpretersFor [LogMetadata a, GhcTime] r interpretLogMetadataDataLog' =   interpretTimeGhc . interpretLogMetadataDataLog-{-# INLINE interpretLogMetadataDataLog' #-}+{-# inline interpretLogMetadataDataLog' #-}  -- |Interpret 'Log' into 'DataLog', adding metadata information and wrapping with 'LogEntry'. --@@ -55,7 +55,7 @@   InterpreterFor Log r interpretLogDataLog =   interpretLogMetadataDataLog @LogMessage . interpretLogLogMetadata . raiseUnder-{-# INLINE interpretLogDataLog #-}+{-# inline interpretLogDataLog #-}  -- |Interpret 'Log' into 'DataLog', adding metadata information and wrapping with 'LogEntry'. interpretLogDataLog' ::@@ -63,7 +63,7 @@   InterpretersFor [Log, LogMetadata LogMessage, GhcTime] r interpretLogDataLog' =   interpretLogMetadataDataLog' . interpretLogLogMetadata-{-# INLINE interpretLogDataLog' #-}+{-# inline interpretLogDataLog' #-}  -- |Interpret 'Log' into 'DataLog' concurrently, adding metadata information and wrapping with 'LogEntry'. interpretLogDataLogConc ::@@ -76,7 +76,7 @@   interpretLogMetadataDataLog @LogMessage .   interpretLogLogMetadata .   raiseUnder2-{-# INLINE interpretLogDataLogConc #-}+{-# inline interpretLogDataLogConc #-}  -- |Helper for maintaining a context function as state that is applied to each logged message, allowing the context of a -- block to be modified.@@ -91,7 +91,7 @@       liftT (log (context msg))     Local f ma ->       raise . interpretDataLogLocal (f . context) log =<< runT ma-{-# INLINE interpretDataLogLocal #-}+{-# inline interpretDataLogLocal #-}  -- |Combinator for building 'DataLog' interpreters that handles 'Local'. interpretDataLog ::

@@ -2,16 +2,13 @@ {-# language NoImplicitPrelude #-}  module Polysemy.Log.Prelude (-  module Polysemy.Log.Prelude,   module GHC.Err,   module Polysemy,   module Polysemy.AtomicState,   module Relude, ) where -import qualified Data.String.Interpolate as Interpolate import GHC.Err (undefined)-import Language.Haskell.TH.Quote (QuasiQuoter) import Polysemy (   Effect,   EffectRow,@@ -58,8 +55,3 @@   traceShow,   undefined,   )--qt :: QuasiQuoter-qt =-  Interpolate.i-{-# INLINE qt #-}

@@ -11,7 +11,9 @@ import Polysemy.Log.Data.Log (Log) import Polysemy.Log.Data.LogEntry (LogEntry) import Polysemy.Log.Data.LogMessage (LogMessage)+import Polysemy.Log.Data.Severity (Severity) import Polysemy.Log.Format (formatLogEntry)+import Polysemy.Log.Level (setLogLevel) import Polysemy.Log.Log (interpretDataLog, interpretLogDataLog, interpretLogDataLogConc)  -- |Interpret 'DataLog' by printing to stderr, converting messages to 'Text' with the supplied function.@@ -21,7 +23,7 @@   InterpreterFor (DataLog a) r interpretDataLogStderrWith fmt =   interpretDataLog \ msg -> embed (Text.hPutStrLn stderr (fmt msg))-{-# INLINE interpretDataLogStderrWith #-}+{-# inline interpretDataLogStderrWith #-}  -- |Interpret 'DataLog' by printing to stderr, converting messages to 'Text' by using 'Show'. interpretDataLogStderr ::@@ -30,7 +32,7 @@   InterpreterFor (DataLog a) r interpretDataLogStderr =   interpretDataLogStderrWith show-{-# INLINE interpretDataLogStderr #-}+{-# inline interpretDataLogStderr #-}  -- |Interpret 'Log' by printing to stderr, converting messages to 'Text' with the supplied function. interpretLogStderrWith ::@@ -42,8 +44,23 @@   interpretTimeGhc .   interpretLogDataLog .   raiseUnder2-{-# INLINE interpretLogStderrWith #-}+{-# inline interpretLogStderrWith #-} +-- |Like 'interpretLogStderrWith', but setting a log level.+-- 'Nothing' causes no messages to be logged.+interpretLogStderrLevelWith ::+  Members [Embed IO, GhcTime] r =>+  (LogEntry LogMessage -> Text) ->+  Maybe Severity ->+  InterpreterFor Log r+interpretLogStderrLevelWith fmt level =+  interpretDataLogStderrWith fmt .+  setLogLevel level .+  interpretTimeGhc .+  interpretLogDataLog .+  raiseUnder2+{-# inline interpretLogStderrLevelWith #-}+ -- |Interpret 'Log' by printing to stderr, using the default formatter. -- -- Since this adds a timestamp, it has a dependency on 'GhcTime'.@@ -53,8 +70,18 @@   InterpreterFor Log r interpretLogStderr =   interpretLogStderrWith formatLogEntry-{-# INLINE interpretLogStderr #-}+{-# inline interpretLogStderr #-} +-- |Like 'interpretLogStderr', but setting a log level.+-- 'Nothing' causes no messages to be logged.+interpretLogStderrLevel ::+  Members [Embed IO, GhcTime] r =>+  Maybe Severity ->+  InterpreterFor Log r+interpretLogStderrLevel =+  interpretLogStderrLevelWith formatLogEntry+{-# inline interpretLogStderrLevel #-}+ -- |Interpret 'Log' by printing to stderr, using the default formatter, then interpreting 'GhcTime'. interpretLogStderr' ::   Member (Embed IO) r =>@@ -63,7 +90,7 @@   interpretTimeGhc .   interpretLogStderr .   raiseUnder-{-# INLINE interpretLogStderr' #-}+{-# inline interpretLogStderr' #-}  -- |Like 'interpretLogStderr', but process messages concurrently. interpretLogStderrConc ::@@ -74,4 +101,17 @@   interpretDataLogStderrWith formatLogEntry .   interpretLogDataLogConc 64 .   raiseUnder2-{-# INLINE interpretLogStderrConc #-}+{-# inline interpretLogStderrConc #-}++-- |Like 'interpretLogStderr', but process messages concurrently.+interpretLogStderrLevelConc ::+  Members [Resource, Async, Race, Embed IO] r =>+  Maybe Severity ->+  InterpreterFor Log r+interpretLogStderrLevelConc level =+  interpretTimeGhc .+  interpretDataLogStderrWith formatLogEntry .+  setLogLevel level .+  interpretLogDataLogConc 64 .+  raiseUnder2+{-# inline interpretLogStderrLevelConc #-}

@@ -13,6 +13,8 @@ import Polysemy.Log.Data.LogMessage (LogMessage) import Polysemy.Log.Format (formatLogEntry) import Polysemy.Log.Log (interpretDataLog, interpretLogDataLog, interpretLogDataLogConc)+import Polysemy.Log.Data.Severity (Severity)+import Polysemy.Log.Level (setLogLevel)  -- |Interpret 'DataLog' by printing to stdout, converting messages to 'Text' with the supplied function. interpretDataLogStdoutWith ::@@ -21,7 +23,7 @@   InterpreterFor (DataLog a) r interpretDataLogStdoutWith fmt =   interpretDataLog \ msg -> embed (Text.hPutStrLn stdout (fmt msg))-{-# INLINE interpretDataLogStdoutWith #-}+{-# inline interpretDataLogStdoutWith #-}  -- |Interpret 'DataLog' by printing to stdout, converting messages to 'Text' by using 'Show'. interpretDataLogStdout ::@@ -30,7 +32,7 @@   InterpreterFor (DataLog a) r interpretDataLogStdout =   interpretDataLogStdoutWith show-{-# INLINE interpretDataLogStdout #-}+{-# inline interpretDataLogStdout #-}  -- |Interpret 'Log' by printing to stdout, converting messages to 'Text' with the supplied function. interpretLogStdoutWith ::@@ -42,8 +44,23 @@   interpretTimeGhc .   interpretLogDataLog .   raiseUnder2-{-# INLINE interpretLogStdoutWith #-}+{-# inline interpretLogStdoutWith #-} +-- |Like 'interpretLogStdoutWith', but setting a log level.+-- 'Nothing' causes no messages to be logged.+interpretLogStdoutLevelWith ::+  Members [Embed IO, GhcTime] r =>+  (LogEntry LogMessage -> Text) ->+  Maybe Severity ->+  InterpreterFor Log r+interpretLogStdoutLevelWith fmt level =+  interpretDataLogStdoutWith fmt .+  setLogLevel level .+  interpretTimeGhc .+  interpretLogDataLog .+  raiseUnder2+{-# inline interpretLogStdoutLevelWith #-}+ -- |Interpret 'Log' by printing to stdout, using the default formatter. -- -- Since this adds a timestamp, it has a dependency on 'GhcTime'.@@ -53,8 +70,18 @@   InterpreterFor Log r interpretLogStdout =   interpretLogStdoutWith formatLogEntry-{-# INLINE interpretLogStdout #-}+{-# inline interpretLogStdout #-} +-- |Like 'interpretLogStdout', but setting a log level.+-- 'Nothing' causes no messages to be logged.+interpretLogStdoutLevel ::+  Members [Embed IO, GhcTime] r =>+  Maybe Severity ->+  InterpreterFor Log r+interpretLogStdoutLevel =+  interpretLogStdoutLevelWith formatLogEntry+{-# inline interpretLogStdoutLevel #-}+ -- |Interpret 'Log' by printing to stdout, using the default formatter, then interpreting 'GhcTime'. interpretLogStdout' ::   Member (Embed IO) r =>@@ -63,7 +90,7 @@   interpretTimeGhc .   interpretLogStdout .   raiseUnder-{-# INLINE interpretLogStdout' #-}+{-# inline interpretLogStdout' #-}  -- |Like 'interpretLogStdout', but process messages concurrently. interpretLogStdoutConc ::@@ -74,4 +101,17 @@   interpretDataLogStdoutWith formatLogEntry .   interpretLogDataLogConc 64 .   raiseUnder2-{-# INLINE interpretLogStdoutConc #-}+{-# inline interpretLogStdoutConc #-}++-- |Like 'interpretLogStdout', but process messages concurrently.+interpretLogStdoutLevelConc ::+  Members [Resource, Async, Race, Embed IO] r =>+  Maybe Severity ->+  InterpreterFor Log r+interpretLogStdoutLevelConc level =+  interpretTimeGhc .+  interpretDataLogStdoutWith formatLogEntry .+  setLogLevel level .+  interpretLogDataLogConc 64 .+  raiseUnder2+{-# inline interpretLogStdoutLevelConc #-}

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-log-version:        0.3.0.2+version:        0.4.0.0 synopsis:       Polysemy Effects for Logging description:    See <https://hackage.haskell.org/package/polysemy-log/docs/Polysemy-Log.html> category:       Logging@@ -37,6 +37,7 @@       Polysemy.Log.Data.LogMetadata       Polysemy.Log.Data.Severity       Polysemy.Log.Format+      Polysemy.Log.Level       Polysemy.Log.Log       Polysemy.Log.Prelude       Polysemy.Log.Pure@@ -107,7 +108,7 @@       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -flate-specialise -fspecialise-aggressively -Wall -Wredundant-constraints -Wunused-packages+  ghc-options: -Wall -Wredundant-constraints -Wunused-packages -Widentities   build-depends:       ansi-terminal >=0.10.3     , base ==4.*@@ -115,7 +116,6 @@     , polysemy-conc >=0.3     , polysemy-time >=0.1.4     , relude >=0.7-    , string-interpolate >=0.2.1     , template-haskell     , text     , time@@ -193,7 +193,7 @@       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -flate-specialise -fspecialise-aggressively -Wall -Wredundant-constraints -Wunused-packages -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -Wredundant-constraints -Wunused-packages -Widentities -threaded -rtsopts -with-rtsopts=-N   build-depends:       base ==4.*     , polysemy >=1.5

@@ -6,7 +6,7 @@  A common interface for the polysemy logging backend adapters. -An example program using [co-log], for the simple logger with predefined formatting and a custom data type:+An example program using a simple logger with predefined formatting and a custom data type:  ```haskell import Colog (logTextStdout)