diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,25 @@ `co-log` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.5.0.0 - Nov 2, 2022 + +* [#230](https://github.com/kowainik/co-log/issues/230): + Support GHC-9.2. +* Allow `mtl-2.3`. +* Allow `vector-0.13`. +* Allow `hedgehog-1.2`. +* [#187](https://github.com/kowainik/co-log/issues/187): + Remove `CoLog.Concurrent` module and executable. +* [#243](https://github.com/kowainik/co-log/pull/243): + Improve printing in multiple threads. +* Drop support for GHC-8.2, GHC-8.4, GHC-8.6, GHC-8.8 + +## 0.4.0.2 — , 2021 + +* [#223](https://github.com/kowainik/co-log/pulls/223): + Support GHC-9.0.1. + Require typerep-map ^>= 0.4 + ## 0.4.0.1 — Apr 18, 2020 * [#186](https://github.com/kowainik/co-log/issues/186): diff --git a/README.lhs b/README.lhs --- a/README.lhs +++ b/README.lhs @@ -1,23 +1,53 @@ # co-log -[![Hackage](https://img.shields.io/hackage/v/co-log.svg)](https://hackage.haskell.org/package/co-log) -[![Stackage LTS](http://stackage.org/package/co-log/badge/lts)](http://stackage.org/lts/package/co-log) -[![Stackage Nightly](http://stackage.org/package/co-log/badge/nightly)](http://stackage.org/nightly/package/co-log) -[![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](https://github.com/kowainik/co-log/blob/master/LICENSE) -[![Build status](https://secure.travis-ci.org/kowainik/co-log.svg)](https://travis-ci.org/kowainik/co-log) +![Co-logo](https://user-images.githubusercontent.com/8126674/80955687-92f21a80-8df7-11ea-90d3-422dafdc8391.png) +[![GitHub CI](https://github.com/kowainik/co-log/workflows/CI/badge.svg)](https://github.com/kowainik/co-log/actions) +[![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](https://github.com/kowainik/co-log/blob/main/LICENSE) -Logging library based on [`co-log-core`](../co-log-core) package. Provides -ready-to-go implementation of logging. This README contains _How to_ tutorial on -using this library. This tutorial explains step by step how to integrate -`co-log` into small basic project, specifically how to replace `putStrLn` used -for logging with library provided logging. +`co-log` is a composable and configurable logging framework. It +combines all the benefits of Haskell idioms to provide a reasonable +and convenient interface. Although the library design uses some advanced +concepts in its core, we are striving to provide beginner-friendly API. The +library also provides the complete documentation with a lot of beginner-friendly +examples, explanations and tutorials to guide users. The combination of a +pragmatic approach to logging and fundamental Haskell abstractions allows us to +create a highly composable and configurable logging framework. +If you're interested in how different Haskell typeclasses are used to +implement core functions of `co-log`, you can read the following blog +post which goes into detail about the internal implementation specifics: + +* [co-log: Composable Contravariant Combinatorial Comonadic Configurable Convenient Logging](https://kowainik.github.io/posts/2018-09-25-co-log) + +## Co-Log Family + +Co-Log is a family of repositories for a composable and configurable logging +framework `co-log`. + +Here is the list of currently available repositories and libraries that you can +check out: + +| | | | +| :---------------------------------------------------------------- | :----------------------------------------------------------------------------------------------------------------------------------------------------- | :--------------------------------- | +| [`co-log-core`](https://github.com/co-log/co-log-core) | lightweight package with basic data types and general idea which depends only on `base` | [![Hackage][hk-img-core]][hk-core] | +| [`co-log`](https://github.com/co-log/co-log) | taggless final implementation of logging library based on `co-log-core` | [![Hackage][hk-img]][hk] | +| [`co-log-polysemy`](https://github.com/co-log/co-log-polysemy) | implementation of logging library based on `co-log-core` and the [`polysemy`](http://hackage.haskell.org/package/polysemy) extensible effects library. | [![Hackage][hk-img-ps]][hk-ps] | +| [`co-log-benchmarks`](https://github.com/co-log/co-log-benchmarks) | benchmarks of the `co-log` library | - + +## `co-log` library + +Logging library based on [`co-log-core`](https://github.com/co-log/co-log-core) +package. Provides ready-to-go implementation of logging. This README contains +_How to_ tutorial on using this library. This tutorial explains step by step how +to integrate `co-log` into small basic project, specifically how to replace +`putStrLn` used for logging with library provided logging. + All code below can be compiled and run with the following commands: ```shell -$ cabal new-build co-log -$ cabal new-exec readme +$ cabal build +$ cabal exec readme ``` ## Preamble: imports and language extensions @@ -29,14 +59,13 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +import Control.Monad.IO.Class (MonadIO, liftIO) + import Colog (Message, WithLog, cmap, fmtMessage, logDebug, logInfo, logTextStdout, logWarning, usingLoggerT) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Semigroup ((<>)) import qualified Data.Text as Text import qualified Data.Text.IO as TextIO - ``` ## Simple IO function example @@ -103,3 +132,25 @@ And here is how output looks like: ![screenshot from 2018-09-17 20-52-01](https://user-images.githubusercontent.com/4276606/45623973-8bafb900-babb-11e8-9e20-4369a5a8e5ff.png) + +## More Tutorials + +To provide a more user-friendly introduction to the library, we've +created the tutorial series which introduces the main concepts behind `co-log` +smoothly: + +* [Intro: Using `LogAction`](https://github.com/co-log/co-log/blob/main/tutorials/1-intro/Intro.md) +* [Using custom monad that stores `LogAction` inside its environment](https://github.com/co-log/co-log/blob/main/tutorials/2-custom/Custom.md) + +`co-log` also cares about concurrent logging. For this purpose we have the `concurrent-playground` +executable where we experiment with different multithreading scenarios to test the library's behavior. +You can find it here: + +* [tutorials/Concurrent.hs](tutorials/Concurrent.hs) + +[hk-img]: https://img.shields.io/hackage/v/co-log.svg?logo=haskell +[hk-img-ps]: https://img.shields.io/hackage/v/co-log-polysemy.svg?logo=haskell +[hk-img-core]: https://img.shields.io/hackage/v/co-log-core.svg?logo=haskell +[hk]: https://hackage.haskell.org/package/co-log +[hk-ps]: https://hackage.haskell.org/package/co-log-polysemy +[hk-core]: https://hackage.haskell.org/package/co-log-core diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,23 +1,53 @@ # co-log -[![Hackage](https://img.shields.io/hackage/v/co-log.svg)](https://hackage.haskell.org/package/co-log) -[![Stackage LTS](http://stackage.org/package/co-log/badge/lts)](http://stackage.org/lts/package/co-log) -[![Stackage Nightly](http://stackage.org/package/co-log/badge/nightly)](http://stackage.org/nightly/package/co-log) -[![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](https://github.com/kowainik/co-log/blob/master/LICENSE) -[![Build status](https://secure.travis-ci.org/kowainik/co-log.svg)](https://travis-ci.org/kowainik/co-log) +![Co-logo](https://user-images.githubusercontent.com/8126674/80955687-92f21a80-8df7-11ea-90d3-422dafdc8391.png) +[![GitHub CI](https://github.com/kowainik/co-log/workflows/CI/badge.svg)](https://github.com/kowainik/co-log/actions) +[![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](https://github.com/kowainik/co-log/blob/main/LICENSE) -Logging library based on [`co-log-core`](../co-log-core) package. Provides -ready-to-go implementation of logging. This README contains _How to_ tutorial on -using this library. This tutorial explains step by step how to integrate -`co-log` into small basic project, specifically how to replace `putStrLn` used -for logging with library provided logging. +`co-log` is a composable and configurable logging framework. It +combines all the benefits of Haskell idioms to provide a reasonable +and convenient interface. Although the library design uses some advanced +concepts in its core, we are striving to provide beginner-friendly API. The +library also provides the complete documentation with a lot of beginner-friendly +examples, explanations and tutorials to guide users. The combination of a +pragmatic approach to logging and fundamental Haskell abstractions allows us to +create a highly composable and configurable logging framework. +If you're interested in how different Haskell typeclasses are used to +implement core functions of `co-log`, you can read the following blog +post which goes into detail about the internal implementation specifics: + +* [co-log: Composable Contravariant Combinatorial Comonadic Configurable Convenient Logging](https://kowainik.github.io/posts/2018-09-25-co-log) + +## Co-Log Family + +Co-Log is a family of repositories for a composable and configurable logging +framework `co-log`. + +Here is the list of currently available repositories and libraries that you can +check out: + +| | | | +| :---------------------------------------------------------------- | :----------------------------------------------------------------------------------------------------------------------------------------------------- | :--------------------------------- | +| [`co-log-core`](https://github.com/co-log/co-log-core) | lightweight package with basic data types and general idea which depends only on `base` | [![Hackage][hk-img-core]][hk-core] | +| [`co-log`](https://github.com/co-log/co-log) | taggless final implementation of logging library based on `co-log-core` | [![Hackage][hk-img]][hk] | +| [`co-log-polysemy`](https://github.com/co-log/co-log-polysemy) | implementation of logging library based on `co-log-core` and the [`polysemy`](http://hackage.haskell.org/package/polysemy) extensible effects library. | [![Hackage][hk-img-ps]][hk-ps] | +| [`co-log-benchmarks`](https://github.com/co-log/co-log-benchmarks) | benchmarks of the `co-log` library | - + +## `co-log` library + +Logging library based on [`co-log-core`](https://github.com/co-log/co-log-core) +package. Provides ready-to-go implementation of logging. This README contains +_How to_ tutorial on using this library. This tutorial explains step by step how +to integrate `co-log` into small basic project, specifically how to replace +`putStrLn` used for logging with library provided logging. + All code below can be compiled and run with the following commands: ```shell -$ cabal new-build co-log -$ cabal new-exec readme +$ cabal build +$ cabal exec readme ``` ## Preamble: imports and language extensions @@ -29,14 +59,13 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +import Control.Monad.IO.Class (MonadIO, liftIO) + import Colog (Message, WithLog, cmap, fmtMessage, logDebug, logInfo, logTextStdout, logWarning, usingLoggerT) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Semigroup ((<>)) import qualified Data.Text as Text import qualified Data.Text.IO as TextIO - ``` ## Simple IO function example @@ -103,3 +132,25 @@ And here is how output looks like: ![screenshot from 2018-09-17 20-52-01](https://user-images.githubusercontent.com/4276606/45623973-8bafb900-babb-11e8-9e20-4369a5a8e5ff.png) + +## More Tutorials + +To provide a more user-friendly introduction to the library, we've +created the tutorial series which introduces the main concepts behind `co-log` +smoothly: + +* [Intro: Using `LogAction`](https://github.com/co-log/co-log/blob/main/tutorials/1-intro/Intro.md) +* [Using custom monad that stores `LogAction` inside its environment](https://github.com/co-log/co-log/blob/main/tutorials/2-custom/Custom.md) + +`co-log` also cares about concurrent logging. For this purpose we have the `concurrent-playground` +executable where we experiment with different multithreading scenarios to test the library's behavior. +You can find it here: + +* [tutorials/Concurrent.hs](tutorials/Concurrent.hs) + +[hk-img]: https://img.shields.io/hackage/v/co-log.svg?logo=haskell +[hk-img-ps]: https://img.shields.io/hackage/v/co-log-polysemy.svg?logo=haskell +[hk-img-core]: https://img.shields.io/hackage/v/co-log-core.svg?logo=haskell +[hk]: https://hackage.haskell.org/package/co-log +[hk-ps]: https://hackage.haskell.org/package/co-log-polysemy +[hk-core]: https://hackage.haskell.org/package/co-log-core diff --git a/co-log.cabal b/co-log.cabal --- a/co-log.cabal +++ b/co-log.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: co-log -version: 0.4.0.1 +version: 0.5.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). @@ -15,24 +15,22 @@ license-file: LICENSE author: Dmitrii Kovanikov maintainer: Kowainik -copyright: 2018-2020 Kowainik +copyright: 2018-2022 Kowainik category: Logging, Contravariant, Comonad build-type: Simple stability: provisional extra-doc-files: CHANGELOG.md README.md -tested-with: GHC == 8.2.2 - GHC == 8.4.4 - GHC == 8.6.5 - GHC == 8.8.3 - GHC == 8.10.1 +tested-with: GHC == 8.10.7 + GHC == 9.0.2 + GHC == 9.2.4 source-repository head type: git location: https://github.com/kowainik/co-log.git common common-options - build-depends: base >= 4.10.1.0 && < 4.15 + build-depends: base >= 4.14 && < 4.17 ghc-options: -Wall -Wcompat @@ -49,6 +47,11 @@ ghc-options: -Wmissing-deriving-strategies if impl(ghc >= 8.10) ghc-options: -Wunused-packages + if impl(ghc >= 9.0) + ghc-options: -Winvalid-haddock + if impl(ghc >= 9.2) + ghc-options: -Wredundant-bang-patterns + -Woperator-whitespace default-language: Haskell2010 default-extensions: ConstraintKinds @@ -78,28 +81,26 @@ hs-source-dirs: src exposed-modules: Colog Colog.Actions - Colog.Concurrent - Colog.Concurrent.Internal Colog.Contra Colog.Message Colog.Monad Colog.Pure Colog.Rotation - build-depends: ansi-terminal ^>= 0.10 - , bytestring ^>= 0.10.8 - , co-log-core ^>= 0.2.1.0 + build-depends: ansi-terminal >= 0.10 && < 0.12 + , bytestring >= 0.10.8 && < 0.12 + , co-log-core ^>= 0.3 , containers >= 0.5.7 && < 0.7 , contravariant ^>= 1.5 , directory ^>= 1.3.0 + , exceptions >= 0.8.3 , filepath ^>= 1.4.1 - , mtl ^>= 2.2.2 - , stm >= 2.4 && < 2.6 - , text ^>= 1.2.3 - , chronos ^>= 1.1 - , transformers ^>= 0.5 - , typerep-map ^>= 0.3.2 - , vector ^>= 0.12.0.3 + , mtl >= 2.2.2 && < 2.4 + , text >= 1.2.3 && < 2.1 + , chronos ^>= 1.1 && < 1.2 + , transformers >= 0.5 && < 0.7 + , typerep-map ^>= 0.5 + , vector >= 0.12.0.3 && < 0.14 executable play-colog import: common-options @@ -144,7 +145,17 @@ import: common-options build-depends: co-log , co-log-core - , hedgehog ^>= 1.0 + , hedgehog >= 1.0 && < 1.3 hs-source-dirs: test main-is: Property.hs type: exitcode-stdio-1.0 + +test-suite co-log-doctest + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Doctest.hs + + build-depends: doctest >= 0.16.0 && < 0.21 + , Glob ^>= 0.10.0 + ghc-options: -threaded diff --git a/src/Colog.hs b/src/Colog.hs --- a/src/Colog.hs +++ b/src/Colog.hs @@ -1,5 +1,5 @@ {- | -Copyright: (c) 2018-2020 Kowainik +Copyright: (c) 2018-2022 Kowainik SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik @@ -9,7 +9,6 @@ module Colog ( module Colog.Actions - , module Colog.Concurrent , module Colog.Core , module Colog.Message , module Colog.Monad @@ -18,7 +17,6 @@ ) 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,5 +1,5 @@ {- | -Copyright: (c) 2018-2020 Kowainik +Copyright: (c) 2018-2022 Kowainik SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik @@ -27,9 +27,10 @@ import Control.Monad.IO.Class (MonadIO (..)) import Data.Text.Encoding (encodeUtf8) -import System.IO (Handle, IOMode (AppendMode), stderr, withFile) +import System.IO (Handle, IOMode (AppendMode), stderr, stdout, withFile) import Colog.Core.Action (LogAction (..), cmapM, (>$<)) +import Colog.Core.IO (logFlush) import Colog.Message (Message, defaultFieldMap, fmtMessage, fmtRichMessageDefault, upgradeMessageAction) @@ -42,19 +43,28 @@ -- ByteString ---------------------------------------------------------------------------- -{- | Action that prints 'BS.ByteString' to stdout. -} +{- | Action that prints 'BS.ByteString' to stdout. +This action does not flush the output buffer. +If buffering mode is block buffering, the effect of this action can be delayed. +-} logByteStringStdout :: MonadIO m => LogAction m BS.ByteString logByteStringStdout = LogAction $ liftIO . BS8.putStrLn {-# INLINE logByteStringStdout #-} {-# SPECIALIZE logByteStringStdout :: LogAction IO BS.ByteString #-} -{- | Action that prints 'BS.ByteString' to stderr. -} +{- | Action that prints 'BS.ByteString' to stderr. +This action does not flush the output buffer. +If buffering mode is block buffering, the effect of this action can be delayed. +-} logByteStringStderr :: MonadIO m => LogAction m BS.ByteString logByteStringStderr = logByteStringHandle stderr {-# INLINE logByteStringStderr #-} {-# SPECIALIZE logByteStringStderr :: LogAction IO BS.ByteString #-} -{- | Action that prints 'BS.ByteString' to 'Handle'. -} +{- | Action that prints 'BS.ByteString' to 'Handle'. +This action does not flush the output buffer. +If buffering mode is block buffering, the effect of this action can be delayed. +-} logByteStringHandle :: MonadIO m => Handle -> LogAction m BS.ByteString logByteStringHandle handle = LogAction $ liftIO . BS8.hPutStrLn handle {-# INLINE logByteStringHandle #-} @@ -64,7 +74,8 @@ 'Colog.Core.Action.withLogStringFile' for details. -} withLogByteStringFile :: MonadIO m => FilePath -> (LogAction m BS.ByteString -> IO r) -> IO r -withLogByteStringFile path action = withFile path AppendMode $ action . logByteStringHandle +withLogByteStringFile path action = withFile path AppendMode $ \handle -> + action (logByteStringHandle handle <> logFlush handle) {-# INLINE withLogByteStringFile #-} {-# SPECIALIZE withLogByteStringFile :: FilePath -> (LogAction IO BS.ByteString -> IO r) -> IO r #-} @@ -72,21 +83,30 @@ -- Text ---------------------------------------------------------------------------- -{- | Action that prints 'T.Text' to stdout. -} +{- | Action that prints 'T.Text' to stdout. +This action does not flush the output buffer. +If buffering mode is block buffering, the effect of this action can be delayed. +-} logTextStdout :: MonadIO m => LogAction m T.Text -logTextStdout = LogAction $ liftIO . TIO.putStrLn +logTextStdout = logTextHandle stdout {-# INLINE logTextStdout #-} {-# SPECIALIZE logTextStdout :: LogAction IO T.Text #-} -{- | Action that prints 'T.Text' to stderr. -} +{- | Action that prints 'T.Text' to stderr. +This action does not flush the output buffer. +If buffering mode is block buffering, the effect of this action can be delayed. +-} logTextStderr :: MonadIO m => LogAction m T.Text logTextStderr = logTextHandle stderr {-# INLINE logTextStderr #-} {-# SPECIALIZE logTextStderr :: LogAction IO T.Text #-} -{- | Action that prints 'T.Text' to 'Handle'. -} +{- | Action that prints 'T.Text' to 'Handle'. +This action does not flush the output buffer. +If buffering mode is block buffering, the effect of this action can be delayed. +-} logTextHandle :: MonadIO m => Handle -> LogAction m T.Text -logTextHandle handle = LogAction $ liftIO . TIO.hPutStrLn handle +logTextHandle handle = LogAction $ \m -> liftIO . TIO.hPutStr handle $ m <> "\n" {-# INLINE logTextHandle #-} {-# SPECIALIZE logTextHandle :: Handle -> LogAction IO T.Text #-} @@ -94,7 +114,8 @@ 'Colog.Core.Action.withLogStringFile' for details. -} withLogTextFile :: MonadIO m => FilePath -> (LogAction m T.Text -> IO r) -> IO r -withLogTextFile path action = withFile path AppendMode $ action . logTextHandle +withLogTextFile path action = withFile path AppendMode $ \handle -> + action (logTextHandle handle <> logFlush handle) {-# INLINE withLogTextFile #-} {-# SPECIALIZE withLogTextFile :: FilePath -> (LogAction IO T.Text -> IO r) -> IO r #-} diff --git a/src/Colog/Concurrent.hs b/src/Colog/Concurrent.hs deleted file mode 100644 --- a/src/Colog/Concurrent.hs +++ /dev/null @@ -1,343 +0,0 @@ -{- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik - -__NOTE:__ Many thanks to Alexander Vershilov for the implementation. - -For the speed reasons you may want to dump logs asynchronously. -This is especially useful when application threads are CPU -bound while logs emitting is I/O bound. This approach -allows to mitigate bottlenecks from the I/O. - -When writing an application user should be aware of the tradeoffs -that concurrent log system can provide, in this module we explain -potential tradeoffs and describe if certain building blocks are -affected or not. - - 1. Unbounded memory usage - if there is no backpressure mechanism - the user threads, they may generate more logs that can be - written in the same amount of time. In those cases messages will - be accumulated in memory. That will lead to extended GC times and - application may be killed by the operating systems mechanisms. - - 2. Persistence requirement - sometimes application may want to - ensure that logs were written before it can continue. This is not - a case with concurrent log systems in general, and some logs may - be lost when application exits before dumping all logs. - - 3. Non-precise logging - sometimes it may happen that there can be - logs reordering (in case if thread was moved to another capability). - -In case if your application is a subject of those problems you may -consider not using concurrent logging system in other cases concurrent -logger may be a good default for you. --} - -module Colog.Concurrent - ( -- $general - -- * Simple API. - -- $simple-api - withBackgroundLogger - , defCapacity - -- * Extended API - -- $extended-api - -- ** Background worker - -- $background-worker - , BackgroundWorker - , backgroundWorkerWrite - , killBackgroundLogger - -- ** Background logger - , forkBackgroundLogger - , convertToLogAction - -- ** Worker thread - -- $worker-thread - , mkBackgroundThread - , runInBackgroundThread - -- *** Usage example - -- $worker-thread-usage - ) where - -import Control.Applicative (many) -import Control.Concurrent (forkFinally, killThread) -import Control.Concurrent.STM (atomically, check, newTVarIO, readTVar, writeTVar) -import Control.Concurrent.STM.TBQueue (newTBQueueIO, readTBQueue, writeTBQueue) -import Control.Exception (bracket, finally) -import Control.Monad (forever, join) -import Control.Monad.IO.Class (MonadIO (..)) -import Data.Foldable (for_) - -import Colog.Concurrent.Internal (BackgroundWorker (..), Capacity (..)) -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 '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 - (action . convertToLogAction) - --- | Default capacity size, (4096) -defCapacity :: Capacity -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. --} - -{- $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. --} - -{- | 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. --} - -{- | 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 - isAlive <- newTVarIO True - tid <- forkFinally - (forever $ do - msg <- atomically $ readTBQueue queue - unLogAction logAction msg) - (\_ -> - (do msgs <- atomically $ many $ readTBQueue queue - for_ msgs $ unLogAction logAction) - `finally` atomically (writeTVar isAlive False)) - 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. --} -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. --} - -{- | 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 - isAlive <- newTVarIO True - tid <- forkFinally - (forever $ join $ atomically $ readTBQueue queue) - (\_ -> - (sequence_ =<< atomically (many $ readTBQueue queue)) - `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. --} -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 = '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 deleted file mode 100644 --- a/src/Colog/Concurrent/Internal.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE CPP #-} - -{- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik - -__NOTE:__ Many thanks to Alexander Vershilov for the implementation. - -This is internal module, use it on your own risk. The implementation here may be -changed without a version bump. --} - -module Colog.Concurrent.Internal - ( BackgroundWorker (..) - , Capacity (..) - ) where - -import Control.Concurrent (ThreadId) -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. --} -#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. --} -data BackgroundWorker msg = BackgroundWorker - { backgroundWorkerThreadId :: !ThreadId - -- ^ Background 'ThreadId'. - , backgroundWorkerWrite :: msg -> STM () - -- ^ Method for communication with the thread. - , backgroundWorkerIsAlive :: TVar Bool - } diff --git a/src/Colog/Contra.hs b/src/Colog/Contra.hs --- a/src/Colog/Contra.hs +++ b/src/Colog/Contra.hs @@ -3,7 +3,7 @@ {-# LANGUAGE CPP #-} {- | -Copyright: (c) 2018-2020 Kowainik +Copyright: (c) 2018-2022 Kowainik SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik diff --git a/src/Colog/Message.hs b/src/Colog/Message.hs --- a/src/Colog/Message.hs +++ b/src/Colog/Message.hs @@ -9,7 +9,7 @@ {-# LANGUAGE TypeFamilies #-} {- | -Copyright: (c) 2018-2020 Kowainik +Copyright: (c) 2018-2022 Kowainik SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik @@ -42,6 +42,9 @@ , fmtMessage , showSeverity , showSourceLoc + , showTime + , showTimeOffset + , showThreadId -- * Externally extensible message type -- ** Field of the dependent map @@ -68,7 +71,6 @@ import Control.Exception (Exception, displayException) import Control.Monad.IO.Class (MonadIO (..)) import Data.Kind (Type) -import Data.Semigroup ((<>)) import Data.Text (Text) import Data.Text.Lazy (toStrict) import Data.TypeRepMap (TypeRepMap) @@ -105,7 +107,7 @@ data Msg sev = Msg { msgSeverity :: !sev , msgStack :: !CallStack - , msgText :: !Text + , msgText :: Text } {- | Message data type without 'Severity'. Use 'logText' to log @@ -417,37 +419,45 @@ {- | Shows time in the following format: ->>> showTime $ C.Time 1577656800 -[29 Dec 2019 22:00:00.000 +00:00] +>>> showTime $ C.Time 1577656800000000000 +"[29 Dec 2019 22:00:00.000 +00:00] " -} showTime :: C.Time -> Text showTime t = square $ toStrict $ TB.toLazyText - $ builderDmyHMSz (C.timeToDatetime t) + $ builderDmyHMSz (C.timeToOffsetDatetime (C.Offset 0) t) +{- | Shows time in the following format: + +>>> showTimeOffset $ C.timeToOffsetDatetime (C.Offset $ -120) $ C.Time 1577656800000000000 +"[29 Dec 2019 20:00:00.000 -02:00] " +-} +showTimeOffset :: C.OffsetDatetime -> Text +showTimeOffset = square . toStrict . TB.toLazyText . builderDmyHMSz + ---------------------------------------------------------------------------- -- Chronos extra ---------------------------------------------------------------------------- -{- | Given a 'Datetime', constructs a 'Text' 'TB.Builder' corresponding to a -Day\/Month\/Year,Hour\/Minute\/Second\/Offset encoding of the given 'Datetime'. +{- | Given a 'OffsetDatetime', constructs a 'Text' 'TB.Builder' corresponding to a +Day\/Month\/Year,Hour\/Minute\/Second\/Offset encoding of the given 'OffsetDatetime'. Example: @29 Dec 2019 22:00:00.000 +00:00@ -} -builderDmyHMSz :: C.Datetime -> TB.Builder -builderDmyHMSz (C.Datetime date time) = +builderDmyHMSz :: C.OffsetDatetime -> TB.Builder +builderDmyHMSz (C.OffsetDatetime (C.Datetime date time) offset) = builderDmy date <> spaceSep <> C.builder_HMS (C.SubsecondPrecisionFixed 3) (Just ':') time <> spaceSep - <> C.builderOffset C.OffsetFormatColonOn (C.Offset 0) + <> C.builderOffset C.OffsetFormatColonOn offset where spaceSep :: TB.Builder spaceSep = TB.singleton ' ' - {- | Given a 'Date' construct a 'Text' 'TB.Builder' + {- Given a 'Date' construct a 'Text' 'TB.Builder' corresponding to a Day\/Month\/Year encoding. Example: @01 Jan 2020@ @@ -490,6 +500,11 @@ -- Utility functions ---------------------------------------------------------------------------- +{- | Shows a thread id in the following format: + +__>>__ showThreadId <$> Control.Concurrent.myThreadId +"[ThreadId 4898] " +-} showThreadId :: ThreadId -> Text showThreadId = square . T.pack . show diff --git a/src/Colog/Monad.hs b/src/Colog/Monad.hs --- a/src/Colog/Monad.hs +++ b/src/Colog/Monad.hs @@ -1,7 +1,7 @@ {-# LANGUAGE InstanceSigs #-} {- | -Copyright: (c) 2018-2020 Kowainik +Copyright: (c) 2018-2022 Kowainik SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik @@ -10,6 +10,7 @@ module Colog.Monad ( LoggerT (..) + , HasLog (..) , WithLog , logMsg , logMsgs @@ -26,7 +27,7 @@ import Data.Foldable (traverse_) import GHC.Stack (HasCallStack) -import Colog.Core (HasLog (..), LogAction (..), overLogAction, hoistLogAction) +import Colog.Core (HasLog (..), LogAction (..), hoistLogAction, overLogAction) {- | @newtype@ wrapper 'ReaderT' that keeps 'LogAction' in its context. diff --git a/src/Colog/Pure.hs b/src/Colog/Pure.hs --- a/src/Colog/Pure.hs +++ b/src/Colog/Pure.hs @@ -1,5 +1,5 @@ {- | -Copyright: (c) 2018-2020 Kowainik +Copyright: (c) 2018-2022 Kowainik SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik @@ -16,6 +16,8 @@ , logMessagePure ) where +import Control.Monad.Catch (MonadThrow) +import Control.Monad.IO.Class (MonadIO) import Control.Monad.State (MonadState, StateT (..), modify') import Control.Monad.Trans.Class (MonadTrans) import Data.Bifunctor (second) @@ -31,7 +33,9 @@ -} newtype PureLoggerT msg m a = PureLoggerT { runPureLoggerT :: StateT (Seq msg) m a - } deriving newtype (Functor, Applicative, Monad, MonadTrans, MonadState (Seq msg)) + } deriving newtype ( Functor, Applicative, Monad, MonadTrans + , MonadState (Seq msg), MonadFail, MonadIO, MonadThrow + ) -- | 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,5 +1,5 @@ {- | -Copyright: (c) 2018-2020 Kowainik +Copyright: (c) 2018-2022 Kowainik SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik Stability: experimental @@ -125,7 +125,7 @@ -- if you give it name like `node.log.4` then it returns `Just 4` logFileIndex :: FilePath -> Maybe Natural -logFileIndex path = fmap NE.tail (nonEmpty (POS.takeExtension path)) >>= readMaybe +logFileIndex path = nonEmpty (POS.takeExtension path) >>= readMaybe . NE.tail -- creates list of files with indices who are older on given Limit than the latest one getOldFiles :: Limit -> FilePath -> IO [FilePath] diff --git a/test/Doctest.hs b/test/Doctest.hs new file mode 100644 --- /dev/null +++ b/test/Doctest.hs @@ -0,0 +1,22 @@ +module Main(main) where + +import System.FilePath.Glob (glob) +import Test.DocTest (doctest) + +main :: IO () +main = do + sourceFiles <- glob "src/**/*.hs" + doctest + $ "-XConstraintKinds" + : "-XDerivingStrategies" + : "-XDeriveGeneric" + : "-XGeneralizedNewtypeDeriving" + : "-XLambdaCase" + : "-XOverloadedStrings" + : "-XRecordWildCards" + : "-XScopedTypeVariables" + : "-XStandaloneDeriving" + : "-XTupleSections" + : "-XTypeApplications" + : "-XViewPatterns" + : sourceFiles diff --git a/test/Property.hs b/test/Property.hs --- a/test/Property.hs +++ b/test/Property.hs @@ -1,9 +1,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} -module Main where +module Main (main) where -import Data.Semigroup ((<>)) import Hedgehog (MonadGen, Property, checkSequential, discover, forAll, property, (===)) import System.Exit (exitFailure, exitSuccess) import System.IO (BufferMode (..), hSetBuffering, stderr, stdout) diff --git a/tutorials/Concurrent.hs b/tutorials/Concurrent.hs --- a/tutorials/Concurrent.hs +++ b/tutorials/Concurrent.hs @@ -1,4 +1,4 @@ -{- | The purpose of this module is to check concurrent abilities of @colog@. +{- | The purpose of this module is to check concurrent abilities of @co-log@. -} module Main (main) where @@ -6,7 +6,6 @@ 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, (<&)) diff --git a/tutorials/Main.hs b/tutorials/Main.hs --- a/tutorials/Main.hs +++ b/tutorials/Main.hs @@ -11,7 +11,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeSynonymInstances #-} module Main (main) where @@ -21,14 +20,13 @@ import Control.Exception (Exception) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Reader (MonadReader, ReaderT (..)) -import Data.Semigroup ((<>)) -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 Colog (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, pattern D, runPureLog, upgradeMessageAction, usingLoggerT, withLog, + withLogTextFile, (*<), (<&), (>$), (>$<), (>*), (>*<), (>|<)) import qualified Data.TypeRepMap as TM @@ -46,7 +44,7 @@ app :: (WithLog env Message m, MonadIO m) => m () app = do logWarning "Starting application..." - liftIO $ threadDelay $ 10^(6 :: Int) + liftIO $ threadDelay $ 10 ^ (6 :: Int) withLog (cmap addApp) $ do example exceptionL @@ -170,7 +168,7 @@ ---------------------------------------------------------------------------- main :: IO () -main = withLogTextFile "co-log/tutorials/example.log" $ \logTextFile -> do +main = withLogTextFile "tutorials/example.log" $ \logTextFile -> do let runApp :: LogAction IO Message -> IO () runApp action = usingLoggerT action app