co-log-core-0.3.2.5/0000755000000000000000000000000007346545000012156 5ustar0000000000000000co-log-core-0.3.2.5/CHANGELOG.md0000644000000000000000000001230107346545000013764 0ustar0000000000000000# Change log `co-log-core` uses [PVP Versioning][1]. The change log is available [on GitHub][2]. ## 0.3.2.5 — March 2, 2025 ## What's Changed * Allow `doctest-0.24`. **Full Changelog**: https://github.com/co-log/co-log-core/compare/v0.3.2.4...v0.3.2.5 ## 0.3.2.4 — January 5, 2025 ## What's Changed * Support ghc-9.12. **Full Changelog**: https://github.com/co-log/co-log-core/compare/v0.3.2.3...v0.3.2.4 ## 0.3.2.3 — December 15, 2024 ## What's Changed * Allow `doctest-0.23`. **Full Changelog**: https://github.com/co-log/co-log-core/compare/v0.3.2.2...v0.3.2.3 ## 0.3.2.2 — May 21, 2024 ## What's Changed * GA(deps): Bump actions/cache from 3 to 4 by @dependabot in https://github.com/co-log/co-log-core/pull/40 * Support ghc-9.10. by @alaendle in https://github.com/co-log/co-log-core/pull/41 **Full Changelog**: https://github.com/co-log/co-log-core/compare/v0.3.2.1...v0.3.2.2 ## 0.3.2.1 — Oct 20, 2023 ## What's Changed * Relax doctest boundaries. by @alaendle in [#32](https://github.com/co-log/co-log-core/pull/32) * GA(deps): Bump actions/checkout from 3 to 4 by @dependabot in [#35](https://github.com/co-log/co-log-core/pull/35) * Allow doctest-0.22 by @Vekhir in [#36](https://github.com/co-log/co-log-core/pull/36) * [#29] Support GHC 9.6 by @vrom911 in [#33](https://github.com/co-log/co-log-core/pull/33) * Support ghc-9.8 by @alaendle in [#37](https://github.com/co-log/co-log-core/pull/37) * Publish to hackage directly from GitHub by @alaendle in [#38](https://github.com/co-log/co-log-core/pull/38) ## New Contributors * @Vekhir made their first contribution in https://github.com/co-log/co-log-core/pull/36 **Full Changelog**: https://github.com/co-log/co-log-core/compare/v0.3.2.0...v0.3.2.1 ## 0.3.2.0 — Nov 2, 2022 - [#25](https://github.com/co-log/co-log-core/issues/25): Support GHC-9.4. ## 0.3.1.0 — Feb 15, 2022 - [#7](https://github.com/co-log/co-log-core/issues/7): Support GHC-9.2. - [#13](https://github.com/co-log/co-log-core/issues/13): Add `WithSeverity` and `mapSeverity` to `Colog.Severity`. ## 🎃 0.3.0.0 — Oct 29, 2021 - [#223](https://github.com/co-log/co-log/pull/223): Support GHC-9.0.1. - [#176](https://github.com/co-log/co-log/issues/176): Add `logFlush` action to flush the given `Handle`. **Breaking change:** All `withLog*File` functions how flush handle after logging each message. Now you'll see logs in the file immediately. **Migration guide:** If you rely on the previous behaviour, then copy-paste corresponding functions and remove flushing. - Update maintainers information to the new [Co-Log](https://github.com/co-log) organization. ## 0.2.1.1 — Apr 18, 2020 - [#186](https://github.com/co-log/co-log/issues/186): Support GHC-8.10.1. ## 0.2.1.0 — Jan 19, 2020 - [#139](https://github.com/co-log/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/co-log/co-log/issues/148): Support GHC-8.8.2. (by [@chshersh](https://github.com/chshersh)) - [#122](https://github.com/co-log/co-log/issues/122): Add the `separate` combinator. (by [@vrom911](https://github.com/vrom911)) - [#125](https://github.com/co-log/co-log/issues/125): Add monadic versions of contravariant functions. (by [@piq9117](https://github.com/piq9117)) - [#138](https://github.com/co-log/co-log/issues/138): Add `hoistLogAction` — higher-order transformation function. (by [@jiribenes](https://github.com/jiribenes)) - [#123](https://github.com/co-log/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/co-log/co-log/issues/85): Move `overLogAction` to `HasLog` typeclass - [#101](https://github.com/co-log/co-log/issues/101): Add `logActionL` lens with default implementation to `HasLog` type class. - [#99](https://github.com/co-log/co-log/issues/99): Add comonadic combinators: `duplicate` and `multiplicate`. - [#78](https://github.com/co-log/co-log/issues/78): Improve documentation significantly. ## 0.1.1 — Nov 15, 2018 - [#63](https://github.com/co-log/co-log/issues/63): Add `logPrint`, `logPrintStderr`, `logPrintHandle` and `withLogPrintFile` to `Colog.Core.IO`. - [#46](https://github.com/co-log/co-log/issues/46): Moves `logStringStdout`, `logStringStderr`, `logStringHandle`, `withLogStringFile` from `Colog.Actions` to `Colog.Core.IO`. - [#48](https://github.com/co-log/co-log/issues/48): Adds `liftLogIO` function. - [#49](https://github.com/co-log/co-log/issues/49): Add `<&` and `&>`operators for `unLogAction`. - [#47](https://github.com/co-log/co-log/issues/47): Add `doctest` tests. - [#13](https://github.com/co-log/co-log/issues/13): Add `.cabal` file description and improve documentation. - [#39](https://github.com/co-log/co-log/issues/39): Support GHC-8.2.2 and GHC-8.6.2. ## 0.1.0 - [#38](https://github.com/co-log/co-log/issues/38): Rename `cbind` to `cmapM`. - [#37](https://github.com/co-log/co-log/issues/37): Add `base` bounds. ## 0.0.0 - Initially created. [1]: https://pvp.haskell.org [2]: https://github.com/co-log/co-log-core/releases co-log-core-0.3.2.5/LICENSE0000644000000000000000000004052507346545000013171 0ustar0000000000000000Mozilla Public License Version 2.0 ================================== 1. Definitions -------------- 1.1. "Contributor" means each individual or legal entity that creates, contributes to the creation of, or owns Covered Software. 1.2. "Contributor Version" means the combination of the Contributions of others (if any) used by a Contributor and that particular Contributor's Contribution. 1.3. "Contribution" means Covered Software of a particular Contributor. 1.4. "Covered Software" means Source Code Form to which the initial Contributor has attached the notice in Exhibit A, the Executable Form of such Source Code Form, and Modifications of such Source Code Form, in each case including portions thereof. 1.5. "Incompatible With Secondary Licenses" means (a) that the initial Contributor has attached the notice described in Exhibit B to the Covered Software; or (b) that the Covered Software was made available under the terms of version 1.1 or earlier of the License, but not also under the terms of a Secondary License. 1.6. "Executable Form" means any form of the work other than Source Code Form. 1.7. "Larger Work" means a work that combines Covered Software with other material, in a separate file or files, that is not Covered Software. 1.8. "License" means this document. 1.9. "Licensable" means having the right to grant, to the maximum extent possible, whether at the time of the initial grant or subsequently, any and all of the rights conveyed by this License. 1.10. "Modifications" means any of the following: (a) any file in Source Code Form that results from an addition to, deletion from, or modification of the contents of Covered Software; or (b) any new file in Source Code Form that contains any Covered Software. 1.11. "Patent Claims" of a Contributor means any patent claim(s), including without limitation, method, process, and apparatus claims, in any patent Licensable by such Contributor that would be infringed, but for the grant of the License, by the making, using, selling, offering for sale, having made, import, or transfer of either its Contributions or its Contributor Version. 1.12. "Secondary License" means either the GNU General Public License, Version 2.0, the GNU Lesser General Public License, Version 2.1, the GNU Affero General Public License, Version 3.0, or any later versions of those licenses. 1.13. "Source Code Form" means the form of the work preferred for making modifications. 1.14. "You" (or "Your") means an individual or a legal entity exercising rights under this License. For legal entities, "You" includes any entity that controls, is controlled by, or is under common control with You. For purposes of this definition, "control" means (a) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (b) ownership of more than fifty percent (50%) of the outstanding shares or beneficial ownership of such entity. 2. License Grants and Conditions -------------------------------- 2.1. Grants Each Contributor hereby grants You a world-wide, royalty-free, non-exclusive license: (a) under intellectual property rights (other than patent or trademark) Licensable by such Contributor to use, reproduce, make available, modify, display, perform, distribute, and otherwise exploit its Contributions, either on an unmodified basis, with Modifications, or as part of a Larger Work; and (b) under Patent Claims of such Contributor to make, use, sell, offer for sale, have made, import, and otherwise transfer either its Contributions or its Contributor Version. 2.2. Effective Date The licenses granted in Section 2.1 with respect to any Contribution become effective for each Contribution on the date the Contributor first distributes such Contribution. 2.3. Limitations on Grant Scope The licenses granted in this Section 2 are the only rights granted under this License. No additional rights or licenses will be implied from the distribution or licensing of Covered Software under this License. Notwithstanding Section 2.1(b) above, no patent license is granted by a Contributor: (a) for any code that a Contributor has removed from Covered Software; or (b) for infringements caused by: (i) Your and any other third party's modifications of Covered Software, or (ii) the combination of its Contributions with other software (except as part of its Contributor Version); or (c) under Patent Claims infringed by Covered Software in the absence of its Contributions. This License does not grant any rights in the trademarks, service marks, or logos of any Contributor (except as may be necessary to comply with the notice requirements in Section 3.4). 2.4. Subsequent Licenses No Contributor makes additional grants as a result of Your choice to distribute the Covered Software under a subsequent version of this License (see Section 10.2) or under the terms of a Secondary License (if permitted under the terms of Section 3.3). 2.5. Representation Each Contributor represents that the Contributor believes its Contributions are its original creation(s) or it has sufficient rights to grant the rights to its Contributions conveyed by this License. 2.6. Fair Use This License is not intended to limit any rights You have under applicable copyright doctrines of fair use, fair dealing, or other equivalents. 2.7. Conditions Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted in Section 2.1. 3. Responsibilities ------------------- 3.1. Distribution of Source Form All distribution of Covered Software in Source Code Form, including any Modifications that You create or to which You contribute, must be under the terms of this License. You must inform recipients that the Source Code Form of the Covered Software is governed by the terms of this License, and how they can obtain a copy of this License. You may not attempt to alter or restrict the recipients' rights in the Source Code Form. 3.2. Distribution of Executable Form If You distribute Covered Software in Executable Form then: (a) such Covered Software must also be made available in Source Code Form, as described in Section 3.1, and You must inform recipients of the Executable Form how they can obtain a copy of such Source Code Form by reasonable means in a timely manner, at a charge no more than the cost of distribution to the recipient; and (b) You may distribute such Executable Form under the terms of this License, or sublicense it under different terms, provided that the license for the Executable Form does not attempt to limit or alter the recipients' rights in the Source Code Form under this License. 3.3. Distribution of a Larger Work You may create and distribute a Larger Work under terms of Your choice, provided that You also comply with the requirements of this License for the Covered Software. If the Larger Work is a combination of Covered Software with a work governed by one or more Secondary Licenses, and the Covered Software is not Incompatible With Secondary Licenses, this License permits You to additionally distribute such Covered Software under the terms of such Secondary License(s), so that the recipient of the Larger Work may, at their option, further distribute the Covered Software under the terms of either this License or such Secondary License(s). 3.4. Notices You may not remove or alter the substance of any license notices (including copyright notices, patent notices, disclaimers of warranty, or limitations of liability) contained within the Source Code Form of the Covered Software, except that You may alter any license notices to the extent required to remedy known factual inaccuracies. 3.5. Application of Additional Terms You may choose to offer, and to charge a fee for, warranty, support, indemnity or liability obligations to one or more recipients of Covered Software. However, You may do so only on Your own behalf, and not on behalf of any Contributor. You must make it absolutely clear that any such warranty, support, indemnity, or liability obligation is offered by You alone, and You hereby agree to indemnify every Contributor for any liability incurred by such Contributor as a result of warranty, support, indemnity or liability terms You offer. You may include additional disclaimers of warranty and limitations of liability specific to any jurisdiction. 4. Inability to Comply Due to Statute or Regulation --------------------------------------------------- If it is impossible for You to comply with any of the terms of this License with respect to some or all of the Covered Software due to statute, judicial order, or regulation then You must: (a) comply with the terms of this License to the maximum extent possible; and (b) describe the limitations and the code they affect. Such description must be placed in a text file included with all distributions of the Covered Software under this License. Except to the extent prohibited by statute or regulation, such description must be sufficiently detailed for a recipient of ordinary skill to be able to understand it. 5. Termination -------------- 5.1. The rights granted under this License will terminate automatically if You fail to comply with any of its terms. However, if You become compliant, then the rights granted under this License from a particular Contributor are reinstated (a) provisionally, unless and until such Contributor explicitly and finally terminates Your grants, and (b) on an ongoing basis, if such Contributor fails to notify You of the non-compliance by some reasonable means prior to 60 days after You have come back into compliance. Moreover, Your grants from a particular Contributor are reinstated on an ongoing basis if such Contributor notifies You of the non-compliance by some reasonable means, this is the first time You have received notice of non-compliance with this License from such Contributor, and You become compliant prior to 30 days after Your receipt of the notice. 5.2. If You initiate litigation against any entity by asserting a patent infringement claim (excluding declaratory judgment actions, counter-claims, and cross-claims) alleging that a Contributor Version directly or indirectly infringes any patent, then the rights granted to You by any and all Contributors for the Covered Software under Section 2.1 of this License shall terminate. 5.3. In the event of termination under Sections 5.1 or 5.2 above, all end user license agreements (excluding distributors and resellers) which have been validly granted by You or Your distributors under this License prior to termination shall survive termination. ************************************************************************ * * * 6. Disclaimer of Warranty * * ------------------------- * * * * Covered Software is provided under this License on an "as is" * * basis, without warranty of any kind, either expressed, implied, or * * statutory, including, without limitation, warranties that the * * Covered Software is free of defects, merchantable, fit for a * * particular purpose or non-infringing. The entire risk as to the * * quality and performance of the Covered Software is with You. * * Should any Covered Software prove defective in any respect, You * * (not any Contributor) assume the cost of any necessary servicing, * * repair, or correction. This disclaimer of warranty constitutes an * * essential part of this License. No use of any Covered Software is * * authorized under this License except under this disclaimer. * * * ************************************************************************ ************************************************************************ * * * 7. Limitation of Liability * * -------------------------- * * * * Under no circumstances and under no legal theory, whether tort * * (including negligence), contract, or otherwise, shall any * * Contributor, or anyone who distributes Covered Software as * * permitted above, be liable to You for any direct, indirect, * * special, incidental, or consequential damages of any character * * including, without limitation, damages for lost profits, loss of * * goodwill, work stoppage, computer failure or malfunction, or any * * and all other commercial damages or losses, even if such party * * shall have been informed of the possibility of such damages. This * * limitation of liability shall not apply to liability for death or * * personal injury resulting from such party's negligence to the * * extent applicable law prohibits such limitation. Some * * jurisdictions do not allow the exclusion or limitation of * * incidental or consequential damages, so this exclusion and * * limitation may not apply to You. * * * ************************************************************************ 8. Litigation ------------- Any litigation relating to this License may be brought only in the courts of a jurisdiction where the defendant maintains its principal place of business and such litigation shall be governed by laws of that jurisdiction, without reference to its conflict-of-law provisions. Nothing in this Section shall prevent a party's ability to bring cross-claims or counter-claims. 9. Miscellaneous ---------------- This License represents the complete agreement concerning the subject matter hereof. If any provision of this License is held to be unenforceable, such provision shall be reformed only to the extent necessary to make it enforceable. Any law or regulation which provides that the language of a contract shall be construed against the drafter shall not be used to construe this License against a Contributor. 10. Versions of the License --------------------------- 10.1. New Versions Mozilla Foundation is the license steward. Except as provided in Section 10.3, no one other than the license steward has the right to modify or publish new versions of this License. Each version will be given a distinguishing version number. 10.2. Effect of New Versions You may distribute the Covered Software under the terms of the version of the License under which You originally received the Covered Software, or under the terms of any subsequent version published by the license steward. 10.3. Modified Versions If you create software not governed by this License, and you want to create a new license for such software, you may create and use a modified version of this License if you rename the license and remove any references to the name of the license steward (except to note that such modified license differs from this License). 10.4. Distributing Source Code Form that is Incompatible With Secondary Licenses If You choose to distribute Source Code Form that is Incompatible With Secondary Licenses under the terms of this version of the License, the notice described in Exhibit B of this License must be attached. Exhibit A - Source Code Form License Notice ------------------------------------------- This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. If a copy of the MPL was not distributed with this file, You can obtain one at http://mozilla.org/MPL/2.0/. If it is not possible or desirable to put the notice in a particular file, then You may include the notice in a location (such as a LICENSE file in a relevant directory) where a recipient would be likely to look for such a notice. You may add additional accurate notices of copyright ownership. Exhibit B - "Incompatible With Secondary Licenses" Notice --------------------------------------------------------- This Source Code Form is "Incompatible With Secondary Licenses", as defined by the Mozilla Public License, v. 2.0. co-log-core-0.3.2.5/README.md0000644000000000000000000000312107346545000013432 0ustar0000000000000000# co-log-core ![Co-logo](https://user-images.githubusercontent.com/8126674/80955687-92f21a80-8df7-11ea-90d3-422dafdc8391.png) [![GitHub CI](https://github.com/co-log/co-log-core/workflows/CI/badge.svg)](https://github.com/co-log/co-log-core/actions) [![Hackage][hk-img-core]][hk-core] [![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](https://github.com/co-log/co-log/blob/main/LICENSE) `co-log-core` is a lightweight package that provides core types and functions to work with the @LogAction@ data type which is both simple and powerful. ## How to use `co-log-core` is compatible with the following GHC versions - [supported versions](https://matrix.hackage.haskell.org/#/package/co-log-core) In order to start using `co-log-core` in your project, you will need to set it up with these steps: 1. Add the dependency on `co-log-core` in your project's `.cabal` file. For this, you should modify the `build-depends` section according to the below section: ```haskell build-depends: base ^>= LATEST_SUPPORTED_BASE , co-log-core ^>= LATEST_VERSION ``` 2. To use this package, refer to the below example. ```haskell module Main (main) where import Prelude hiding (log) import Colog.Core (LogAction, logStringStdout, (<&)) app :: LogAction IO String -> IO () app log = do log <& "Starting app..." log <& "Finishing app..." main :: IO () main = app logStringStdout ``` [hk-img-core]: https://img.shields.io/hackage/v/co-log-core.svg?logo=haskell [hk-core]: https://hackage.haskell.org/package/co-log-core co-log-core-0.3.2.5/co-log-core.cabal0000644000000000000000000000776707346545000015271 0ustar0000000000000000cabal-version: 2.4 name: co-log-core version: 0.3.2.5 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. . @ __newtype__ LogAction m msg = LogAction \ { unLogAction :: msg -> m () \ } @ . The ideas behind this package are described in the following blog post: . * [co-log: Composable Contravariant Combinatorial Comonadic Configurable Convenient Logging](https://kowainik.github.io/posts/2018-09-25-co-log) . See the following packages for different implementations based on @co-log-core@: . * [co-log](http://hackage.haskell.org/package/co-log): taggless final implementations. * [co-log-polysemy](http://hackage.haskell.org/package/co-log-polysemy): extensible effects implementation based on @polysemy@. homepage: https://github.com/co-log/co-log-core bug-reports: https://github.com/co-log/co-log-core/issues license: MPL-2.0 license-file: LICENSE author: Dmitrii Kovanikov maintainer: Co-Log copyright: 2018-2020 Kowainik, 2021-2025 Co-Log category: Logging, Contravariant, Comonad build-type: Simple stability: stable extra-doc-files: CHANGELOG.md README.md tested-with: GHC == 8.2.2 GHC == 8.4.4 GHC == 8.6.5 GHC == 8.8.4 GHC == 8.10.7 GHC == 9.0.2 GHC == 9.2.8 GHC == 9.4.8 GHC == 9.6.6 GHC == 9.8.4 GHC == 9.10.1 GHC == 9.12.1 source-repository head type: git location: https://github.com/co-log/co-log-core.git common common-options build-depends: base >= 4.10.1.0 && < 4.22 ghc-options: -Wall -Wcompat -Widentities -Wincomplete-uni-patterns -Wincomplete-record-updates -Wredundant-constraints if impl(ghc >= 8.2) ghc-options: -fhide-source-paths if impl(ghc >= 8.4) ghc-options: -Wmissing-export-lists -Wpartial-fields if impl(ghc >= 8.8) 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 if impl(ghc >= 9.4) ghc-options: -Wredundant-strictness-flags -Wforall-identifier default-language: Haskell2010 default-extensions: ConstraintKinds DeriveFunctor DeriveTraversable DeriveGeneric DerivingStrategies GeneralizedNewtypeDeriving InstanceSigs LambdaCase OverloadedStrings RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections 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 hs-source-dirs: test main-is: Doctests.hs build-depends: doctest >= 0.16.0 && < 0.25 , Glob ^>= 0.10.0 co-log-core-0.3.2.5/src/Colog/0000755000000000000000000000000007346545000014010 5ustar0000000000000000co-log-core-0.3.2.5/src/Colog/Core.hs0000644000000000000000000000254607346545000015243 0ustar0000000000000000{- | Module : Colog.Core Copyright : (c) 2018-2020 Kowainik, 2021-2025 Co-Log SPDX-License-Identifier : MPL-2.0 Maintainer : Co-Log Stability : Stable Portability : Portable Exports all core functionality. @co-log-core@ is a lightweight package that defines only core data type and various combinators to work with it. Fundamentals of @co-log-core@ are based on the following data type: @ __newtype__ LogAction m msg = LogAction { unLogAction :: msg -> m () } @ This data type provides extremely composable and flexible interface by having many instances of the standard algebraic data types. The package has the following structure: * __"Colog.Core.Action":__ definition of the main data type and its combinators. * __"Colog.Core.Class":__ 'HasLog' typeclass that describes how different values (e.g. application environment) can store and modify 'LogAction'. * __"Colog.Core.IO":__ basic loggers that work with 'Control.Monad.IO.Class.MonadIO' and 'String'. * __"Colog.Core.Severity":__ logger severity. -} module Colog.Core ( module Colog.Core.Action , module Colog.Core.Class , module Colog.Core.IO , module Colog.Core.Severity ) where import Colog.Core.Action import Colog.Core.Class import Colog.Core.IO import Colog.Core.Severity co-log-core-0.3.2.5/src/Colog/Core/0000755000000000000000000000000007346545000014700 5ustar0000000000000000co-log-core-0.3.2.5/src/Colog/Core/Action.hs0000644000000000000000000005103007346545000016450 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {- | Module : Colog.Core.Action Copyright : (c) 2018-2020 Kowainik, 2021-2025 Co-Log SPDX-License-Identifier : MPL-2.0 Maintainer : Co-Log Stability : Stable Portability : Portable Implements core data types and combinators for logging actions. -} module Colog.Core.Action ( -- * Core type and instances LogAction (..) , (<&) , (&>) -- * 'Semigroup' combinators , foldActions -- * Contravariant combinators -- $contravariant , cfilter , cfilterM , cmap , (>$<) , cmapMaybe , cmapMaybeM , (Colog.Core.Action.>$) , cmapM -- * Divisible combinators -- $divisible , divide , divideM , conquer , (>*<) , (>*) , (*<) -- * Decidable combinators -- $decidable , lose , choose , chooseM , (>|<) -- * Comonadic combinators -- $comonad , extract , extend , (=>>) , (<<=) , duplicate , multiplicate , separate -- * Higher-order combinators , hoistLogAction ) where import Control.Monad (when, (<=<), (>=>)) import Data.Coerce (coerce) 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 #endif {- $setup >>> import Colog.Core.IO -} ---------------------------------------------------------------------------- -- Core data type with instances ---------------------------------------------------------------------------- {- | Polymorphic and very general logging action type. * @__msg__@ type variables is an input for logger. It can be 'Text' or custom logging messsage with different fields that you want to format in future. * @__m__@ type variable is for monadic action inside which logging is happening. It can be either 'IO' or some custom pure monad. Key design point here is that 'LogAction' is: * 'Semigroup' * 'Monoid' * 'Data.Functor.Contravariant.Contravariant' * 'Data.Functor.Contravariant.Divisible.Divisible' * 'Data.Functor.Contravariant.Divisible.Decidable' * 'Control.Comonad.Comonad' -} newtype LogAction m msg = LogAction { unLogAction :: msg -> m () } {- | This instance allows you to join multiple logging actions into single one. For example, if you have two actions like these: @ logToStdout :: 'LogAction' IO String -- outputs String to terminal logToFile :: 'LogAction' IO String -- appends String to some file @ You can create new 'LogAction' that perform both actions one after another using 'Semigroup': @ logToBoth :: 'LogAction' IO String -- outputs String to both terminal and some file logToBoth = logToStdout <> logToFile @ -} instance Applicative m => Semigroup (LogAction m a) where (<>) :: LogAction m a -> LogAction m a -> LogAction m a LogAction action1 <> LogAction action2 = LogAction $ \a -> action1 a *> action2 a {-# INLINE (<>) #-} sconcat :: NonEmpty (LogAction m a) -> LogAction m a sconcat = foldActions {-# INLINE sconcat #-} stimes :: Integral b => b -> LogAction m a -> LogAction m a stimes = stimesMonoid {-# INLINE stimes #-} instance Applicative m => Monoid (LogAction m a) where mappend :: LogAction m a -> LogAction m a -> LogAction m a mappend = (<>) {-# INLINE mappend #-} mempty :: LogAction m a mempty = LogAction $ \_ -> pure () {-# INLINE mempty #-} mconcat :: [LogAction m a] -> LogAction m a mconcat = foldActions {-# INLINE mconcat #-} #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: @ action <& msg1 <& msg2 @ doesn't make sense. Instead you want: @ action <& msg1 \>\> action <& msg2 @ In addition, because '<&' has higher precedence than the other operators in this module, the following: @ f >$< action <& msg @ is equivalent to: @ (f >$< action) <& msg @ -} infix 5 <& (<&) :: LogAction m msg -> msg -> m () (<&) = coerce {-# INLINE (<&) #-} {- | A flipped version of '<&'. It shares the same precedence as '<&', so make sure to surround lower precedence operators in parentheses: @ msg &> (f >$< action) @ -} infix 5 &> (&>) :: msg -> LogAction m msg -> m () (&>) = flip (<&) {-# INLINE (&>) #-} {- | Joins some 'Foldable' of 'LogAction's into single 'LogAction' using 'Semigroup' instance for 'LogAction'. This is basically specialized version of 'Data.Foldable.fold' function. -} foldActions :: (Foldable t, Applicative m) => t (LogAction m a) -> LogAction m a foldActions actions = LogAction $ \a -> for_ actions $ \(LogAction action) -> action a {-# INLINE foldActions #-} {-# SPECIALIZE foldActions :: Applicative m => [LogAction m a] -> LogAction m a #-} {-# SPECIALIZE foldActions :: Applicative m => NonEmpty (LogAction m a) -> LogAction m a #-} ---------------------------------------------------------------------------- -- Contravariant combinators ---------------------------------------------------------------------------- {- $contravariant Combinators that implement interface in the spirit of the following typeclass: @ __class__ Contravariant f __where__ contramap :: (a -> b) -> f b -> f a @ -} {- | Takes predicate and performs given logging action only if predicate returns 'True' on input logging message. -} cfilter :: Applicative m => (msg -> Bool) -> LogAction m msg -> LogAction m msg 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 @ __data__ LogRecord = LR { lrName :: LoggerName , lrMessage :: Text } @ and you need to provide 'LogAction' which consumes @LogRecord@ @ logRecordAction :: 'LogAction' m LogRecord @ when you only have action that consumes 'Text' @ logTextAction :: 'LogAction' m Text @ With 'cmap' you can do the following: @ logRecordAction :: 'LogAction' m LogRecord logRecordAction = 'cmap' lrMesssage logTextAction @ This action will print only @lrMessage@ from @LogRecord@. But if you have formatting function like this: @ formatLogRecord :: LogRecord -> Text @ you can apply it instead of @lrMessage@ to log formatted @LogRecord@ as 'Text'. -} cmap :: (a -> b) -> LogAction m b -> LogAction m a cmap f (LogAction action) = LogAction (action . f) {-# INLINE cmap #-} {- | Operator version of 'cmap'. >>> 1 &> (show >$< logStringStdout) 1 -} infixr 3 >$< (>$<) :: (a -> b) -> LogAction m b -> LogAction m a (>$<) = cmap {-# INLINE (>$<) #-} -- | 'cmap' for convertions that may fail cmapMaybe :: Applicative m => (a -> Maybe b) -> LogAction m b -> LogAction m a 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. >>> "Hello?" &> ("OUT OF SERVICE" >$ logStringStdout) OUT OF SERVICE >>> ("OUT OF SERVICE" >$ logStringStdout) <& 42 OUT OF SERVICE -} infixl 4 >$ (>$) :: b -> LogAction m b -> LogAction m a (>$) b (LogAction action) = LogAction (\_ -> action b) {- | 'cmapM' combinator is similar to 'cmap' but allows to call monadic functions (functions that require extra context) to extend consumed value. Consider the following example. You have this logging record: @ __data__ LogRecord = LR { lrTime :: UTCTime , lrMessage :: Text } @ and you also have logging consumer inside 'IO' for such record: @ logRecordAction :: 'LogAction' IO LogRecord @ But you need to return consumer only for 'Text' messages: @ logTextAction :: 'LogAction' IO Text @ If you have function that can extend 'Text' to @LogRecord@ like the function below: @ withTime :: 'Text' -> 'IO' LogRecord withTime msg = __do__ time <- getCurrentTime pure (LR time msg) @ you can achieve desired behavior with 'cmapM' in the following way: @ logTextAction :: 'LogAction' IO Text logTextAction = 'cmapM' withTime myAction @ -} cmapM :: Monad m => (a -> m b) -> LogAction m b -> LogAction m a cmapM f (LogAction action) = LogAction (f >=> action) {-# INLINE cmapM #-} ---------------------------------------------------------------------------- -- Divisible combinators ---------------------------------------------------------------------------- {- $divisible Combinators that implement interface in the spirit of the following typeclass: @ __class__ Contravariant f => Divisible f __where__ conquer :: f a divide :: (a -> (b, c)) -> f b -> f c -> f a @ -} {- | @divide@ combinator from @Divisible@ type class. >>> logInt = LogAction print >>> "ABC" &> divide (\s -> (s, length s)) logStringStdout logInt ABC 3 -} divide :: (Applicative m) => (a -> (b, c)) -> LogAction m b -> LogAction m c -> LogAction m a divide f (LogAction actionB) (LogAction actionC) = LogAction $ \(f -> (b, c)) -> 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: >>> conquer <& "hello?" >>> "hello?" &> conquer -} conquer :: Applicative m => LogAction m a conquer = mempty {-# INLINE conquer #-} {- | Operator version of @'divide' 'id'@. >>> logInt = LogAction print >>> (logStringStdout >*< logInt) <& ("foo", 1) foo 1 >>> (logInt >*< logStringStdout) <& (1, "foo") 1 foo -} infixr 4 >*< (>*<) :: (Applicative m) => LogAction m a -> LogAction m b -> LogAction m (a, b) (LogAction actionA) >*< (LogAction actionB) = LogAction $ \(a, b) -> actionA a *> actionB b {-# INLINE (>*<) #-} {-| Perform a constant log action after another. >>> logHello = LogAction (const (putStrLn "Hello!")) >>> "Greetings!" &> (logStringStdout >* logHello) Greetings! Hello! -} infixr 4 >* (>*) :: Applicative m => LogAction m a -> LogAction m () -> LogAction m a (LogAction actionA) >* (LogAction actionB) = LogAction $ \a -> actionA a *> actionB () {-# INLINE (>*) #-} -- | A flipped version of '>*' infixr 4 *< (*<) :: Applicative m => LogAction m () -> LogAction m a -> LogAction m a (LogAction actionA) *< (LogAction actionB) = LogAction $ \a -> actionA () *> actionB a {-# INLINE (*<) #-} ---------------------------------------------------------------------------- -- Decidable combinators ---------------------------------------------------------------------------- {- $decidable Combinators that implement interface in the spirit of the following typeclass: @ __class__ Divisible f => Decidable f __where__ lose :: (a -> Void) -> f a choose :: (a -> Either b c) -> f b -> f c -> f a @ -} -- | @lose@ combinator from @Decidable@ type class. lose :: (a -> Void) -> LogAction m a lose f = LogAction (absurd . f) {-# INLINE lose #-} {- | @choose@ combinator from @Decidable@ type class. >>> logInt = LogAction print >>> f = choose (\a -> if a < 0 then Left "Negative" else Right a) >>> f logStringStdout logInt <& 1 1 >>> f logStringStdout logInt <& (-1) Negative -} choose :: (a -> Either b c) -> LogAction m b -> LogAction m c -> LogAction m a 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")) >>> Left 1 &> (dontPrintInt >|< logStringStdout) Not printing Int >>> (dontPrintInt >|< logStringStdout) <& Right ":)" :) -} infixr 3 >|< (>|<) :: LogAction m a -> LogAction m b -> LogAction m (Either a b) (LogAction actionA) >|< (LogAction actionB) = LogAction (either actionA actionB) {-# INLINE (>|<) #-} ---------------------------------------------------------------------------- -- Comonadic combinators ---------------------------------------------------------------------------- {- $comonad Combinators that implement interface in the spirit of the following typeclass: @ __class__ Functor w => Comonad w __where__ extract :: w a -> a duplicate :: w a -> w (w a) extend :: (w a -> b) -> w a -> w b @ -} {- | If @msg@ is 'Monoid' then 'extract' performs given log action by passing 'mempty' to it. >>> logPrint :: LogAction IO [Int]; logPrint = LogAction print >>> extract logPrint [] -} extract :: Monoid msg => LogAction m msg -> m () extract action = unLogAction action mempty {-# INLINE extract #-} -- TODO: write better motivation for comonads {- | This is a /comonadic extend/. It allows you to chain different transformations on messages. >>> f (LogAction l) = l ".f1" *> l ".f2" >>> g (LogAction l) = l ".g" >>> logStringStdout <& "foo" foo >>> extend f logStringStdout <& "foo" foo.f1 foo.f2 >>> (extend g $ extend f logStringStdout) <& "foo" foo.g.f1 foo.g.f2 >>> (logStringStdout =>> f =>> g) <& "foo" foo.g.f1 foo.g.f2 -} extend :: Semigroup msg => (LogAction m msg -> m ()) -> LogAction m msg -> LogAction m msg extend f (LogAction action) = LogAction $ \m -> f $ LogAction $ \m' -> action (m <> m') {-# INLINE extend #-} -- | 'extend' with the arguments swapped. Dual to '>>=' for a 'Monad'. infixl 1 =>> (=>>) :: Semigroup msg => LogAction m msg -> (LogAction m msg -> m ()) -> LogAction m msg (=>>) = flip extend {-# INLINE (=>>) #-} -- | 'extend' in operator form. infixr 1 <<= (<<=) :: Semigroup msg => (LogAction m msg -> m ()) -> LogAction m msg -> LogAction m msg (<<=) = extend {-# INLINE (<<=) #-} {- | Converts any 'LogAction' that can log single message to the 'LogAction' that can log two messages. The new 'LogAction' behaves in the following way: 1. Joins two messages of type @msg@ using '<>' operator from 'Semigroup'. 2. Passes resulted message to the given 'LogAction'. >>> :{ let logger :: LogAction IO [Int] logger = logPrint in duplicate logger <& ([3, 4], [42, 10]) :} [3,4,42,10] __Implementation note:__ True and fair translation of the @duplicate@ function from the 'Control.Comonad.Comonad' interface should result in the 'LogAction' of the following form: @ msg -> msg -> m () @ In order to capture this behavior, 'duplicate' should have the following type: @ duplicate :: Semigroup msg => LogAction m msg -> LogAction (Compose ((->) msg) m) msg @ However, it's quite awkward to work with such type. It's a known fact that the following two types are isomorphic (see functions 'curry' and 'uncurry'): @ a -> b -> c (a, b) -> c @ So using this fact we can come up with the simpler interface. -} duplicate :: forall msg m . Semigroup msg => LogAction m msg -> LogAction m (msg, msg) duplicate (LogAction l) = LogAction $ \(msg1, msg2) -> l (msg1 <> msg2) {-# INLINE duplicate #-} {- | Like 'duplicate' but why stop on a pair of two messages if you can log any 'Foldable' of messages? >>> :{ let logger :: LogAction IO [Int] logger = logPrint in multiplicate logger <& replicate 5 [1..3] :} [1,2,3,1,2,3,1,2,3,1,2,3,1,2,3] -} multiplicate :: forall f msg m . (Foldable f, Monoid msg) => LogAction m msg -> LogAction m (f msg) multiplicate (LogAction l) = LogAction $ \msgs -> l (fold msgs) {-# 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 #-} co-log-core-0.3.2.5/src/Colog/Core/Class.hs0000644000000000000000000000661707346545000016313 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-} {- | Module : Colog.Core.Class Copyright : (c) 2018-2020 Kowainik, 2021-2025 Co-Log SPDX-License-Identifier : MPL-2.0 Maintainer : Co-Log Stability : Stable Portability : Portable Provides type class for values that has access to 'LogAction'. -} module Colog.Core.Class ( HasLog (..) -- * Lens -- $lens , Lens' ) where import Colog.Core.Action (LogAction) import Data.Functor.Const (Const (..)) -- to inline lens better {- HLINT ignore "Redundant lambda" -} {- | This types class contains simple pair of getter-setter and related functions. It also provides the useful lens 'logActionL' with the default implementation using type class methods. The default one could be easily overritten under your instances. Every instance of the this typeclass should satisfy the following laws: 1. __Set-Get:__ @'getLogAction' ('setLogAction' l env) ≡ l@ 2. __Get-Set:__ @'setLogAction' ('getLogAction' env) env ≡ env@ 3. __Set-Set:__ @'setLogAction' l2 ('setLogAction' l1 env) ≡ 'setLogAction' l2 env@ 4. __Set-Over:__ @'overLogAction' f env ≡ 'setLogAction' (f $ 'getLogAction' env) env@ -} class HasLog env msg m where {-# 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 setLogAction = overLogAction . const {-# INLINE setLogAction #-} -- | Applies function to the 'LogAction' inside the environment. overLogAction :: (LogAction m msg -> LogAction m msg) -> env -> env overLogAction f env = setLogAction (f $ getLogAction env) env {-# INLINE overLogAction #-} -- | Lens for 'LogAction' inside the environment. logActionL :: Lens' env (LogAction m msg) logActionL = lens getLogAction (flip setLogAction) {-# INLINE logActionL #-} instance HasLog (LogAction m msg) msg m where getLogAction :: LogAction m msg -> LogAction m msg getLogAction = id {-# INLINE getLogAction #-} setLogAction :: LogAction m msg -> LogAction m msg -> LogAction m msg setLogAction = const {-# INLINE setLogAction #-} overLogAction :: (LogAction m msg -> LogAction m msg) -> LogAction m msg -> LogAction m msg overLogAction = id {-# INLINE overLogAction #-} logActionL :: Lens' (LogAction m msg) (LogAction m msg) logActionL = \f s -> s <$ f s {-# INLINE logActionL #-} ---------------------------------------------------------------------------- -- Lens ---------------------------------------------------------------------------- {- $lens To keep @co-log-core@ a lightweight library it was decided to introduce local 'Lens'' type alias as it doesn't harm. -} {- | The monomorphic lenses which don't change the type of the container (or of the value inside). -} type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s -- | Creates 'Lens'' from the getter and setter. lens :: (s -> a) -> (s -> a -> s) -> Lens' s a lens getter setter = \f s -> setter s <$> f (getter s) {-# INLINE lens #-} co-log-core-0.3.2.5/src/Colog/Core/IO.hs0000644000000000000000000001402207346545000015542 0ustar0000000000000000{-# LANGUAGE CPP #-} {- | Module : Colog.Core.IO Copyright : (c) 2018-2020 Kowainik, 2021-2025 Co-Log SPDX-License-Identifier : MPL-2.0 Maintainer : Co-Log Stability : Stable Portability : Portable Introduces logging actions working in 'MonadIO'. These actions are very basic and inefficient because they use the 'String' data type. If you don't want to have extra dependencies and performance of logging is not the bottleneck of your application, then these functions should be enough. Otherwise use functions from the "Colog.Actions" module from the @co-log@ package. -} module Colog.Core.IO ( -- * 'String' actions logStringStdout , logStringStderr , logStringHandle , withLogStringFile -- * 'Show' actions , logPrint , logPrintStderr , logPrintHandle , withLogPrintFile -- * Various combinators , liftLogIO , logFlush ) where import Colog.Core.Action (LogAction (..)) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Semigroup ((<>)) import System.IO (Handle, IOMode (AppendMode), hFlush, hPrint, hPutStrLn, stderr, withFile) {- $setup >>> import Colog.Core.Action -} ---------------------------------------------------------------------------- -- String ---------------------------------------------------------------------------- {- | Action that prints 'String' to stdout. This action does not flush the output buffer. If buffering mode is block buffering, the effect of this action can be delayed. >>> logStringStdout <& "foo" foo -} logStringStdout :: MonadIO m => LogAction m String logStringStdout = LogAction (liftIO . putStrLn) {-# INLINE logStringStdout #-} {-# SPECIALIZE logStringStdout :: LogAction IO String #-} {- | Action that prints 'String' to stderr. This action does not flush the output buffer. If buffering mode is block buffering, the effect of this action can be delayed. >>> logStringStderr <& "foo" foo -} logStringStderr :: MonadIO m => LogAction m String logStringStderr = logStringHandle stderr {-# INLINE logStringStderr #-} {-# SPECIALIZE logStringStderr :: LogAction IO String #-} {- | Action that prints 'String' to 'Handle'. This action does not flush the output buffer. If buffering mode is block buffering, the effect of this action can be delayed. >>> logStringHandle stderr <& "foo" foo -} logStringHandle :: MonadIO m => Handle -> LogAction m String logStringHandle handle = LogAction $ liftIO . hPutStrLn handle {-# INLINE logStringHandle #-} {-# SPECIALIZE logStringHandle :: Handle -> LogAction IO String #-} {- | Action that prints 'String' to file. Instead of returning 'LogAction' it's implemented in continuation-passing style because it's more efficient to open file only once at the start of the application and write to 'Handle' instead of opening file each time we need to write to it. Opens file in 'AppendMode'. Automatically flushes the output buffer. #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 $ \handle -> action (logStringHandle handle <> logFlush handle) {-# INLINE withLogStringFile #-} {-# SPECIALIZE withLogStringFile :: FilePath -> (LogAction IO String -> IO r) -> IO r #-} ---------------------------------------------------------------------------- -- Show ---------------------------------------------------------------------------- {- | Action that prints to stdout using 'Show'. This action does not flush the output buffer. If buffering mode is block buffering, the effect of this action can be delayed. >>> logPrint <& 5 5 -} logPrint :: forall a m . (Show a, MonadIO m) => LogAction m a logPrint = LogAction $ liftIO . print {-# INLINE logPrint #-} {-# SPECIALIZE logPrint :: Show a => LogAction IO a #-} {- | Action that prints to stderr using 'Show'. This action does not flush the output buffer. If buffering mode is block buffering, the effect of this action can be delayed. >>> logPrintStderr <& 5 5 -} logPrintStderr :: forall a m . (Show a, MonadIO m) => LogAction m a logPrintStderr = logPrintHandle stderr {-# INLINE logPrintStderr #-} {-# SPECIALIZE logPrintStderr :: Show a => LogAction IO a #-} {- | Action that prints to a 'Handle' using 'Show'. This action does not flush the output buffer. If buffering mode is block buffering, the effect of this action can be delayed. >>> logPrintHandle stderr <& 5 5 -} logPrintHandle :: forall a m . (Show a, MonadIO m) => Handle -> LogAction m a logPrintHandle handle = LogAction $ liftIO . hPrint handle {-# INLINE logPrintHandle #-} {-# SPECIALIZE logPrintHandle :: Show a => Handle -> LogAction IO a #-} {- | Action that prints to a file using 'Show'. See 'withLogStringFile' for details. -} withLogPrintFile :: forall a m r . (Show a, MonadIO m) => FilePath -> (LogAction m a -> IO r) -> IO r withLogPrintFile path action = withFile path AppendMode $ \handle -> action (logPrintHandle handle <> logFlush handle) {-# INLINE withLogPrintFile #-} {-# SPECIALIZE withLogPrintFile :: Show a => FilePath -> (LogAction IO a -> IO r) -> IO r #-} ---------------------------------------------------------------------------- -- Misc ---------------------------------------------------------------------------- {- | Lifts a LogAction over IO into a more general Monad. >>> logToStdout = LogAction putStrLn >>> liftLogIO logToStdout <& "foo" foo -} liftLogIO :: MonadIO m => LogAction IO msg -> LogAction m msg liftLogIO (LogAction action) = LogAction (liftIO . action) {-# INLINE liftLogIO #-} {- | This action can be used in combination with other actions to flush a handle every time you log anything. @since 0.3.0.0 -} logFlush :: MonadIO m => Handle -> LogAction m a logFlush handle = LogAction $ const $ liftIO $ hFlush handle {-# INLINE logFlush #-} {-# SPECIALIZE logFlush :: Handle -> LogAction IO a #-} co-log-core-0.3.2.5/src/Colog/Core/Severity.hs0000644000000000000000000001176007346545000017053 0ustar0000000000000000{-# LANGUAGE PatternSynonyms #-} {- | Module : Colog.Core.Severity Copyright : (c) 2018-2020 Kowainik, 2021-2025 Co-Log SPDX-License-Identifier : MPL-2.0 Maintainer : Co-Log Stability : Stable Portability : Portable This module introduces 'Severity' data type for expressing how severe the message is. Also, it contains useful functions and patterns for work with 'Severity'. +-----------+---------+-----------------------------------------+-----------------------------+ | Severity | Pattern | Meaning | Example | +===========+=========+=========================================+=============================+ | 'Debug' | 'D' | Information useful for debug purposes | Internal function call logs | +-----------+---------+-----------------------------------------+-----------------------------+ | 'Info' | 'I' | Normal operational information | Finish file uploading | +-----------+---------+-----------------------------------------+-----------------------------+ | 'Warning' | 'W' | General warnings, non-critical failures | Image load error | +-----------+---------+-----------------------------------------+-----------------------------+ | 'Error' | 'E' | General errors/severe errors | Could not connect to the DB | +-----------+---------+-----------------------------------------+-----------------------------+ -} module Colog.Core.Severity ( Severity (..) -- ** Patterns -- $pattern , pattern D , pattern I , pattern W , pattern E , filterBySeverity , WithSeverity (..) , mapSeverity ) where import Data.Ix (Ix) import Colog.Core.Action (LogAction (..), cfilter) -- | Severity for the log messages. data Severity {- | Information useful for debug purposes. E.g. output of the function that is important for the internal development, not for users. Like, the result of SQL query. -} = Debug {- | Normal operational information. E.g. describing general steps: starting application, finished downloading. -} | Info {- | General warnings, non-critical failures. E.g. couldn't download icon from some service to display. -} | Warning {- | General errors/severe errors. E.g. exceptional situations: couldn't syncronize accounts. -} | Error deriving stock (Show, Read, Eq, Ord, Enum, Bounded, Ix) {- $pattern Instead of using full names of the constructors you can instead use one-letter patterns. To do so you can import and use the pattern: @ __import__ Colog (__pattern__ D) example :: WithLog env Message m => m () example = log D "I'm using severity pattern" @ Moreover, you could use patterns when pattern-matching on severity @ errorToStderr :: 'Severity' -> IO () errorToStderr E = hputStrLn stderr "Error severity" errorToStderr _ = putStrLn "Something else" @ -} pattern D, I, W, E :: Severity pattern D <- Debug where D = Debug pattern I <- Info where I = Info pattern W <- Warning where W = Warning pattern E <- Error where E = Error {-# COMPLETE D, I, W, E #-} -- | Filters messages by the given 'Severity'. filterBySeverity :: Applicative m => Severity -> (a -> Severity) -> LogAction m a -> LogAction m a filterBySeverity s fs = cfilter (\a -> fs a >= s) {-# INLINE filterBySeverity #-} -- Note: the order of the fields here is to allow the constructor to be used infix. {-| A message tagged with a 'Severity'. It is common to want to log various types of messages tagged with a severity. 'WithSeverity' provides a standard way to do so while allowing the messages to be processed independently of the severity. It is easy to 'cmap' over a 'LogAction m (WithSeverity a)', or to filter based on the severity. @ logSomething :: 'LogAction' m ('WithSeverity' 'String') -> m () logSomething logger = logger <& "hello" \`WithSeverity\` 'Info' cmap' :: (b -> a) -> 'LogAction' m ('WithSeverity' a) -> 'LogAction' m ('WithSeverity' b) cmap' f action = 'cmap' ('fmap' f) action filterBySeverity' :: ('Applicative' m) => 'Severity' -> 'LogAction' m ('WithSeverity' a) -> 'LogAction' m ('WithSeverity' a) filterBySeverity' threshold action = 'filterBySeverity' threshold 'getSeverity' action @ @since 0.3.1.0 -} data WithSeverity msg = WithSeverity { getMsg :: msg , getSeverity :: Severity } deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) {- | Map the given function over the severity of a 'WithSeverity'. This can be useful to operate generically over the severity, for example: @ suppressErrors :: 'LogAction' m ('WithSeverity' msg) -> 'LogAction' m ('WithSeverity' msg) suppressErrors = 'cmap' ('mapSeverity' (\s -> if s == 'Error' then 'Warning' else s)) @ @since 0.3.1.0 -} mapSeverity :: (Severity -> Severity) -> WithSeverity msg -> WithSeverity msg mapSeverity f (WithSeverity msg sev) = WithSeverity msg (f sev) {-# INLINE mapSeverity #-} co-log-core-0.3.2.5/test/0000755000000000000000000000000007346545000013135 5ustar0000000000000000co-log-core-0.3.2.5/test/Doctests.hs0000644000000000000000000000050507346545000015261 0ustar0000000000000000module Main ( main ) where import System.FilePath.Glob (glob) import Test.DocTest (doctest) main :: IO () main = do sourceFiles <- glob "src/**/*.hs" doctest $ "-XDerivingStrategies" : "-XInstanceSigs" : "-XScopedTypeVariables" : "-XViewPatterns" : sourceFiles