diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,7 +3,29 @@ `co-log-core` uses [PVP Versioning][1]. The change log is available [on GitHub][2]. -## 0.1.2.0 — May 5, 2019 +## 0.2.1.0 — Jan 19, 2020 + +* [#139](https://github.com/kowainik/co-log/issues/139): + Add (unrepresentable) `Functor` instance for `LogAction` with the + custom type-error. + (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)) +* [#122](https://github.com/kowainik/co-log/issues/122): + Add the `separate` combinator. + (by [@vrom911](https://github.com/vrom911)) +* [#125](https://github.com/kowainik/co-log/issues/125): + Add monadic versions of contravariant functions. + (by [@piq9117](https://github.com/piq9117)) +* [#138](https://github.com/kowainik/co-log/issues/138): + Add `hoistLogAction` — higher-order transformation function. + (by [@jiribenes](https://github.com/jiribenes)) +* [#123](https://github.com/kowainik/co-log/issues/123): + Write default implementation to `getLogAction` via `logActionL`. + (by [@SanchayanMaity](https://github.com/SanchayanMaity)) + +## 0.2.0.0 — May 5, 2019 * [#85](https://github.com/kowainik/co-log/issues/85): Move `overLogAction` to `HasLog` typeclass diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,8 @@ # 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://img.shields.io/travis/kowainik/co-log.svg?logo=travis)](https://travis-ci.org/kowainik/co-log) +[![Windows build](https://ci.appveyor.com/api/projects/status/github/kowainik/co-log?branch=master&svg=true)](https://ci.appveyor.com/project/kowainik/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) | | | | | | :------------ | :--------------------------------- | :---------------------------------------- | :---------------------------------------------------- | @@ -9,26 +10,48 @@ | `co-log` | [![Hackage][hk-img]][hk] | [![Stackage LTS][lts-img]][lts] | [![Stackage Nightly][nightly-img]][nightly] | | `co-log-polysemy` | [![Hackage][hk-img-ps]][hk-ps] | [![Stackage LTS][lts-img-ps]][lts-ps] | [![Stackage Nightly][nightly-img-ps]][nightly-ps] | -`co-log` is a composable and configurable logging framework. The idea of the approach is -described in the following blog post: +`co-log` is a composable and configurable logging framework. It +combines all the benefits of Haskell idioms to provide a reasonable +and convenient interface. Though it uses some advanced concepts in its +core, we are striving to provide beginner-friendly API. The library +also contains complete documentation with a lot of beginner-friendly +examples, explanations and tutorials to guide users. The combination +of pragmatic approach to logging and fundamental Haskell abstractions +allows us to create highly composable and configurable logging +framework. +If you're interested in how different Haskel typeclasses are used to +implement core functions of `co-log`, you can read the following blog +post which goes in detail about internal implementation specifics: + * [co-log: Composable Contravariant Combinatorial Comonadic Configurable Convenient Logging](https://kowainik.github.io/posts/2018-09-25-co-log) -The repository contains the following packages: +`co-log` is also modular on the level of packages. We care a lot about a +low dependency footprint so you can build your logging only on top of +the minimal required interface for your use-case. This repository contains +the following packages: * [`co-log-core`](co-log-core): lightweight package with basic data types and - general idea. + general idea which depends only on `base`. * [`co-log`](co-log): taggless final implementation of logging library based on `co-log-core`. * [`co-log-polysemy`](co-log-polysemy): implementation of logging library based on `co-log-core` and the [`polysemy`](http://hackage.haskell.org/package/polysemy) extensible effects library. * [`co-log-benchmark`](co-log-benchmark): Benchmarks of the `co-log` library. -See the following tutorial series about the library: +To provide 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/kowainik/co-log/blob/master/co-log/tutorials/1-intro/Intro.md) * [Using custom monad that stores `LogAction` inside its environment](https://github.com/kowainik/co-log/blob/master/co-log/tutorials/2-custom/Custom.md) +`co-log` also cares about concurrent logging. For this purposes we have the `concurrent-playground` +executable where we experiment with different multithreading scenarios to test the library behavior. +You can find it here: + +* [tutorials/Concurrent.hs](co-log/tutorials/Concurrent.hs) + ## Benchmarks `co-log` is compared with basic functions like `putStrLn`. Since IO overhead is @@ -36,6 +59,12 @@ doesn't contain `Message` then this benchmark simply dumps string `"message"` to output, otherwise it works with `Message` data type from the `co-log` library. + +To run benchmarks, use the following command: + +``` +cabal v2-run co-log-bench +``` | Benchmarks | Time for 10K messages | | :------------------------------------------------------ | :-------------------- | diff --git a/co-log-core.cabal b/co-log-core.cabal --- a/co-log-core.cabal +++ b/co-log-core.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: co-log-core -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Composable Contravariant Comonadic Logging Library description: This package provides core types and functions to work with the @LogAction@ data type which is both simple and powerful. @@ -27,29 +27,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: stable 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.2 source-repository head type: git location: https://github.com/kowainik/co-log.git -library - hs-source-dirs: src - exposed-modules: Colog.Core - Colog.Core.Action - Colog.Core.Class - Colog.Core.Severity - Colog.Core.IO - - build-depends: base >= 4.10 && < 4.13 +common common-options + build-depends: base >= 4.10.1.0 && < 4.14 ghc-options: -Wall -Wincomplete-uni-patterns @@ -59,10 +53,14 @@ -Wredundant-constraints -fhide-source-paths -freverse-errors + if impl(ghc >= 8.8.1) + ghc-options: -Wmissing-deriving-strategies + -Werror=missing-deriving-strategies default-language: Haskell2010 default-extensions: ConstraintKinds DeriveGeneric + DerivingStrategies GeneralizedNewtypeDeriving InstanceSigs LambdaCase @@ -74,11 +72,19 @@ TypeApplications ViewPatterns +library + import: common-options + hs-source-dirs: src + exposed-modules: Colog.Core + Colog.Core.Action + Colog.Core.Class + Colog.Core.Severity + Colog.Core.IO + test-suite doctest + import: common-options type: exitcode-stdio-1.0 - build-depends: base >= 4.10 && < 4.13 - , doctest ^>= 0.16.0 - , Glob - default-language: Haskell2010 hs-source-dirs: test main-is: Doctests.hs + build-depends: doctest ^>= 0.16.0 + , Glob ^>= 0.10.0 diff --git a/src/Colog/Core.hs b/src/Colog/Core.hs --- a/src/Colog/Core.hs +++ b/src/Colog/Core.hs @@ -1,6 +1,6 @@ {- | -Copyright: (c) 2018-2019 Kowainik -License: MIT +Copyright: (c) 2018-2020 Kowainik +SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik Exports all core functionality. @co-log-core@ is a lightweight package that diff --git a/src/Colog/Core/Action.hs b/src/Colog/Core/Action.hs --- a/src/Colog/Core/Action.hs +++ b/src/Colog/Core/Action.hs @@ -1,8 +1,13 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} {- | -Copyright: (c) 2018-2019 Kowainik -License: MIT +Copyright: (c) 2018-2020 Kowainik +SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik Implements core data types and combinators for logging actions. @@ -20,15 +25,18 @@ -- * Contravariant combinators -- $contravariant , cfilter + , cfilterM , cmap , (>$<) , cmapMaybe + , cmapMaybeM , (Colog.Core.Action.>$) , cmapM -- * Divisible combinators -- $divisible , divide + , divideM , conquer , (>*<) , (>*) @@ -38,6 +46,7 @@ -- $decidable , lose , choose + , chooseM , (>|<) -- * Comonadic combinators @@ -48,15 +57,21 @@ , (<<=) , duplicate , multiplicate + , separate + + -- * Higher-order combinators + , hoistLogAction ) where -import Control.Monad (when, (>=>)) +import Control.Monad (when, (<=<), (>=>)) import Data.Coerce (coerce) -import Data.Foldable (fold, for_) +import Data.Foldable (fold, for_, traverse_) +import Data.Kind (Constraint) import Data.List.NonEmpty (NonEmpty (..)) import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..), stimesMonoid) import Data.Void (Void, absurd) +import GHC.TypeLits (ErrorMessage (..), TypeError) #if MIN_VERSION_base(4,12,0) import qualified Data.Functor.Contravariant as Contravariant @@ -135,13 +150,68 @@ #if MIN_VERSION_base(4,12,0) instance Contravariant.Contravariant (LogAction m) where + contramap :: (a -> b) -> LogAction m b -> LogAction m a contramap = cmap {-# INLINE contramap #-} + (>$) :: b -> LogAction m b -> LogAction m a (>$) = (Colog.Core.Action.>$) {-# INLINE (>$) #-} #endif +-- | For tracking usage of unrepresentable class instances of 'LogAction'. +type family UnrepresentableClass :: Constraint + where + UnrepresentableClass = TypeError + ( 'Text "'LogAction' cannot have a 'Functor' instance by design." + ':$$: 'Text "However, you've attempted to use this instance." +#if MIN_VERSION_base(4,12,0) + ':$$: 'Text "" + ':$$: 'Text "Probably you meant 'Contravariant' class instance with the following methods:" + ':$$: 'Text " * contramap :: (a -> b) -> LogAction m b -> LogAction m a" + ':$$: 'Text " * (>$) :: b -> LogAction m b -> LogAction m a" +#endif + ) + +{- | ⚠️__CAUTION__⚠️ This instance is for custom error display only. + +'LogAction' is not supposed to have 'Functor' instance by design. + +In case it is used by mistake, the user will see the following: + +#if MIN_VERSION_base(4,12,0) + +>>> fmap show logStringStdout +... +... 'LogAction' cannot have a 'Functor' instance by design. + However, you've attempted to use this instance. +... + Probably you meant 'Contravariant' class instance with the following methods: + * contramap :: (a -> b) -> LogAction m b -> LogAction m a + * (>$) :: b -> LogAction m b -> LogAction m a +... + + +#else + +>>> fmap show logStringStdout +... +... 'LogAction' cannot have a 'Functor' instance by design. + However, you've attempted to use this instance. +... + +#endif + +@since 0.2.1.0 +-} +instance UnrepresentableClass => Functor (LogAction m) where + fmap :: (a -> b) -> LogAction m a -> LogAction m b + fmap _ _ = error "Unreachable Functor instance of LogAction" + + (<$) :: a -> LogAction m b -> LogAction m a + _ <$ _ = error "Unreachable Functor instance of LogAction" + + {- | Operator version of 'unLogAction'. Note that because of the types, something like: @ @@ -217,6 +287,30 @@ cfilter predicate (LogAction action) = LogAction $ \a -> when (predicate a) (action a) {-# INLINE cfilter #-} +{- | Performs the given logging action only if satisfies the monadic +predicate. Let's say you want to only to see logs that happened on +weekends. + +@ +isWeekendM :: MessageWithTimestamp -> IO Bool +@ + +And use it with 'cfilterM' like this + +@ +logMessageAction :: 'LogAction' m MessageWithTimestamp + +logWeekendAction :: 'LogAction' m MessageWithTimestamp +logWeekendAction = cfilterM isWeekendM logMessageAction +@ + +@since 0.2.1.0 +-} +cfilterM :: Monad m => (msg -> m Bool) -> LogAction m msg -> LogAction m msg +cfilterM predicateM (LogAction action) = + LogAction $ \a -> predicateM a >>= \b -> when b (action a) +{-# INLINE cfilterM #-} + {- | This combinator is @contramap@ from contravariant functor. It is useful when you have something like @@ -274,6 +368,15 @@ cmapMaybe f (LogAction action) = LogAction (maybe (pure ()) action . f) {-# INLINE cmapMaybe #-} +{- | Similar to `cmapMaybe` but for convertions that may fail inside a +monadic context. + +@since 0.2.1.0 +-} +cmapMaybeM :: Monad m => (a -> m (Maybe b)) -> LogAction m b -> LogAction m a +cmapMaybeM f (LogAction action) = LogAction (maybe (pure ()) action <=< f) +{-# INLINE cmapMaybeM #-} + {- | This combinator is @>$@ from contravariant functor. Replaces all locations in the output with the same value. The default definition is @contramap . const@, so this is a more efficient version. @@ -360,6 +463,15 @@ actionB b *> actionC c {-# INLINE divide #-} +{- | Monadic version of 'divide'. + +@since 0.2.1.0 +-} +divideM :: (Monad m) => (a -> m (b, c)) -> LogAction m b -> LogAction m c -> LogAction m a +divideM f (LogAction actionB) (LogAction actionC) = + LogAction $ \(f -> mbc) -> mbc >>= (\(b, c) -> actionB b *> actionC c) +{-# INLINE divideM #-} + {- | @conquer@ combinator from @Divisible@ type class. Concretely, this is a 'LogAction' that does nothing: @@ -440,6 +552,14 @@ choose f (LogAction actionB) (LogAction actionC) = LogAction (either actionB actionC . f) {-# INLINE choose #-} +{- | Monadic version of 'choose'. + +@since 0.2.1.0 +-} +chooseM :: Monad m => (a -> m (Either b c)) -> LogAction m b -> LogAction m c -> LogAction m a +chooseM f (LogAction actionB) (LogAction actionC) = LogAction (either actionB actionC <=< f) +{-# INLINE chooseM #-} + {- | Operator version of @'choose' 'id'@. >>> dontPrintInt = LogAction (const (putStrLn "Not printing Int")) @@ -575,3 +695,58 @@ {-# INLINE multiplicate #-} {-# SPECIALIZE multiplicate :: Monoid msg => LogAction m msg -> LogAction m [msg] #-} {-# SPECIALIZE multiplicate :: Monoid msg => LogAction m msg -> LogAction m (NonEmpty msg) #-} + +{- | Like 'multiplicate' but instead of logging a batch of messages it logs each +of them separately. + +>>> :{ +let logger :: LogAction IO Int + logger = logPrint +in separate logger <& [1..5] +:} +1 +2 +3 +4 +5 + +@since 0.2.1.0 +-} +separate + :: forall f msg m . + (Traversable f, Applicative m) + => LogAction m msg + -> LogAction m (f msg) +separate (LogAction action) = LogAction (traverse_ action) +{-# INLINE separate #-} +{-# SPECIALIZE separate :: Applicative m => LogAction m msg -> LogAction m [msg] #-} +{-# SPECIALIZE separate :: Applicative m => LogAction m msg -> LogAction m (NonEmpty msg) #-} +{-# SPECIALIZE separate :: LogAction IO msg -> LogAction IO [msg] #-} +{-# SPECIALIZE separate :: LogAction IO msg -> LogAction IO (NonEmpty msg) #-} + +{- | Allows changing the internal monadic action. + +Let's say we have a pure logger action using 'PureLogger' +and we want to log all messages into 'IO' instead. + +If we provide the following function: + +@ +performPureLogsInIO :: PureLogger a -> IO a +@ + +then we can convert a logger action that uses a pure monad +to a one that performs the logging in the 'IO' monad using: + +@ +hoistLogAction performPureLogsInIO :: LogAction (PureLogger a) a -> LogAction IO a +@ + +@since 0.2.1.0 +-} +hoistLogAction + :: (forall x. m x -> n x) + -> LogAction m a + -> LogAction n a +hoistLogAction f (LogAction l) = LogAction (f . l) +{-# INLINE hoistLogAction #-} diff --git a/src/Colog/Core/Class.hs b/src/Colog/Core/Class.hs --- a/src/Colog/Core/Class.hs +++ b/src/Colog/Core/Class.hs @@ -3,8 +3,8 @@ {-# LANGUAGE Rank2Types #-} {- | -Copyright: (c) 2018-2019 Kowainik -License: MIT +Copyright: (c) 2018-2020 Kowainik +SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik Provides type class for values that has access to 'LogAction'. @@ -19,6 +19,7 @@ ) where import Colog.Core.Action (LogAction) +import Data.Functor.Const (Const (..)) -- to inline lens better @@ -37,10 +38,12 @@ 4. __Set-Over:__ @'overLogAction' f env ≡ 'setLogAction' (f $ 'getLogAction' env) env@ -} class HasLog env msg m where - {-# MINIMAL getLogAction, (setLogAction | overLogAction) #-} + {-# MINIMAL logActionL | (getLogAction , (setLogAction | overLogAction)) #-} -- | Extracts 'LogAction' from the environment. getLogAction :: env -> LogAction m msg + getLogAction = getConst . logActionL Const + {-# INLINE getLogAction #-} -- | Sets 'LogAction' to the given one inside the environment. setLogAction :: LogAction m msg -> env -> env diff --git a/src/Colog/Core/IO.hs b/src/Colog/Core/IO.hs --- a/src/Colog/Core/IO.hs +++ b/src/Colog/Core/IO.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE CPP #-} + {- | -Copyright: (c) 2018-2019 Kowainik -License: MIT +Copyright: (c) 2018-2020 Kowainik +SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik Introduces logging actions working in 'MonadIO'. These actions are very basic @@ -31,6 +33,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import System.IO (Handle, IOMode (AppendMode), hPrint, hPutStrLn, stderr, withFile) + {- $setup >>> import Colog.Core.Action -} @@ -76,9 +79,13 @@ Opens file in 'AppendMode'. +#ifndef mingw32_HOST_OS + >>> logger action = action <& "foo" >>> withLogStringFile "/dev/stdout" logger foo + +#endif -} withLogStringFile :: MonadIO m => FilePath -> (LogAction m String -> IO r) -> IO r withLogStringFile path action = withFile path AppendMode $ action . logStringHandle diff --git a/src/Colog/Core/Severity.hs b/src/Colog/Core/Severity.hs --- a/src/Colog/Core/Severity.hs +++ b/src/Colog/Core/Severity.hs @@ -1,8 +1,8 @@ {-# LANGUAGE PatternSynonyms #-} {- | -Copyright: (c) 2018-2019 Kowainik -License: MIT +Copyright: (c) 2018-2020 Kowainik +SPDX-License-Identifier: MPL-2.0 Maintainer: Kowainik This module introduces 'Severity' data type for expressing how severe the @@ -37,6 +37,7 @@ import Colog.Core.Action (LogAction (..), cfilter) + -- | Severity for the log messages. data Severity {- | Information useful for debug purposes. @@ -60,7 +61,7 @@ E.g. exceptional situations: couldn't syncronize accounts. -} | Error - deriving (Show, Read, Eq, Ord, Enum, Bounded, Ix) + deriving stock (Show, Read, Eq, Ord, Enum, Bounded, Ix) {- $pattern Instead of using full names of the constructors you can instead use one-letter diff --git a/test/Doctests.hs b/test/Doctests.hs --- a/test/Doctests.hs +++ b/test/Doctests.hs @@ -7,9 +7,10 @@ main :: IO () main = do - sourceFiles <- glob "co-log-core/src/**/*.hs" + sourceFiles <- glob "src/**/*.hs" doctest - $ "-XInstanceSigs" + $ "-XDerivingStrategies" + : "-XInstanceSigs" : "-XScopedTypeVariables" : "-XViewPatterns" : sourceFiles