diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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): diff --git a/co-log.cabal b/co-log.cabal --- a/co-log.cabal +++ b/co-log.cabal @@ -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 -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 diff --git a/src/Colog.hs b/src/Colog.hs --- a/src/Colog.hs +++ b/src/Colog.hs @@ -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 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 diff --git a/src/Colog/Actions.hs b/src/Colog/Actions.hs --- a/src/Colog/Actions.hs +++ b/src/Colog/Actions.hs @@ -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 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'. diff --git a/src/Colog/Concurrent.hs b/src/Colog/Concurrent.hs --- a/src/Colog/Concurrent.hs +++ b/src/Colog/Concurrent.hs @@ -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 __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 +@ +-} diff --git a/src/Colog/Concurrent/Internal.hs b/src/Colog/Concurrent/Internal.hs --- a/src/Colog/Concurrent/Internal.hs +++ b/src/Colog/Concurrent/Internal.hs @@ -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 __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'. diff --git a/src/Colog/Contra.hs b/src/Colog/Contra.hs --- a/src/Colog/Contra.hs +++ b/src/Colog/Contra.hs @@ -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 This module contains 'LogAction' orphan instances of @contravariant@ classes. diff --git a/src/Colog/Message.hs b/src/Colog/Message.hs --- a/src/Colog/Message.hs +++ b/src/Colog/Message.hs @@ -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 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] \ +@ + +__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] \ +@ +__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 diff --git a/src/Colog/Monad.hs b/src/Colog/Monad.hs --- a/src/Colog/Monad.hs +++ b/src/Colog/Monad.hs @@ -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 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 #-} diff --git a/src/Colog/Pure.hs b/src/Colog/Pure.hs --- a/src/Colog/Pure.hs +++ b/src/Colog/Pure.hs @@ -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 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]) diff --git a/src/Colog/Rotation.hs b/src/Colog/Rotation.hs --- a/src/Colog/Rotation.hs +++ b/src/Colog/Rotation.hs @@ -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 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 diff --git a/test/Property.hs b/test/Property.hs --- a/test/Property.hs +++ b/test/Property.hs @@ -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] diff --git a/tutorials/2-custom/Custom.lhs b/tutorials/2-custom/Custom.lhs --- a/tutorials/2-custom/Custom.lhs +++ b/tutorials/2-custom/Custom.lhs @@ -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) diff --git a/tutorials/Concurrent.hs b/tutorials/Concurrent.hs new file mode 100644 --- /dev/null +++ b/tutorials/Concurrent.hs @@ -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 diff --git a/tutorials/Main.hs b/tutorials/Main.hs --- a/tutorials/Main.hs +++ b/tutorials/Main.hs @@ -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)