diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,13 @@ +# Unreleased + +# 0.3.0.0 + +* Add concurrent interpreters for stdout and stderr. +* Add stdout interpreters. + # 0.2.1.0 -* add naive stderr interpreters for `DataLog` and `Log`. + +* Add naive stderr interpreters for `DataLog` and `Log`. # 0.2.0.0 diff --git a/lib/Polysemy/Log.hs b/lib/Polysemy/Log.hs --- a/lib/Polysemy/Log.hs +++ b/lib/Polysemy/Log.hs @@ -14,6 +14,8 @@ -- ** Interpreters interpretDataLogStderrWith, interpretDataLogStderr, + interpretDataLogStdoutWith, + interpretDataLogStdout, interpretDataLogAtomic', interpretDataLogAtomic, @@ -36,6 +38,9 @@ interpretLogStderrWith, interpretLogStderr, interpretLogStderr', + interpretLogStdoutWith, + interpretLogStdout, + interpretLogStdout', interpretLogDataLog, interpretLogDataLog', interpretLogOutput, @@ -50,23 +55,32 @@ import Polysemy.Log.Atomic (interpretDataLogAtomic, interpretDataLogAtomic', interpretLogAtomic, interpretLogAtomic') import Polysemy.Log.Conc (interceptDataLogConc) -import Polysemy.Log.Data.DataLog (DataLog(DataLog), dataLog) -import Polysemy.Log.Data.Log (Log(Log), crit, debug, error, info, log, trace, warn) -import Polysemy.Log.Data.LogEntry (LogEntry(LogEntry)) -import Polysemy.Log.Data.LogMessage (LogMessage(LogMessage)) -import Polysemy.Log.Data.Severity (Severity(..)) +import Polysemy.Log.Data.DataLog (DataLog (DataLog), dataLog) +import Polysemy.Log.Data.Log (Log (Log), crit, debug, error, info, log, trace, warn) +import Polysemy.Log.Data.LogEntry (LogEntry (LogEntry)) +import Polysemy.Log.Data.LogMessage (LogMessage (LogMessage)) +import Polysemy.Log.Data.Severity (Severity (..)) import Polysemy.Log.Format (formatLogEntry) import Polysemy.Log.Log ( interpretLogDataLog, interpretLogDataLog', interpretLogDataLogConc, - interpretDataLogStderrWith, + ) +import Polysemy.Log.Pure (interpretLogNull, interpretLogOutput) +import Polysemy.Log.Stderr ( interpretDataLogStderr, - interpretLogStderrWith, + interpretDataLogStderrWith, interpretLogStderr, interpretLogStderr', + interpretLogStderrWith, ) -import Polysemy.Log.Pure (interpretLogNull, interpretLogOutput) +import Polysemy.Log.Stdout ( + interpretDataLogStdout, + interpretDataLogStdoutWith, + interpretLogStdout, + interpretLogStdout', + interpretLogStdoutWith, + ) -- $intro -- There are at least two libraries that wrap a logging backend with polysemy interpreters. diff --git a/lib/Polysemy/Log/Log.hs b/lib/Polysemy/Log/Log.hs --- a/lib/Polysemy/Log/Log.hs +++ b/lib/Polysemy/Log/Log.hs @@ -1,7 +1,6 @@ -- |Description: Internal module Polysemy.Log.Log where -import qualified Data.Text.IO as Text import Polysemy (interpretH, runT) import Polysemy.Async (Async) import Polysemy.Conc (Race) @@ -11,12 +10,11 @@ import Polysemy.Time (GhcTime, interpretTimeGhc) import Polysemy.Log.Conc (interceptDataLogConc) -import Polysemy.Log.Data.DataLog (DataLog(DataLog, Local), dataLog) -import Polysemy.Log.Data.Log (Log(Log)) +import Polysemy.Log.Data.DataLog (DataLog (DataLog, Local), dataLog) +import Polysemy.Log.Data.Log (Log (Log)) import Polysemy.Log.Data.LogEntry (LogEntry, annotate) import Polysemy.Log.Data.LogMessage (LogMessage) -import Polysemy.Log.Data.LogMetadata (LogMetadata(Annotated), annotated) -import Polysemy.Log.Format (formatLogEntry) +import Polysemy.Log.Data.LogMetadata (LogMetadata (Annotated), annotated) -- |Interpret 'Log' into the intermediate internal effect 'LogMetadata'. interpretLogLogMetadata :: @@ -80,7 +78,7 @@ raiseUnder2 {-# INLINE interpretLogDataLogConc #-} --- |Helper for maintaining context function as state that is applied to each logged message, allowing the context of a +-- |Helper for maintaining a context function as state that is applied to each logged message, allowing the context of a -- block to be modified. interpretDataLogLocal :: ∀ a r . @@ -102,54 +100,3 @@ InterpreterFor (DataLog a) r interpretDataLog = interpretDataLogLocal id - --- |Interpret 'DataLog' by printing to stderr, converting messages to 'Text' with the supplied function. -interpretDataLogStderrWith :: - Member (Embed IO) r => - (a -> Text) -> - InterpreterFor (DataLog a) r -interpretDataLogStderrWith fmt = - interpretDataLog \ msg -> embed (Text.hPutStrLn stderr (fmt msg)) -{-# INLINE interpretDataLogStderrWith #-} - --- |Interpret 'DataLog' by printing to stderr, converting messages to 'Text' by using 'Show'. -interpretDataLogStderr :: - Show a => - Member (Embed IO) r => - InterpreterFor (DataLog a) r -interpretDataLogStderr = - interpretDataLogStderrWith show -{-# INLINE interpretDataLogStderr #-} - --- |Interpret 'Log' by printing to stderr, converting messages to 'Text' with the supplied function. -interpretLogStderrWith :: - Members [Embed IO, GhcTime] r => - (LogEntry LogMessage -> Text) -> - InterpreterFor Log r -interpretLogStderrWith fmt = - interpretDataLogStderrWith fmt . - interpretTimeGhc . - interpretLogDataLog . - raiseUnder2 -{-# INLINE interpretLogStderrWith #-} - --- |Interpret 'Log' by printing to stderr, using the default formatter. --- --- Since this adds a timestamp, it has a dependency on 'GhcTime'. --- Use 'interpretLogStderr'' for a variant that interprets 'GhcTime' in-place. -interpretLogStderr :: - Members [Embed IO, GhcTime] r => - InterpreterFor Log r -interpretLogStderr = - interpretLogStderrWith formatLogEntry -{-# INLINE interpretLogStderr #-} - --- |Interpret 'Log' by printing to stderr, using the default formatter, then interpreting 'GhcTime'. -interpretLogStderr' :: - Member (Embed IO) r => - InterpreterFor Log r -interpretLogStderr' = - interpretTimeGhc . - interpretLogStderr . - raiseUnder -{-# INLINE interpretLogStderr' #-} diff --git a/lib/Polysemy/Log/Prelude.hs b/lib/Polysemy/Log/Prelude.hs --- a/lib/Polysemy/Log/Prelude.hs +++ b/lib/Polysemy/Log/Prelude.hs @@ -1,5 +1,5 @@ {-# options_haddock hide #-} -{-# LANGUAGE NoImplicitPrelude #-} +{-# language NoImplicitPrelude #-} module Polysemy.Log.Prelude ( module Polysemy.Log.Prelude, diff --git a/lib/Polysemy/Log/Stderr.hs b/lib/Polysemy/Log/Stderr.hs new file mode 100644 --- /dev/null +++ b/lib/Polysemy/Log/Stderr.hs @@ -0,0 +1,77 @@ +-- |Description: Internal +module Polysemy.Log.Stderr where + +import qualified Data.Text.IO as Text +import Polysemy.Async (Async) +import Polysemy.Conc (Race) +import Polysemy.Resource (Resource) +import Polysemy.Time (GhcTime, interpretTimeGhc) + +import Polysemy.Log.Data.DataLog (DataLog) +import Polysemy.Log.Data.Log (Log) +import Polysemy.Log.Data.LogEntry (LogEntry) +import Polysemy.Log.Data.LogMessage (LogMessage) +import Polysemy.Log.Format (formatLogEntry) +import Polysemy.Log.Log (interpretDataLog, interpretLogDataLog, interpretLogDataLogConc) + +-- |Interpret 'DataLog' by printing to stderr, converting messages to 'Text' with the supplied function. +interpretDataLogStderrWith :: + Member (Embed IO) r => + (a -> Text) -> + InterpreterFor (DataLog a) r +interpretDataLogStderrWith fmt = + interpretDataLog \ msg -> embed (Text.hPutStrLn stderr (fmt msg)) +{-# INLINE interpretDataLogStderrWith #-} + +-- |Interpret 'DataLog' by printing to stderr, converting messages to 'Text' by using 'Show'. +interpretDataLogStderr :: + Show a => + Member (Embed IO) r => + InterpreterFor (DataLog a) r +interpretDataLogStderr = + interpretDataLogStderrWith show +{-# INLINE interpretDataLogStderr #-} + +-- |Interpret 'Log' by printing to stderr, converting messages to 'Text' with the supplied function. +interpretLogStderrWith :: + Members [Embed IO, GhcTime] r => + (LogEntry LogMessage -> Text) -> + InterpreterFor Log r +interpretLogStderrWith fmt = + interpretDataLogStderrWith fmt . + interpretTimeGhc . + interpretLogDataLog . + raiseUnder2 +{-# INLINE interpretLogStderrWith #-} + +-- |Interpret 'Log' by printing to stderr, using the default formatter. +-- +-- Since this adds a timestamp, it has a dependency on 'GhcTime'. +-- Use 'interpretLogStderr'' for a variant that interprets 'GhcTime' in-place. +interpretLogStderr :: + Members [Embed IO, GhcTime] r => + InterpreterFor Log r +interpretLogStderr = + interpretLogStderrWith formatLogEntry +{-# INLINE interpretLogStderr #-} + +-- |Interpret 'Log' by printing to stderr, using the default formatter, then interpreting 'GhcTime'. +interpretLogStderr' :: + Member (Embed IO) r => + InterpreterFor Log r +interpretLogStderr' = + interpretTimeGhc . + interpretLogStderr . + raiseUnder +{-# INLINE interpretLogStderr' #-} + +-- |Like 'interpretLogStderr', but process messages concurrently. +interpretLogStderrConc :: + Members [Resource, Async, Race, Embed IO] r => + InterpreterFor Log r +interpretLogStderrConc = + interpretTimeGhc . + interpretDataLogStderrWith formatLogEntry . + interpretLogDataLogConc 64 . + raiseUnder2 +{-# INLINE interpretLogStderrConc #-} diff --git a/lib/Polysemy/Log/Stdout.hs b/lib/Polysemy/Log/Stdout.hs new file mode 100644 --- /dev/null +++ b/lib/Polysemy/Log/Stdout.hs @@ -0,0 +1,77 @@ +-- |Description: Internal +module Polysemy.Log.Stdout where + +import qualified Data.Text.IO as Text +import Polysemy.Async (Async) +import Polysemy.Conc (Race) +import Polysemy.Resource (Resource) +import Polysemy.Time (GhcTime, interpretTimeGhc) + +import Polysemy.Log.Data.DataLog (DataLog) +import Polysemy.Log.Data.Log (Log) +import Polysemy.Log.Data.LogEntry (LogEntry) +import Polysemy.Log.Data.LogMessage (LogMessage) +import Polysemy.Log.Format (formatLogEntry) +import Polysemy.Log.Log (interpretDataLog, interpretLogDataLog, interpretLogDataLogConc) + +-- |Interpret 'DataLog' by printing to stderr, converting messages to 'Text' with the supplied function. +interpretDataLogStdoutWith :: + Member (Embed IO) r => + (a -> Text) -> + InterpreterFor (DataLog a) r +interpretDataLogStdoutWith fmt = + interpretDataLog \ msg -> embed (Text.hPutStrLn stderr (fmt msg)) +{-# INLINE interpretDataLogStdoutWith #-} + +-- |Interpret 'DataLog' by printing to stderr, converting messages to 'Text' by using 'Show'. +interpretDataLogStdout :: + Show a => + Member (Embed IO) r => + InterpreterFor (DataLog a) r +interpretDataLogStdout = + interpretDataLogStdoutWith show +{-# INLINE interpretDataLogStdout #-} + +-- |Interpret 'Log' by printing to stderr, converting messages to 'Text' with the supplied function. +interpretLogStdoutWith :: + Members [Embed IO, GhcTime] r => + (LogEntry LogMessage -> Text) -> + InterpreterFor Log r +interpretLogStdoutWith fmt = + interpretDataLogStdoutWith fmt . + interpretTimeGhc . + interpretLogDataLog . + raiseUnder2 +{-# INLINE interpretLogStdoutWith #-} + +-- |Interpret 'Log' by printing to stderr, using the default formatter. +-- +-- Since this adds a timestamp, it has a dependency on 'GhcTime'. +-- Use 'interpretLogStdout'' for a variant that interprets 'GhcTime' in-place. +interpretLogStdout :: + Members [Embed IO, GhcTime] r => + InterpreterFor Log r +interpretLogStdout = + interpretLogStdoutWith formatLogEntry +{-# INLINE interpretLogStdout #-} + +-- |Interpret 'Log' by printing to stderr, using the default formatter, then interpreting 'GhcTime'. +interpretLogStdout' :: + Member (Embed IO) r => + InterpreterFor Log r +interpretLogStdout' = + interpretTimeGhc . + interpretLogStdout . + raiseUnder +{-# INLINE interpretLogStdout' #-} + +-- |Like 'interpretLogStdout', but process messages concurrently. +interpretLogStdoutConc :: + Members [Resource, Async, Race, Embed IO] r => + InterpreterFor Log r +interpretLogStdoutConc = + interpretTimeGhc . + interpretDataLogStdoutWith formatLogEntry . + interpretLogDataLogConc 64 . + raiseUnder2 +{-# INLINE interpretLogStdoutConc #-} diff --git a/polysemy-log.cabal b/polysemy-log.cabal --- a/polysemy-log.cabal +++ b/polysemy-log.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: polysemy-log -version: 0.2.2.4 +version: 0.3.0.0 synopsis: Polysemy Effects for Logging description: See category: Logging @@ -40,6 +40,8 @@ Polysemy.Log.Log Polysemy.Log.Prelude Polysemy.Log.Pure + Polysemy.Log.Stderr + Polysemy.Log.Stdout other-modules: Prelude Paths_polysemy_log @@ -105,13 +107,13 @@ UndecidableInstances UnicodeSyntax ViewPatterns - ghc-options: -flate-specialise -fspecialise-aggressively -Wall -Wredundant-constraints + ghc-options: -flate-specialise -fspecialise-aggressively -Wall -Wredundant-constraints -Wunused-packages build-depends: ansi-terminal >=0.10.3 , base ==4.* , polysemy >=1.5 - , polysemy-conc >=0.1.0.0 - , polysemy-time >=0.1.1.0 + , polysemy-conc >=0.3 + , polysemy-time >=0.1.4 , relude >=0.7 , string-interpolate >=0.2.1 , template-haskell @@ -191,25 +193,18 @@ UndecidableInstances UnicodeSyntax ViewPatterns - ghc-options: -flate-specialise -fspecialise-aggressively -Wall -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + ghc-options: -flate-specialise -fspecialise-aggressively -Wall -Wredundant-constraints -Wunused-packages -threaded -rtsopts -with-rtsopts=-N build-depends: - ansi-terminal >=0.10.3 - , base ==4.* - , hedgehog + base ==4.* , polysemy >=1.5 - , polysemy-conc >=0.1.0.0 + , polysemy-conc , polysemy-log , polysemy-test - , polysemy-time >=0.1.1.0 - , relude >=0.7 - , string-interpolate >=0.2.1 + , polysemy-time , tasty - , tasty-hedgehog - , template-haskell - , text , time mixins: base hiding (Prelude) - , polysemy-log hiding (Prelude) + , polysemy-log hiding (Polysemy.Log.Prelude) , polysemy-log (Polysemy.Log.Prelude as Prelude) default-language: Haskell2010 diff --git a/test/Polysemy/Log/Test/LogEntryTest.hs b/test/Polysemy/Log/Test/LogEntryTest.hs --- a/test/Polysemy/Log/Test/LogEntryTest.hs +++ b/test/Polysemy/Log/Test/LogEntryTest.hs @@ -8,7 +8,7 @@ import qualified Polysemy.Log.Data.LogEntry as LogEntry import Polysemy.Log.Data.LogEntry (LogEntry) import Polysemy.Log.Data.LogMessage (LogMessage (LogMessage)) -import Polysemy.Log.Data.Severity (Severity(Crit, Debug)) +import Polysemy.Log.Data.Severity (Severity (Crit, Debug)) import Polysemy.Log.Format (formatCaller) import Polysemy.Log.Log (interpretLogDataLog')