co-log 0.3.0.0 → 0.4.0.0

raw patch · 15 files changed

+619/−292 lines, 15 filesdep +vectordep ~ansi-terminaldep ~basedep ~bytestringnew-component:exe:concurrent-playgroundPVP ok

version bump matches the API change (PVP)

Dependencies added: vector

Dependency ranges changed: ansi-terminal, base, bytestring, chronos, co-log-core, hedgehog, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +35/−0
• co-log.cabal +31/−13
• src/Colog.hs +4/−2
• src/Colog/Actions.hs +3/−3
• src/Colog/Concurrent.hs +215/−201
• src/Colog/Concurrent/Internal.hs +9/−6
• src/Colog/Contra.hs +2/−2
• src/Colog/Message.hs +221/−37
• src/Colog/Monad.hs +20/−5
• src/Colog/Pure.hs +3/−3
• src/Colog/Rotation.hs +19/−12
• test/Property.hs +2/−1
• tutorials/2-custom/Custom.lhs +3/−2
• tutorials/Concurrent.hs +28/−0
• tutorials/Main.hs +24/−5

@@ -3,6 +3,41 @@ `co-log` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.4.0.0 — Jan 19, 2020++* [#120](https://github.com/kowainik/co-log/issues/120):+  Improve time formatting.++  Old: `29-12-2019 22:00:00.000`++  New: `29 Dec 2019 22:00:00.000 +00:00`++  (by [@vrom911](https://github.com/vrom911))+* [#144](https://github.com/kowainik/co-log/issues/144):+  Add Windows CI check.+  (by [@vrom911](https://github.com/vrom911))+* [#148](https://github.com/kowainik/co-log/issues/148):+  Support GHC-8.8.2.+  (by [@chshersh](https://github.com/chshersh))+* [#119](https://github.com/kowainik/co-log/issues/119):+  Add new message type that allows printing messages without+  `Severity`.+  (by [@sphaso](https://github.com/sphaso))+* [#150](https://github.com/kowainik/co-log/issues/150):+  Introduce `formatWith` — beginner-friendly alias for formatting combinator.+  (by [@chshersh](https://github.com/chshersh))+* Use `chronos-1.1` as `1.0.9` is not Windows-compatible.+  (by [@vrom911](https://github.com/vrom911))+* [#156](https://github.com/kowainik/co-log/issues/156):+  Improve documentation for the `Colog.Concurrent` module.+  (by [@chshersh](https://github.com/chshersh))+* [#146](https://github.com/kowainik/co-log/issues/146):+  Allow `ansi-terminal-0.10`.+  (by [@mpilgrem](https://github.com/mpilgrem))+* [#124](https://github.com/kowainik/co-log/issues/124):+  Implement executable playground for concurrent logging.+  (by [@chshersh](https://github.com/chshersh))+ ## 0.3.0.0 — May 5, 2019  * [#77](https://github.com/kowainik/co-log/issues/77):

@@ -1,10 +1,9 @@ cabal-version:       2.4 name:                co-log-version:             0.3.0.0+version:             0.4.0.0 synopsis:            Composable Contravariant Comonadic Logging Library description:-    The default implementation of logging based on-    [co-log-core](http://hackage.haskell.org/package/co-log-core).+    The default implementation of logging based on [co-log-core](http://hackage.haskell.org/package/co-log-core).     .     The ideas behind this package are described in the following blog post:     .@@ -16,22 +15,23 @@ license-file:        LICENSE author:              Dmitrii Kovanikov maintainer:          Kowainik <xrom.xkov@gmail.com>-copyright:           2018-2019 Kowainik+copyright:           2018-2020 Kowainik category:            Logging, Contravariant, Comonad build-type:          Simple stability:           provisional extra-doc-files:     CHANGELOG.md-                   , README.md+                     README.md tested-with:         GHC == 8.2.2-                   , GHC == 8.4.4-                   , GHC == 8.6.5+                     GHC == 8.4.4+                     GHC == 8.6.5+                     GHC == 8.8.1  source-repository head   type:                git   location:            https://github.com/kowainik/co-log.git  common common-options-  build-depends:       base >= 4.10.0.0 && < 4.13+  build-depends:       base >= 4.10.1.0 && < 4.14    ghc-options:         -Wall                        -Wincomplete-uni-patterns@@ -42,9 +42,13 @@                        -fhide-source-paths                        -freverse-errors                        -Wpartial-fields-  default-language:    Haskell2010+  if impl(ghc >= 8.8.1)+    ghc-options:       -Wmissing-deriving-strategies+                       -Werror=missing-deriving-strategies +  default-language:    Haskell2010   default-extensions:  ConstraintKinds+                       DerivingStrategies                        DeriveGeneric                        GeneralizedNewtypeDeriving                        LambdaCase@@ -58,6 +62,8 @@  common tutorial-options   import:              common-options+  if os(windows)+    buildable:         False   build-depends:       co-log                      , co-log-core @@ -77,9 +83,9 @@                            Colog.Pure                            Colog.Rotation -  build-depends:       ansi-terminal ^>= 0.9+  build-depends:       ansi-terminal ^>= 0.10                      , bytestring ^>= 0.10.8-                     , co-log-core ^>= 0.2.0.0+                     , co-log-core ^>= 0.2.1.0                      , containers >= 0.5.7 && < 0.7                      , contravariant ^>= 1.5                      , directory ^>= 1.3.0@@ -87,9 +93,10 @@                      , mtl ^>= 2.2.2                      , stm >= 2.4 && < 2.6                      , text ^>= 1.2.3-                     , chronos ^>= 1.0.4+                     , chronos ^>= 1.1                      , transformers ^>= 0.5                      , typerep-map ^>= 0.3.2+                     , vector ^>= 0.12.0.3  executable play-colog   import:              common-options@@ -99,11 +106,22 @@   build-depends:       co-log                      , mtl                      , typerep-map+                     , text    ghc-options:         -threaded                        -rtsopts                        -with-rtsopts=-N +executable concurrent-playground+  import:              common-options+  hs-source-dirs:      tutorials+  main-is:             Concurrent.hs+  build-depends:       bytestring+                     , co-log+  ghc-options:         -threaded+                       -rtsopts+                       -with-rtsopts=-N+ executable readme   import:              tutorial-options   main-is:             README.lhs@@ -122,7 +140,7 @@   import:              common-options   build-depends:       co-log                      , co-log-core-                     , hedgehog ^>= 0.6+                     , hedgehog ^>= 1.0   hs-source-dirs:      test   main-is:             Property.hs   type:                exitcode-stdio-1.0

@@ -1,6 +1,6 @@ {- |-Copyright:  (c) 2018-2019 Kowainik-License:    MPL-2.0+Copyright:  (c) 2018-2020 Kowainik+SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik <xrom.xkov@gmail.com>  This package contains @mtl@ implementation of composable, contravariant and@@ -9,6 +9,7 @@  module Colog        ( module Colog.Actions+       , module Colog.Concurrent        , module Colog.Core        , module Colog.Message        , module Colog.Monad@@ -17,6 +18,7 @@        ) where  import Colog.Actions+import Colog.Concurrent import Colog.Contra () import Colog.Core import Colog.Message

@@ -1,6 +1,6 @@ {- |-Copyright:  (c) 2018-2019 Kowainik-License:    MPL-2.0+Copyright:  (c) 2018-2020 Kowainik+SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik <xrom.xkov@gmail.com>  Logging actions for various text types.@@ -110,7 +110,7 @@ simpleMessageAction :: MonadIO m => LogAction m Message simpleMessageAction = encodeUtf8 . fmtMessage >$< logByteStringStdout {-# INLINE simpleMessageAction #-}-{-# SPECIALIZE simpleMessageAction :: LogAction IO Message#-}+{-# SPECIALIZE simpleMessageAction :: LogAction IO Message #-}  {- | Action that constructs 'Colog.Message.RichMessage' and prints formatted 'Message' for it to 'stdout'.

@@ -1,6 +1,6 @@ {- |-Copyright:  (c) 2018-2019 Kowainik-License:    MPL-2.0+Copyright:  (c) 2018-2020 Kowainik+SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik <xrom.xkov@gmail.com>  __NOTE:__ Many thanks to Alexander Vershilov for the implementation.@@ -71,101 +71,105 @@ import Colog.Core.Action (LogAction (..))  --- $general------ Concurrent logger consists of the basic parts (see schema below).------   1. Logger in application thread. This logger is evaluated in the---   application thread and has an access to all the context available---   in that thread and monad, this logger can work in any `m`.------   2. Communication channel with backpressure support. In addition to---   the channel we have a converter that puts the user message to the---   communication channel. This converter works in the user thread.---   Such a logger usually works in `IO` but it's possible to make it---   work in `STM` as well. At this point library provides only `IO`---   version, but it can be lifted to any `MonadIO` by the user.------   3. Logger thread. This is the thread that performs actual write to---   the sinks. Loggers there do not have access to the users thread---   state, unless that state was passed in the message.--------- @------  +-------------------------+                  +--------------------------------+---  |                         |                  | Logger        |   Sink-1       |---  |   Application Thread    |                  | Thread    +--->                |---  |   -----------------     |  +-----------+   |           |   +----------------+---  |                         |  |           |   +---------+ |   +----------------+---  |           +-------------+  |  channel  |   | Shared  +----->   Sink-2       |---  |           | application||  |          +----> logger  | |   |                |---  |           | logger    +----->          |   +---------+ |   +----------------+---  |           +-------------+  |           |   |           |   +----------------+---  |                         |  +-----------+   |           +--->   Sink3        |---  |                         |                  |               |                |---  |                         |                  |               +----------------+---  |                         |                  |                                |---  +-------------------------+                  +--------------------------------+--- @------ So usually user should write the logging system in the way that all 'LogAction'--- that populate and filter information should live in the application logger.--- All loggers that do serialization and formatting should live in shared logger.--------- If more concurrency is needed it's possible to build multilayer systems:--------- @---   +-------------+                         +-------+---   | application |---+                 +---| sink-1|---   +-------------+   |   +---------+   |   +-------+---                     +---| logger  |---+---                         +---------+   |   +-------+---                                       +---| sink-2|---                                           +-------+--- @------ In this approach application will be concurrently write logs to the logger, then--- logger will be concurrently writing to all sinks.+{- $general +Concurrent logger consists of the basic parts (see schema below). --- $simple-api------ Simple API provides a handy easy to use API that can be used directly--- in application without dealing with internals. Based on users feedback--- internal implementation of the simple API may change, especially in early--- versions of the library. But the guarantee that we give is that no matter--- what implementation is it will be kept with reasonable defaults and will--- be applicable to a generic application.---+  1. Logger in application thread. This logger is evaluated in the+  application thread and has an access to all the context available+  in that thread and monad, this logger can work in any @m@. --- | An exception safe way to create background logger.  This method will fork--- a thread that will run 'shared worker', see schema above.------ @Capacity@ - provides a backpressure mechanism and tells how many messages--- in flight are allowed. In most cases 'defCapacity' will work well.--- See 'forkBackgroundLogger' for more details.------ @LogAction@ - provides a logger action, this action does not have access to the--- application state or thread info, so you should only pass methods that serialize--- and dump data there.------ @--- import qualified Data.Aeson as Aeson------ main :: IO ()--- main =---   'withBackgroundLogger'---      'defCapacity'---      (Aeson.encode \``Colog.Core.Action.cmap`\` logger)---      $ 'Colog.Monad.usingLoggerT' $ __do__---         'Colog.Monad.logMsg' "Starting application..."---   where---     logger = 'Colog.Action.withLogByteStringFile' "\/var\/log\/myapp\/log"--- @-withBackgroundLogger :: MonadIO m => Capacity -> LogAction IO msg -> (LogAction m msg -> IO a) -> IO a+  2. Communication channel with backpressure support. In addition to+  the channel we have a converter that puts the user message to the+  communication channel. This converter works in the user thread.+  Such a logger usually works in 'IO' but it's possible to make it+  work in 'Control.Concurrent.STM.STM' as well. At this point library provides only 'IO'+  version, but it can be lifted to any 'MonadIO' by the user.++  3. Logger thread. This is the thread that performs actual write to+  the sinks. Loggers there do not have access to the users thread+  state, unless that state was passed in the message.+++@++ +-------------------------+                  +--------------------------------++ |                         |                  | Logger        |   Sink-1       |+ |   Application Thread    |                  | Thread    +--->                |+ |   -----------------     |  +-----------+   |           |   +----------------++ |                         |  |           |   +---------+ |   +----------------++ |           +-------------+  |  channel  |   | Shared  +----->   Sink-2       |+ |           | application||  |          +----> logger  | |   |                |+ |           | logger    +----->          |   +---------+ |   +----------------++ |           +-------------+  |           |   |           |   +----------------++ |                         |  +-----------+   |           +--->   Sink3        |+ |                         |                  |               |                |+ |                         |                  |               +----------------++ |                         |                  |                                |+ +-------------------------+                  +--------------------------------++@++So usually user should write the logging system in the way that all 'LogAction'+that populate and filter information should live in the application logger.+All loggers that do serialization and formatting should live in shared logger.+++If more concurrency is needed it's possible to build multilayer systems:+++@+  +-------------+                         +-------++  | application |---+                 +---| sink-1|+  +-------------+   |   +---------+   |   +-------++                    +---| logger  |---++                        +---------+   |   +-------++                                      +---| sink-2|+                                          +-------++@++In this approach application will be concurrently write logs to the logger, then+logger will be concurrently writing to all sinks.+-}++{- $simple-api++Simple API provides a handy easy to use API that can be used directly+in application without dealing with internals. Based on users feedback+internal implementation of the simple API may change, especially in early+versions of the library. But the guarantee that we give is that no matter+what implementation is it will be kept with reasonable defaults and will+be applicable to a generic application.+-}++{- | An exception safe way to create background logger.  This method will fork+a thread that will run 'shared worker', see schema above.++@Capacity@ - provides a backpressure mechanism and tells how many messages+in flight are allowed. In most cases 'defCapacity' will work well.+See 'forkBackgroundLogger' for more details.++@LogAction@ - provides a logger action, this action does not have access to the+application state or thread info, so you should only pass methods that serialize+and dump data there.++@+main :: IO ()+main =+  'withBackgroundLogger'+     'defCapacity'+     'Colog.Actions.logByteStringStdout'+     (\log -> 'Colog.Monad.usingLoggerT' log $ __do__+        'Colog.Monad.logMsg' \@ByteString "Starting application..."+        'Colog.Monad.logMsg' \@ByteString "Finishing application..."+     )+@+-}+withBackgroundLogger+    :: MonadIO m+    => Capacity  -- ^ Capacity of messages to handle; bounded channel size+    -> LogAction IO msg  -- ^ Action that will be used in a forked thread+    -> (LogAction m msg -> IO a)  -- ^ Continuation action+    -> IO a withBackgroundLogger cap logger action =    bracket (forkBackgroundLogger cap logger)            killBackgroundLogger@@ -176,51 +180,56 @@ defCapacity = Capacity 4096  --- $extended-api--- Extended API explains how asynchronous logging is working and provides basic--- building blocks for writing your own combinators. This is the part of the public--- API and will not change without prior notice.+{- $extended-api --- $background-worker--- The main abstraction for the concurrent worker is 'BackgroundWorker'. This--- is a wrapper of the thread, that has communication channel to talk to, and threadId.------ Background worker may provide a backpressure mechanism, but does not provide--- notification of completeness unless it's included in the message itself.+Extended API explains how asynchronous logging is working and provides basic+building blocks for writing your own combinators. This is the part of the public+API and will not change without prior notice.+-} +{- $background-worker+The main abstraction for the concurrent worker is 'BackgroundWorker'. This+is a wrapper of the thread, that has communication channel to talk to, and threadId. --- | Stop background logger thread.------ The thread is blocked until background thread will finish processing--- all messages that were written in the channel.+Background worker may provide a backpressure mechanism, but does not provide+notification of completeness unless it's included in the message itself.+-}++{- | Stop background logger thread.++The thread is blocked until background thread will finish processing+all messages that were written in the channel.+-} killBackgroundLogger :: BackgroundWorker msg -> IO () killBackgroundLogger bl = do   killThread (backgroundWorkerThreadId bl)   atomically $ readTVar (backgroundWorkerIsAlive bl) >>= check . not --- $background-logger------ Background logger is specialized version of the 'BackgroundWorker' process.--- Instead of running any job it will accept @msg@ type--- instead and process it with a single logger defined at creation time.+{- $background-logger --- | Creates background logger with given @Capacity@,--- takes a 'LogAction' that should describe how to write--- logs.------ @capacity@ - parameter tells how many in flight messages are allowed,--- if that value is reached then user's thread that emits logs will be--- blocked until any message will be written. Usually if value should be--- chosen reasonably high and if this value is reached it means that--- the application environment experience severe problems.------ __N.B.__ The 'LogAction' will be run in the background--- thread so that logger should not add any thread specific--- context to the message.------ __N.B.__ On exit, even in case of exception thread will dump all values--- that are in the queue. But it will stop doing that in case if another--- exception will happen.+Background logger is specialized version of the 'BackgroundWorker' process.+Instead of running any job it will accept @msg@ type+instead and process it with a single logger defined at creation time.+-}++{- | Creates background logger with given @Capacity@,+takes a 'LogAction' that should describe how to write+logs.++@capacity@ - parameter tells how many in flight messages are allowed,+if that value is reached then user's thread that emits logs will be+blocked until any message will be written. Usually if value should be+chosen reasonably high and if this value is reached it means that+the application environment experience severe problems.++__N.B.__ The 'LogAction' will be run in the background+thread so that logger should not add any thread specific+context to the message.++__N.B.__ On exit, even in case of exception thread will dump all values+that are in the queue. But it will stop doing that in case if another+exception will happen.+-} forkBackgroundLogger :: Capacity -> LogAction IO msg -> IO (BackgroundWorker msg) forkBackgroundLogger (Capacity cap) logAction = do   queue <- newTBQueueIO cap@@ -236,50 +245,54 @@   pure $ BackgroundWorker tid (writeTBQueue queue) isAlive  --- | Convert a given 'BackgroundWorker msg' into a 'LogAction msg'--- that will send log message to the background thread,--- without blocking the thread.------ If logger dies for any reason then thread that emits--- logs will receive 'BlockedIndefinitelyOnSTM' exception.------ You can extend result worker with all functionality available--- with co-log. This logger will have an access to the thread--- state.+{- | Convert a given 'BackgroundWorker msg' into a 'LogAction msg'+that will send log message to the background thread,+without blocking the thread.++If logger dies for any reason then thread that emits+logs will receive 'BlockedIndefinitelyOnSTM' exception.++You can extend result worker with all functionality available+with co-log. This logger will have an access to the thread+state.+-} convertToLogAction :: MonadIO m => BackgroundWorker msg -> LogAction m msg convertToLogAction logger = LogAction $ \msg ->   liftIO $ atomically $ backgroundWorkerWrite logger msg --- $worker-thread--- While generic background logger is enough for the most--- of the usecases, sometimes you may want even more.------ There are at least two cases where that may happen:------   1. You need to modify logger, for example different---   threads wants to write to different sources. Or you---   want to change lgo mechanism in runtime.------   2. You may want to implement some notification---   machinery that allows you to guarantee that your---   logs were written before processing further.------ In order to solve those problems worker thread abstraction--- was introduced. This is a worker that accepts any action--- and performs that.+{- $worker-thread --- | Create a background worker with a given capacity.--- If capacity is reached, then the thread that tries to--- write logs will be blocked.------ This method is more generic than 'forkBackgroundLogger' but--- it's less effective, as you have to pass entire closure to--- be run and that leads to extra memory usage and indirect calls--- happening.------ When closed it will dump all pending messages, unless--- another asynchronous exception will arrive, or synchronous--- exception will happen during the logging.+While generic background logger is enough for the most+of the usecases, sometimes you may want even more.++There are at least two cases where that may happen:++  1. You need to modify logger, for example different+  threads wants to write to different sources. Or you+  want to change lgo mechanism in runtime.++  2. You may want to implement some notification+  machinery that allows you to guarantee that your+  logs were written before processing further.++In order to solve those problems worker thread abstraction+was introduced. This is a worker that accepts any action+and performs that.+-}++{- | Create a background worker with a given capacity.+If capacity is reached, then the thread that tries to+write logs will be blocked.++This method is more generic than 'forkBackgroundLogger' but+it's less effective, as you have to pass entire closure to+be run and that leads to extra memory usage and indirect calls+happening.++When closed it will dump all pending messages, unless+another asynchronous exception will arrive, or synchronous+exception will happen during the logging.+-} mkBackgroundThread :: Capacity -> IO (BackgroundWorker (IO ())) mkBackgroundThread (Capacity cap) = do   queue <- newTBQueueIO cap@@ -291,39 +304,40 @@        `finally` atomically (writeTVar isAlive False))   pure $ BackgroundWorker tid (writeTBQueue queue) isAlive --- | Run logger action asynchronously in the worker thread.--- Logger is executed in the other thread entirely, so if--- logger takes any thread related context it will be--- read from the other thread.+{- | Run logger action asynchronously in the worker thread.+Logger is executed in the other thread entirely, so if+logger takes any thread related context it will be+read from the other thread.+-} runInBackgroundThread :: BackgroundWorker (IO ()) -> LogAction IO msg -> LogAction IO msg runInBackgroundThread bt logAction = LogAction $ \msg ->   atomically $ backgroundWorkerWrite bt $ unLogAction logAction msg --- $worker-thread-usage------ Consider following example. (Leaving resource control aside).------ @--- data M msg = M (MVar ()) msg------ notificationLogger :: MonadIO m => LoggerAction m msg -> LoggerAction m (M msg)--- notificationLogger logger = 'LoggerAction' $ \(M lock msg) ->---    (unLogger logger msg) `finally` (putMVar lock ())------ example = __do__---    worker <- 'mkBackgroundWorker' 'defCapacity'---    lock <- newEmptyMVar---    -- Log message with default logger.---    'unLogger'---       ('runInBackgroundThread' worker---       (notificationLogger $ 'Colog.Action.withLogByteStringFile' "\/var\/log\/myapp\/log")---       (M lock "my message")---    -- Log message with a different logger.---    'unLogger'---       ('runInBackgroundThread' worker---       ('Colog.Action.withLogByteStringFile' "/var/log/myapp/log")---       ("another message")---    -- Block until first message is logged.---    _ <- takeMVar lock--- @---+{- $worker-thread-usage++Consider following example. (Leaving resource control aside).++@+data M msg = M (MVar ()) msg++notificationLogger :: MonadIO m => LoggerAction m msg -> LoggerAction m (M msg)+notificationLogger logger = 'LogAction' $ \(M lock msg) ->+   (unLogger logger msg) `finally` (putMVar lock ())++example = __do__+   worker <- 'mkBackgroundThread' 'defCapacity'+   lock <- newEmptyMVar+   -- Log message with default logger.+   'unLogger'+      ('runInBackgroundThread' worker+      (notificationLogger $ 'Colog.Action.withLogByteStringFile' "\/var\/log\/myapp\/log")+      (M lock "my message")+   -- Log message with a different logger.+   'unLogger'+      ('runInBackgroundThread' worker+      ('Colog.Action.withLogByteStringFile' "/var/log/myapp/log")+      ("another message")+   -- Block until first message is logged.+   _ <- takeMVar lock+@+-}

@@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-}  {- |-Copyright:  (c) 2018-2019 Kowainik-License:    MPL-2.0+Copyright:  (c) 2018-2020 Kowainik+SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik <xrom.xkov@gmail.com>  __NOTE:__ Many thanks to Alexander Vershilov for the implementation.@@ -20,16 +20,19 @@ import Control.Concurrent.STM (STM, TVar) import Numeric.Natural (Natural) --- | A wrapper type that carries capacity. The internal--- type may be differrent for the different GHC versions.++{- | A wrapper type that carries capacity. The internal type may be+differrent for the different GHC versions.+-} #if MIN_VERSION_stm(2,5,0) newtype Capacity = Capacity Natural #else newtype Capacity = Capacity Int #endif --- | Wrapper for the background thread that may--- receive messages to process.+{- | Wrapper for the background thread that may receive messages to+process.+-} data BackgroundWorker msg = BackgroundWorker     { backgroundWorkerThreadId :: !ThreadId       -- ^ Background 'ThreadId'.

@@ -3,8 +3,8 @@ {-# LANGUAGE CPP #-}  {- |-Copyright:  (c) 2018-2019 Kowainik-License:    MPL-2.0+Copyright:  (c) 2018-2020 Kowainik+SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik <xrom.xkov@gmail.com>  This module contains 'LogAction' orphan instances of @contravariant@ classes.

@@ -1,5 +1,6 @@ {-# LANGUAGE CPP                   #-} {-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveFunctor         #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE GADTs                 #-}@@ -8,8 +9,8 @@ {-# LANGUAGE TypeFamilies          #-}  {- |-Copyright:  (c) 2018-2019 Kowainik-License:    MPL-2.0+Copyright:  (c) 2018-2020 Kowainik+SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik <xrom.xkov@gmail.com>  This module contains logging messages data types along with the formatting and@@ -17,17 +18,27 @@ -}  module Colog.Message-       ( -- * Basic message type-         Msg (..)+       ( -- * Simple message type+         -- ** Type+         SimpleMsg (..)+         -- ** Logging+       , logText+         -- ** Formatting+       , fmtSimpleMessage+       , formatWith++         -- * Core messaging+         -- ** Types+       , Msg (..)        , Message+         -- ** Logging        , log        , logDebug        , logInfo        , logWarning        , logError        , logException--         -- * Formatting functions+         -- ** Formatting        , fmtMessage        , showSeverity        , showSourceLoc@@ -42,8 +53,12 @@        , FieldMap        , defaultFieldMap -       , RichMessage (..)+         -- ** Extensible message+       , RichMessage+       , RichMsg (..)        , fmtRichMessageDefault+       , fmtSimpleRichMessageDefault+       , fmtRichMessageCustomDefault        , upgradeMessageAction        ) where @@ -68,9 +83,12 @@ import Colog.Monad (WithLog, logMsg)  import qualified Chronos as C+import qualified Chronos.Locale.English as C import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as TB+import qualified Data.Text.Lazy.Builder.Int as TB import qualified Data.TypeRepMap as TM+import qualified Data.Vector as Vector  ---------------------------------------------------------------------------- -- Plain message@@ -90,6 +108,16 @@     , msgText     :: !Text     } +{- | Message data type without 'Severity'. Use 'logText' to log+messages of this type.++@since 0.4.0.0+-}+data SimpleMsg = SimpleMsg+    { simpleMsgStack :: !CallStack+    , simpleMsgText  :: !Text+    }+ {- | 'Msg' parametrized by the 'Severity' type. Most formatting functions in this module work with 'Severity' from @co-log-core@. -}@@ -116,10 +144,18 @@ logError :: WithLog env Message m => Text -> m () logError = withFrozenCallStack (log Error) --- | Logs 'Exception' message.+-- | Logs 'Exception' message with the 'Error' severity. logException :: forall e m env . (WithLog env Message m, Exception e) => e -> m () logException = withFrozenCallStack (logError . T.pack . displayException) +{- | Log 'SimpleMsg' without severity, only 'CallStack' and 'Text'+body message.++@since 0.4.0.0+-}+logText :: WithLog env SimpleMsg m => Text -> m ()+logText msgText = withFrozenCallStack (logMsg SimpleMsg{ simpleMsgStack = callStack, simpleMsgText = msgText })+ {- | Formats the 'Message' type in according to the following format:  @@@ -141,6 +177,45 @@     <> showSourceLoc msgStack     <> msgText +{- | Formats the 'SimpleMsg' type in according to the following format:++@+[SourceLocation] \<Text message\>+@++__Examples:__++@+[Main.app#39] Starting application...+[Main.example#34] app: First message...+@++See 'fmtSimpleRichMessageDefault' for richer format.++@since 0.4.0.0+-}+fmtSimpleMessage :: SimpleMsg -> Text+fmtSimpleMessage SimpleMsg{..} = showSourceLoc simpleMsgStack <> simpleMsgText++{- | Alias for 'cmap' specialized for formatting purposes. If you have+an action that can output 'Text' (for example+'Colog.Actions.logTextStdout'), you can convert it to the action that+can print 'SimpleMsg' or 'Message':++@+logSimpleMsgStdout :: 'LogAction' 'IO' 'SimpleMsg'+logSimpleMsgStdout = 'formatWith' 'fmtSimpleMessage' 'Colog.Actions.logTextStdout'++logMessageStdout :: 'LogAction' 'IO' 'Message'+logMessageStdout = 'formatWith' 'fmtMessage' 'Colog.Actions.logTextStdout'+@++@since 0.4.0.0+-}+formatWith :: (msg -> Text) -> LogAction m Text -> LogAction m msg+formatWith = cmap+{-# INLINE formatWith #-}+ {- | Formats severity in different colours with alignment. -} showSeverity :: Severity -> Text@@ -186,8 +261,8 @@ types. The type family is open so you can add new instances. -} type family FieldType (fieldName :: Symbol) :: Type-type instance FieldType "threadId" = ThreadId-type instance FieldType "posixTime"  = C.Time+type instance FieldType "threadId"  = ThreadId+type instance FieldType "posixTime" = C.Time  {- | @newtype@ wrapper. Stores monadic ability to extract value of 'FieldType'. @@ -261,12 +336,18 @@     , #posixTime (liftIO C.now)     ] --- | Contains additional data to 'Message' to display more verbose information.-data RichMessage (m :: Type -> Type) = RichMessage-    { richMessageMsg :: {-# UNPACK #-} !Message-    , richMessageMap :: {-# UNPACK #-} !(FieldMap m)-    }+{- | Contains additional data to 'Message' to display more verbose information. +@since 0.4.0.0+-}+data RichMsg (m :: Type -> Type) (msg :: Type) = RichMsg+    { richMsgMsg :: !msg+    , richMsgMap :: {-# UNPACK #-} !(FieldMap m)+    } deriving stock (Functor)++-- | Specialised version of 'RichMsg' that stores severity, callstack and text message.+type RichMessage m = RichMsg m Message+ {- | Formats 'RichMessage' in the following way:  @@@ -276,17 +357,14 @@ __Examples:__  @-[Debug]   [03 05 2019 05:23:19.058] [Main.example#34] [ThreadId 11] app: First message...-[Info]    [03 05 2019 05:23:19.059] [Main.example#35] [ThreadId 11] app: Second message...+[Debug]   [03 May 2019 05:23:19.058 +00:00] [Main.example#34] [ThreadId 11] app: First message...+[Info]    [03 May 2019 05:23:19.059 +00:00] [Main.example#35] [ThreadId 11] app: Second message... @  See 'fmtMessage' if you don't need both time and thread id. -} fmtRichMessageDefault :: MonadIO m => RichMessage m -> m Text-fmtRichMessageDefault RichMessage{..} = do-    maybeThreadId  <- extractField $ TM.lookup @"threadId"  richMessageMap-    maybePosixTime <- extractField $ TM.lookup @"posixTime" richMessageMap-    pure $ formatRichMessage maybeThreadId maybePosixTime richMessageMsg+fmtRichMessageDefault msg = fmtRichMessageCustomDefault msg formatRichMessage   where     formatRichMessage :: Maybe ThreadId -> Maybe C.Time -> Message -> Text     formatRichMessage (maybe "" showThreadId -> thread) (maybe "" showTime -> time) Msg{..} =@@ -296,27 +374,133 @@      <> thread      <> msgText -    showTime :: C.Time -> Text-    showTime t =-        square-        $ toStrict-        $ TB.toLazyText-        $ C.builder_DmyHMS timePrecision datetimeFormat (C.timeToDatetime t)-      where-        timePrecision = C.SubsecondPrecisionFixed 3-        datetimeFormat = C.DatetimeFormat (Just '-') (Just ' ') (Just ':')+{- | Formats 'RichMessage' in the following way: -    showThreadId :: ThreadId -> Text-    showThreadId = square . T.pack . show+@+[Time] [SourceLocation] [ThreadId] \<Text message\>+@ +__Examples:__++@+[03 May 2019 05:23:19.058 +00:00] [Main.example#34] [ThreadId 11] app: First message...+[03 May 2019 05:23:19.059 +00:00] [Main.example#35] [ThreadId 11] app: Second message...+@++Practically, it formats a message as 'fmtRichMessageDefault' without the severity information.++@since 0.4.0.0+-}+fmtSimpleRichMessageDefault :: MonadIO m => RichMsg m SimpleMsg -> m Text+fmtSimpleRichMessageDefault msg = fmtRichMessageCustomDefault msg formatRichMessage+  where+    formatRichMessage :: Maybe ThreadId -> Maybe C.Time -> SimpleMsg -> Text+    formatRichMessage (maybe "" showThreadId -> thread) (maybe "" showTime -> time) SimpleMsg{..} =+        time+     <> showSourceLoc simpleMsgStack+     <> thread+     <> simpleMsgText+{- | Custom formatting function for 'RichMsg'. It extracts 'ThreadId'+and 'C.Time' from fields and allows you to specify how to format them.++@since 0.4.0.0+-}+fmtRichMessageCustomDefault+    :: MonadIO m+    => RichMsg m msg+    -> (Maybe ThreadId -> Maybe C.Time -> msg -> Text)+    -> m Text+fmtRichMessageCustomDefault RichMsg{..} formatter = do+    maybeThreadId  <- extractField $ TM.lookup @"threadId"  richMsgMap+    maybePosixTime <- extractField $ TM.lookup @"posixTime" richMsgMap+    pure $ formatter maybeThreadId maybePosixTime richMsgMsg++{- | Shows time in the following format:++>>> showTime $ C.Time 1577656800+[29 Dec 2019 22:00:00.000 +00:00]+-}+showTime :: C.Time -> Text+showTime t =+    square+    $ toStrict+    $ TB.toLazyText+    $ builderDmyHMSz (C.timeToDatetime t)++----------------------------------------------------------------------------+-- Chronos extra+----------------------------------------------------------------------------++{- | Given a 'Datetime', construct a 'Text' 'TB.Builder' corresponding to a+Day\/Month\/Year,Hour\/Minute\/Second\/Offset encoding of the given 'Datetime'.++Example: @29 Dec 2019 22:00:00.000 +00:00@+-}+builderDmyHMSz :: C.Datetime -> TB.Builder+builderDmyHMSz (C.Datetime date time) =+       builderDmy date+    <> spaceSep+    <> C.builder_HMS (C.SubsecondPrecisionFixed 3) (Just ':') time+    <> spaceSep+    <> C.builderOffset C.OffsetFormatColonOn (C.Offset 0)+  where+    spaceSep :: TB.Builder+    spaceSep = TB.singleton ' '++    {- | Given a 'Date' construct a 'Text' 'TB.Builder'+    corresponding to a Day\/Month\/Year encoding.++    Example: @01 Jan 2020@+    -}+    builderDmy :: C.Date -> TB.Builder+    builderDmy (C.Date (C.Year y) m d) =+           zeroPadDayOfMonth d+        <> spaceSep+        <> TB.fromText (C.caseMonth C.abbreviated m)+        <> spaceSep+        <> TB.decimal y+++    zeroPadDayOfMonth :: C.DayOfMonth -> TB.Builder+    zeroPadDayOfMonth (C.DayOfMonth d) =+        if d < 100+        then Vector.unsafeIndex twoDigitTextBuilder d+        else TB.decimal d++    twoDigitTextBuilder :: Vector.Vector TB.Builder+    twoDigitTextBuilder = Vector.fromList $+        map (TB.fromText . T.pack) twoDigitStrings+    {-# NOINLINE twoDigitTextBuilder #-}++    twoDigitStrings :: [String]+    twoDigitStrings =+        [ "00","01","02","03","04","05","06","07","08","09"+        , "10","11","12","13","14","15","16","17","18","19"+        , "20","21","22","23","24","25","26","27","28","29"+        , "30","31","32","33","34","35","36","37","38","39"+        , "40","41","42","43","44","45","46","47","48","49"+        , "50","51","52","53","54","55","56","57","58","59"+        , "60","61","62","63","64","65","66","67","68","69"+        , "70","71","72","73","74","75","76","77","78","79"+        , "80","81","82","83","84","85","86","87","88","89"+        , "90","91","92","93","94","95","96","97","98","99"+        ]++----------------------------------------------------------------------------+-- Utility functions+----------------------------------------------------------------------------++showThreadId :: ThreadId -> Text+showThreadId = square . T.pack . show+ {- | Allows to extend basic 'Message' type with given dependent map of fields. -} upgradeMessageAction-    :: forall m .+    :: forall m msg .        FieldMap m-    -> LogAction m (RichMessage m)-    -> LogAction m Message+    -> LogAction m (RichMsg m msg)+    -> LogAction m msg upgradeMessageAction fieldMap = cmap addMap   where-    addMap :: Message -> RichMessage m-    addMap msg = RichMessage msg fieldMap+    addMap :: msg -> RichMsg m msg+    addMap msg = RichMsg msg fieldMap

@@ -1,8 +1,8 @@ {-# LANGUAGE InstanceSigs #-}  {- |-Copyright:  (c) 2018-2019 Kowainik-License:    MPL-2.0+Copyright:  (c) 2018-2020 Kowainik+SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik <xrom.xkov@gmail.com>  Core of the @mtl@ implementation.@@ -26,19 +26,31 @@ import Data.Foldable (traverse_) import GHC.Stack (HasCallStack) -import Colog.Core (HasLog (..), LogAction (..), overLogAction)+import Colog.Core (HasLog (..), LogAction (..), overLogAction, hoistLogAction) + {- | @newtype@ wrapper 'ReaderT' that keeps 'LogAction' in its context. -} newtype LoggerT msg m a = LoggerT     { runLoggerT :: ReaderT (LogAction (LoggerT msg m) msg) m a-    } deriving (Functor, Applicative, Monad, MonadIO, MonadReader (LogAction (LoggerT msg m) msg))+    } deriving newtype ( Functor, Applicative, Monad, MonadIO+                       , MonadReader (LogAction (LoggerT msg m) msg)+                       )  instance MonadTrans (LoggerT msg) where     lift :: Monad m => m a -> LoggerT msg m a     lift = LoggerT . lift     {-# INLINE lift #-} +{- | Type alias for constraint for:++1. Monad @m@ have access to environment @env@.+2. Environment @env@ contains 'LogAction' that can log messages of type @msg@.+3. Function call stack.++If you use this constraint, function call stack will be propagated and+you will have access to code lines that log messages.+-} type WithLog env msg m = (MonadReader env m, HasLog env msg m, HasCallStack)  {- | Perform logging action with given message @msg@. This function works for@@ -77,8 +89,10 @@ withLog = local . overLogAction {-# INLINE withLog #-} +{- | Lifts 'LogAction' by allowing to log in a transformed monad.+-} liftLogAction :: (Monad m, MonadTrans t) => LogAction m msg -> LogAction (t m) msg-liftLogAction (LogAction action) = LogAction (lift . action)+liftLogAction = hoistLogAction lift {-# INLINE liftLogAction #-}  {- | Runner for 'LoggerT' monad. Let's consider one simple example of monadic@@ -109,3 +123,4 @@ -} usingLoggerT :: Monad m => LogAction m msg -> LoggerT msg m a -> m a usingLoggerT action = flip runReaderT (liftLogAction action) . runLoggerT+{-# INLINE usingLoggerT #-}

@@ -1,6 +1,6 @@ {- |-Copyright:  (c) 2018-2019 Kowainik-License:    MPL-2.0+Copyright:  (c) 2018-2020 Kowainik+SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik <xrom.xkov@gmail.com>  Pure implementation of logging action.@@ -31,7 +31,7 @@ -} newtype PureLoggerT msg m a = PureLoggerT     { runPureLoggerT :: StateT (Seq msg) m a-    } deriving (Functor, Applicative, Monad, MonadTrans, MonadState (Seq msg))+    } deriving newtype (Functor, Applicative, Monad, MonadTrans, MonadState (Seq msg))  -- | Returns result value of 'PureLoggerT' and list of logged messages. runPureLogT :: Functor m => PureLoggerT msg m a -> m (a, [msg])

@@ -1,6 +1,6 @@ {- |-Copyright:  (c) 2018-2019 Kowainik-License:    MPL-2.0+Copyright:  (c) 2018-2020 Kowainik+SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik <xrom.xkov@gmail.com> Stability:  experimental @@ -18,6 +18,7 @@ import Control.Monad (when, (>=>)) import Control.Monad.IO.Class (MonadIO (..)) import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.List (isPrefixOf) import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe, mapMaybe) import Numeric.Natural (Natural)@@ -37,7 +38,10 @@ 1. Limit the number of kept files. 2. Limit the size of the files. -}-data Limit = LimitTo Natural | Unlimited deriving (Eq, Ord)+data Limit+    = LimitTo Natural+    | Unlimited+    deriving stock (Eq, Ord, Show)  {- | Logger rotation action. Takes name of the logging file @file.foo@. Always writes new logs to file named @file.foo@ (given file name, also called as /hot log/).@@ -96,7 +100,7 @@ isLimitedBy _ Unlimited = False isLimitedBy size (LimitTo limit)   | size <= 0 = False-  | otherwise = toInteger limit > size+  | otherwise = size > toInteger limit  isFileSizeLimitReached :: forall m . MonadIO m => Limit -> Handle -> m Bool isFileSizeLimitReached limit handle = liftIO $ do@@ -108,35 +112,38 @@ maxFileIndex :: FilePath -> IO Natural maxFileIndex path = do   files <- D.listDirectory (POS.takeDirectory path)-  let logFiles = filter (== POS.takeBaseName path) files+  let logFiles = getLogFiles path files   let maxFile = maximum <$> nonEmpty (mapMaybe logFileIndex logFiles)   pure $ fromMaybe 0 maxFile +getLogFiles :: FilePath -> [FilePath] -> [FilePath]+getLogFiles logPath = filter (\p -> POS.takeFileName logPath `isPrefixOf` POS.takeFileName p)+ -- given number 4 and path `node.log` renames file `node.log` to `node.log.4` renameFileToNumber :: Natural -> FilePath -> IO () renameFileToNumber n path = D.renameFile path (path <.> show n)  -- if you give it name like `node.log.4` then it returns `Just 4` logFileIndex :: FilePath -> Maybe Natural-logFileIndex path =-    nonEmpty (POS.takeExtension path) >>= readMaybe . NE.tail+logFileIndex path = fmap NE.tail (nonEmpty (POS.takeExtension path)) >>= readMaybe  -- creates list of files with indices who are older on given Limit than the latest one getOldFiles :: Limit -> FilePath -> IO [FilePath] getOldFiles limit path = do     currentMaxN <- maxFileIndex path     files <- D.listDirectory (POS.takeDirectory path)-    pure $ mapMaybe (takeFileIndex >=> guardFileIndex currentMaxN) files+    let logFiles = getLogFiles path files+    pure $ mapMaybe (takeFileIndex >=> guardFileIndex currentMaxN) logFiles   where     takeFileIndex  :: FilePath -> Maybe (FilePath, Natural)-    takeFileIndex p = (p,) <$> logFileIndex path+    takeFileIndex p = fmap (p,) (logFileIndex p)      guardFileIndex :: Natural -> (FilePath, Natural) -> Maybe FilePath     guardFileIndex maxN (p, n)-      | isOldFile maxN n = Nothing-      | otherwise       = Just p+      | isOldFile maxN n = Just p+      | otherwise       = Nothing      isOldFile :: Natural -> Natural -> Bool     isOldFile maxN n = case limit of                          Unlimited -> False-                         LimitTo l -> n < maxN - l+                         LimitTo l -> n + l < maxN

@@ -18,7 +18,8 @@  data LogAST     = LogMsg-    | AND LogAST LogAST deriving Show+    | AND LogAST LogAST+    deriving stock (Show)  listLogMessages :: LogAST -> String -> [String] listLogMessages LogMsg msg    = [msg]

@@ -15,6 +15,7 @@ extensions and imports up front.  ```haskell+{-# LANGUAGE DerivingStrategies    #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE InstanceSigs          #-}@@ -78,7 +79,7 @@ ```haskell newtype App a = App     { unApp :: ReaderT (Env App) IO a-    } deriving (Functor, Applicative, Monad, MonadIO, MonadReader (Env App))+    } deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader (Env App)) ```  This monad stores `Env` parameterized by the monad itself in it's context.@@ -132,4 +133,4 @@  And the output will look like this: -![Output example](https://user-images.githubusercontent.com/4276606/57193360-c001b800-6f6c-11e9-9f0a-6027eda3aa37.png)+![co-log output example](https://user-images.githubusercontent.com/8126674/71579355-1b804780-2af4-11ea-97eb-3f220011fd8d.png)

@@ -0,0 +1,28 @@+{- | The purpose of this module is to check concurrent abilities of @colog@.+-}+module Main (main) where++import Control.Concurrent (forkIO, threadDelay)+import Control.Monad (forM_, replicateM_, void)+import Data.ByteString (ByteString)+import Data.ByteString.Char8 (pack)+import Data.Semigroup ((<>))+import Prelude hiding (log)++import Colog (LogAction, logByteStringStderr, logByteStringStdout, (<&))+++{- | Action that prints predefined message 5 times.+-}+action :: LogAction IO ByteString -> ByteString -> IO ()+action log msg = replicateM_ 5 $ log <& msg++{- | Checks @colog@ for interleaved output. Forks 10 threads, each of them runs+'action'.+-}+main :: IO ()+main = do+    forM_ [1..10 :: Int] $ \i -> do+        let log = if even i then logByteStringStdout else logByteStringStderr+        void $ forkIO $ action log $ "Logging from thread: " <> pack (show i)+    threadDelay $ 3 * (10 ^ (6 :: Int)) -- wait 3 seconds

@@ -21,19 +21,26 @@ import Control.Monad.Reader (MonadReader, ReaderT (..)) import Data.Semigroup ((<>)) -import Colog (pattern D, HasLog (..), LogAction, Message, Msg (..), PureLogger, WithLog, cmap,-              cmapM, defaultFieldMap, fmtMessage, fmtRichMessageDefault, liftLogIO, log,-              logException, logInfo, logMessagePure, logMsg, logMsgs, logPrint, logStringStdout,+import Colog (pattern D, HasLog (..), LogAction, Message, Msg (..), PureLogger, RichMsg (..),+              SimpleMsg (..), WithLog, cmap, cmapM, defaultFieldMap, fmtMessage,+              fmtRichMessageDefault, fmtSimpleRichMessageDefault, liftLogIO, log, logException,+              logInfo, logMessagePure, logMsg, logMsgs, logPrint, logStringStdout, logText,               logTextStderr, logTextStdout, logWarning, runPureLog, upgradeMessageAction,               usingLoggerT, withLog, withLogTextFile, (*<), (<&), (>$), (>$<), (>*), (>*<), (>|<))  import qualified Data.TypeRepMap as TM + example :: WithLog env Message m => m () example = do     log D "First message..."     logInfo "Second message..." +simpleApp :: (MonadIO m, WithLog env SimpleMsg m) => m ()+simpleApp = do+    logText "First simple message"+    logText "Second simple message"+ app :: (WithLog env Message m, MonadIO m) => m () app = do     logWarning "Starting application..."@@ -49,7 +56,8 @@   data ExampleException = ExampleException-    deriving (Show, Exception)+    deriving stock (Show)+    deriving anyclass (Exception)  exceptionL :: (WithLog env Message m) => m () exceptionL = logException ExampleException@@ -160,15 +168,24 @@ ----------------------------------------------------------------------------  main :: IO ()-main = withLogTextFile "co-log/example/example.log" $ \logTextFile -> do+main = withLogTextFile "co-log/tutorials/example.log" $ \logTextFile -> do     let runApp :: LogAction IO Message -> IO ()         runApp action = usingLoggerT action app +    let runSimpleApp :: LogAction IO SimpleMsg -> IO ()+        runSimpleApp action = usingLoggerT action simpleApp+     let textAction = logTextStdout <> logTextStderr <> logTextFile      let simpleMessageAction = cmap  fmtMessage            textAction     let richMessageAction   = cmapM fmtRichMessageDefault textAction +    let richSimpleAction :: LogAction IO (RichMsg IO SimpleMsg)+        richSimpleAction = cmapM fmtSimpleRichMessageDefault textAction++    let simpleAction :: LogAction IO SimpleMsg+        simpleAction = upgradeMessageAction defaultFieldMap richSimpleAction+     let fullMessageAction = upgradeMessageAction defaultFieldMap richMessageAction     let semiMessageAction = upgradeMessageAction                                 (TM.delete @"threadId" defaultFieldMap)@@ -177,6 +194,8 @@     runApp simpleMessageAction     runApp fullMessageAction     runApp semiMessageAction++    runSimpleApp simpleAction      usingLoggerT carL $ logMsg $ Car "Toyota" "Corolla" (Pistons 4)