polysemy-log (empty) → 0.1.0.0
raw patch · 21 files changed
+917/−0 lines, 21 filesdep +ansi-terminaldep +basedep +hedgehog
Dependencies added: ansi-terminal, base, hedgehog, polysemy, polysemy-log, polysemy-test, polysemy-time, relude, string-interpolate, tasty, tasty-hedgehog, template-haskell, text, time
Files
- Changelog.md +0/−0
- LICENSE +34/−0
- lib/Polysemy/Log.hs +97/−0
- lib/Polysemy/Log/Atomic.hs +48/−0
- lib/Polysemy/Log/Data/DataLog.hs +14/−0
- lib/Polysemy/Log/Data/Log.hs +102/−0
- lib/Polysemy/Log/Data/LogEntry.hs +28/−0
- lib/Polysemy/Log/Data/LogMessage.hs +13/−0
- lib/Polysemy/Log/Data/LogMetadata.hs +14/−0
- lib/Polysemy/Log/Data/Severity.hs +17/−0
- lib/Polysemy/Log/Format.hs +49/−0
- lib/Polysemy/Log/Log.hs +61/−0
- lib/Polysemy/Log/Prelude.hs +65/−0
- lib/Polysemy/Log/Pure.hs +21/−0
- lib/Prelude.hs +5/−0
- polysemy-log.cabal +210/−0
- readme.md +25/−0
- test/Main.hs +19/−0
- test/Polysemy/Log/Test/DataLogTest.hs +30/−0
- test/Polysemy/Log/Test/LogEntryTest.hs +39/−0
- test/Polysemy/Log/Test/SimpleTest.hs +26/−0
+ Changelog.md view
+ LICENSE view
@@ -0,0 +1,34 @@+Copyright (c) 2020 Torsten Schmits++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met:++ 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following+ disclaimer.+ 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided with the distribution.++Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those+receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except+for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,+import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired+or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by:++ (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of+ contributors, in source or binary form) alone; or+ (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such+ copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to+ be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution.++Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this+license, whether expressly, by implication, estoppel or otherwise.++DISCLAIMER++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ lib/Polysemy/Log.hs view
@@ -0,0 +1,97 @@+{-# language NoImplicitPrelude #-}+{-# options_haddock prune #-}+-- |Description: Polysemy Effects for Logging++module Polysemy.Log (+ -- * Introduction+ -- $intro++ -- * Arbitrary Data Messages+ -- $datalog+ DataLog(DataLog),+ dataLog,++ -- ** Interpreters+ interpretDataLogAtomic',+ interpretDataLogAtomic,++ -- * Text Messages with Severity and Metadata+ -- $messages+ LogMessage(LogMessage),+ LogEntry(LogEntry),+ Log(Log),+ log,+ trace,+ debug,+ info,+ warn,+ error,+ crit,+ formatLogEntry,+ Severity(..),++ -- ** Interpreters+ interpretLogDataLog,+ interpretLogDataLog',+ interpretLogOutput,+ interpretLogNull,+ interpretLogAtomic,+ interpretLogAtomic',+) where++import Polysemy.Log.Atomic (interpretDataLogAtomic, interpretDataLogAtomic', interpretLogAtomic, interpretLogAtomic')+import Polysemy.Log.Data.DataLog (DataLog(DataLog), dataLog)+import Polysemy.Log.Data.Log (Log(Log), crit, debug, error, info, log, trace, warn)+import Polysemy.Log.Data.LogEntry (LogEntry(LogEntry))+import Polysemy.Log.Data.LogMessage (LogMessage(LogMessage))+import Polysemy.Log.Data.Severity (Severity(..))+import Polysemy.Log.Format (formatLogEntry)+import Polysemy.Log.Log (interpretLogDataLog, interpretLogDataLog')+import Polysemy.Log.Pure (interpretLogNull, interpretLogOutput)++-- $intro+-- There are at least two libraries that wrap a logging backend with polysemy interpreters.+-- An author of a library who wants to provide log messages faces the problem that committing to a backend requires the+-- user to translate those messages if their chosen backend differs.+--+-- /polysemy-log/ provides an abstraction for this task with interpreter adapters for+-- [co-log](https://hackage.haskell.org/package/co-log-polysemy) and+-- [di](https://hackage.haskell.org/package/di-polysemy).+--+-- If you're looking for instructions on how to use /polysemy-log/ with a backend, please visit the haddocks of the+-- adapter libraries:+--+-- - [polysemy-log-co for co-log](https://hackage.haskell.org/package/polysemy-log-co)+-- - [polysemy-log-di for di](https://hackage.haskell.org/package/polysemy-log-di)+--+-- A program using this library might look like this:+--+-- @+-- prog :: Member Log r => Sem r ()+-- prog = do+-- Log.debug "starting"+-- Log.error "nothing happened"+-- @++-- $datalog+-- Logging backends usually don't put any restrictions on the data type that represents a log message, so the adapter+-- effect that faces towards the backend is simply polymorphic in that type.+--+-- For complex logging purposes, it would be perfectly valid to use 'DataLog' directly, even though this library focuses+-- on simpler messages:+--+-- @+-- data ComplexMessage = ComplexMessage { points :: Int, user :: Text }+--+-- prog :: Member (DataLog ComplexMessage) r => Sem r ()+-- prog = do+-- dataLog (ComplexMessage 500 "googleson78")+-- @++-- $messages+-- While it would be quite reasonable to handle any kind of complexly structured logging data ergonomically with+-- /polysemy/, most authors probably prefer not to burden their users with this task while still appreciating the+-- possibility to easily relay debug information in a standardized way.+--+-- The default logging effect uses a simple data structure that annotates the given severity and text message with the+-- source location and timestamp:
+ lib/Polysemy/Log/Atomic.hs view
@@ -0,0 +1,48 @@+-- |Description: Internal+module Polysemy.Log.Atomic where++import Polysemy.Internal (InterpretersFor)++import Polysemy.Log.Data.DataLog (DataLog(DataLog))+import Polysemy.Log.Data.Log (Log(Log))+import Polysemy.Log.Data.LogMessage (LogMessage)++-- |Interpret 'DataLog' by prepending each message to a list in an 'AtomicState'.+interpretDataLogAtomic' ::+ ∀ a r .+ Member (AtomicState [a]) r =>+ InterpreterFor (DataLog a) r+interpretDataLogAtomic' =+ interpret \case+ DataLog msg -> atomicModify' (msg :)+{-# INLINE interpretDataLogAtomic' #-}++-- |Interpret 'DataLog' by prepending each message to a list in an 'AtomicState', then interpret the 'AtomicState' in a+-- 'TVar'.+interpretDataLogAtomic ::+ ∀ a r .+ Member (Embed IO) r =>+ InterpretersFor [DataLog a, AtomicState [a]] r+interpretDataLogAtomic sem = do+ tv <- newTVarIO []+ runAtomicStateTVar tv (interpretDataLogAtomic' sem)+{-# INLINE interpretDataLogAtomic #-}++-- |Interpret 'Log' by prepending each message to a list in an 'AtomicState'.+interpretLogAtomic' ::+ Member (AtomicState [LogMessage]) r =>+ InterpreterFor Log r+interpretLogAtomic' =+ interpret \case+ Log msg -> atomicModify' (msg :)+{-# INLINE interpretLogAtomic' #-}++-- |Interpret 'Log' by prepending each message to a list in an 'AtomicState', then interpret the 'AtomicState' in a+-- 'TVar'.+interpretLogAtomic ::+ Member (Embed IO) r =>+ InterpretersFor [Log, AtomicState [LogMessage]] r+interpretLogAtomic sem = do+ tv <- newTVarIO []+ runAtomicStateTVar tv (interpretLogAtomic' sem)+{-# INLINE interpretLogAtomic #-}
+ lib/Polysemy/Log/Data/DataLog.hs view
@@ -0,0 +1,14 @@+{-# options_haddock prune #-}+-- |Description: Internal++module Polysemy.Log.Data.DataLog where++-- |Adapter for a logging backend.+--+-- Usually this is reinterpreted into an effect like those from /co-log/ or /di/, but it can be used purely for testing.+-- This effect is basically identical to 'Polysemy.Output.Output' and serves only as a nominal component.+data DataLog a :: Effect where+ -- |Schedule an arbitrary value for logging.+ DataLog :: a -> DataLog a m ()++makeSem ''DataLog
+ lib/Polysemy/Log/Data/Log.hs view
@@ -0,0 +1,102 @@+-- |Description: Internal+module Polysemy.Log.Data.Log where++import Polysemy.Internal (send)++import Polysemy.Log.Data.Severity (Severity, Severity(Debug, Trace, Info, Warn, Error, Crit))+import Polysemy.Log.Data.LogMessage (LogMessage(LogMessage))++-- |The default high-level effect for simple text messages.+-- To be used with the severity constructors:+--+-- @+-- import qualified Polysemy.Log as Log+--+-- prog = do+-- Log.debug "debugging…"+-- Log.warn "warning!"+-- @+--+-- Interpreters should preprocess and relay the message to 'Polysemy.Log.DataLog'.+data Log :: Effect where+ -- |Schedule a message to be logged.+ Log :: HasCallStack => LogMessage -> Log m ()++-- |Log a message with the given severity.+-- Basic 'Sem' constructor.+log ::+ HasCallStack =>+ Member Log r =>+ Severity ->+ Text ->+ Sem r ()+log severity message =+ withFrozenCallStack $+ send (Log (LogMessage severity message))+{-# INLINE log #-}++-- |Log a message with the 'Trace' severity.+trace ::+ HasCallStack =>+ Member Log r =>+ Text ->+ Sem r ()+trace =+ withFrozenCallStack $+ log Trace+{-# INLINE trace #-}++-- |Log a message with the 'Debug' severity.+debug ::+ HasCallStack =>+ Member Log r =>+ Text ->+ Sem r ()+debug =+ withFrozenCallStack $+ log Debug+{-# INLINE debug #-}++-- |Log a message with the 'Info' severity.+info ::+ HasCallStack =>+ Member Log r =>+ Text ->+ Sem r ()+info =+ withFrozenCallStack $+ log Info+{-# INLINE info #-}++-- |Log a message with the 'Warn' severity.+warn ::+ HasCallStack =>+ Member Log r =>+ Text ->+ Sem r ()+warn =+ withFrozenCallStack $+ log Warn+{-# INLINE warn #-}++-- |Log a message with the 'Error' severity.+error ::+ HasCallStack =>+ Member Log r =>+ Text ->+ Sem r ()+error =+ withFrozenCallStack $+ log Error+{-# INLINE error #-}++-- |Log a message with the 'Crit' severity.+crit ::+ HasCallStack =>+ Member Log r =>+ Text ->+ Sem r ()+crit =+ withFrozenCallStack $+ log Crit+{-# INLINE crit #-}
+ lib/Polysemy/Log/Data/LogEntry.hs view
@@ -0,0 +1,28 @@+-- |Description: Internal+module Polysemy.Log.Data.LogEntry where++import Data.Time (UTCTime)+import Data.Time.Calendar (Day)+import qualified Polysemy.Time as Time+import Polysemy.Time (GhcTime)++-- |Metadata wrapper for a log message.+data LogEntry a =+ LogEntry {+ message :: !a,+ -- |The time at which the log entry was created.+ time :: !UTCTime,+ -- |The call stack of the function in which the entry was created.+ source :: !CallStack+ }+ deriving (Show)++-- |Add call stack and timestamp to a message and wrap it with 'LogEntry'.+annotate ::+ HasCallStack =>+ Member GhcTime r =>+ a ->+ Sem r (LogEntry a)+annotate msg = do+ time <- Time.now @UTCTime @Day+ pure (LogEntry msg time callStack)
+ lib/Polysemy/Log/Data/LogMessage.hs view
@@ -0,0 +1,13 @@+-- |Description: Internal+module Polysemy.Log.Data.LogMessage where++import Polysemy.Log.Data.Severity (Severity)++-- |User-specified part of the default logging data, consisting of a severity level like /warning/, /error/, /debug/,+-- and a plain text message.+data LogMessage =+ LogMessage {+ severity :: !Severity,+ message :: !Text+ }+ deriving (Eq, Show)
+ lib/Polysemy/Log/Data/LogMetadata.hs view
@@ -0,0 +1,14 @@+-- |Description: Internal+{-# options_haddock prune #-}+module Polysemy.Log.Data.LogMetadata where++-- |Internal effect used as an intermediate stage between 'Polysemy.Log.Log' and 'Polysemy.Log.DataLog', for the purpose+-- of isolating the metadata annotation task.+--+-- The type of metadata is arbitrary and chosen in interpreters, but this exposes a 'HasCallStack' dependency since it's+-- the primary purpose.+data LogMetadata a :: Effect where+ -- |Schedule a message to be annotated and logged.+ Annotated :: HasCallStack => a -> LogMetadata a m ()++makeSem ''LogMetadata
+ lib/Polysemy/Log/Data/Severity.hs view
@@ -0,0 +1,17 @@+-- |Description: Internal+module Polysemy.Log.Data.Severity where++-- |A log message's severity, or log level.+data Severity =+ Trace+ |+ Debug+ |+ Info+ |+ Warn+ |+ Error+ |+ Crit+ deriving (Eq, Show, Enum)
+ lib/Polysemy/Log/Format.hs view
@@ -0,0 +1,49 @@+-- |Description: Formatting helpers+module Polysemy.Log.Format where++import qualified Data.Text as Text+import GHC.Exception (SrcLoc(..))+import System.Console.ANSI (Color(..), ColorIntensity(Dull), ConsoleLayer(Foreground), SGR (..), setSGRCode)++import Polysemy.Log.Data.LogEntry (LogEntry(LogEntry))+import qualified Polysemy.Log.Data.LogMessage as LogMessage+import Polysemy.Log.Data.LogMessage (LogMessage(LogMessage))+import Polysemy.Log.Data.Severity (Severity(..))++-- |Create a colored tag with the format @"[tag]"@ for a 'Severity' value.+formatSeverity :: Severity -> Text+formatSeverity = \case+ Trace -> "[trace]"+ Debug -> color Green "[debug]"+ Info -> color Blue "[info] "+ Warn -> color Yellow "[warn] "+ Error -> color Red "[error]"+ Crit -> color Magenta "[crit] "+ where+ color c txt =+ toText (setSGRCode [SetColor Foreground Dull c]) <>+ txt <>+ toText (setSGRCode [Reset])++-- |Turn a module string like @Foo.Bar.Baz@ into an abbreviated @F.B.Baz@.+shortModule :: Text -> Text+shortModule =+ spin . Text.splitOn "."+ where+ spin = \case+ [] -> ""+ [m] -> m+ h : t -> Text.take 1 h <> "." <> spin t++-- |Format a call stack's top element as @"F.B.Baz#32"@ with the line number.+formatCaller :: CallStack -> Text+formatCaller =+ maybe "<unknown loc>" format . listToMaybe . getCallStack+ where+ format (_, SrcLoc {..}) =+ [qt|#{shortModule (toText srcLocModule)}##{srcLocStartLine}|]++-- |Default formatter for the default message type.+formatLogEntry :: LogEntry LogMessage -> Text+formatLogEntry (LogEntry LogMessage {..} _ source) =+ [qt|#{formatSeverity severity} [#{formatCaller source}] #{message}|]
+ lib/Polysemy/Log/Log.hs view
@@ -0,0 +1,61 @@+-- |Description: Internal+module Polysemy.Log.Log where++import Polysemy.Internal (InterpretersFor)+import Polysemy.Time (GhcTime, interpretTimeGhc)++import Polysemy.Log.Data.DataLog (DataLog, dataLog)+import Polysemy.Log.Data.Log (Log(Log))+import Polysemy.Log.Data.LogEntry (LogEntry, annotate)+import Polysemy.Log.Data.LogMessage (LogMessage)+import Polysemy.Log.Data.LogMetadata (LogMetadata(Annotated), annotated)++-- |Interpret 'Log' into the intermediate internal effect 'LogMetadata'.+interpretLogLogMetadata ::+ Members [LogMetadata LogMessage, GhcTime] r =>+ InterpreterFor Log r+interpretLogLogMetadata =+ interpret \case+ Log msg -> annotated msg+{-# INLINE interpretLogLogMetadata #-}++-- |Interpret the intermediate internal effect 'LogMetadata' into 'DataLog'.+--+-- Since this adds a timestamp, it has a dependency on 'GhcTime'.+-- Use 'interpretLogMetadataDataLog'' for a variant that interprets 'GhcTime' in-place.+interpretLogMetadataDataLog ::+ ∀ a r .+ Members [DataLog (LogEntry a), GhcTime] r =>+ InterpreterFor (LogMetadata a) r+interpretLogMetadataDataLog =+ interpret \case+ Annotated msg -> dataLog =<< annotate msg+{-# INLINE interpretLogMetadataDataLog #-}++-- |Interpret the intermediate internal effect 'LogMetadata' into 'DataLog'.+interpretLogMetadataDataLog' ::+ Members [DataLog (LogEntry a), Embed IO] r =>+ InterpretersFor [LogMetadata a, GhcTime] r+interpretLogMetadataDataLog' =+ interpretTimeGhc . interpretLogMetadataDataLog+{-# INLINE interpretLogMetadataDataLog' #-}++-- |Interpret 'Log' into 'DataLog', adding metadata information and wrapping with 'LogEntry'.+--+-- Since this adds a timestamp, it has a dependency on 'GhcTime'.+-- Use 'interpretLogDataLog'' for a variant that interprets 'GhcTime' in-place.+interpretLogDataLog ::+ Members [DataLog (LogEntry LogMessage), GhcTime] r =>+ InterpreterFor Log r+interpretLogDataLog =+ interpretLogMetadataDataLog @LogMessage . interpretLogLogMetadata . raiseUnder+{-# INLINE interpretLogDataLog #-}++-- |Interpret 'Log' into 'DataLog', adding metadata information and wrapping with 'LogEntry'.+interpretLogDataLog' ::+ Member (Embed IO) r =>+ Member (DataLog (LogEntry LogMessage)) r =>+ InterpretersFor [Log, LogMetadata LogMessage, GhcTime] r+interpretLogDataLog' =+ interpretLogMetadataDataLog' . interpretLogLogMetadata+{-# INLINE interpretLogDataLog' #-}
+ lib/Polysemy/Log/Prelude.hs view
@@ -0,0 +1,65 @@+{-# options_haddock hide #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Polysemy.Log.Prelude (+ module Polysemy.Log.Prelude,+ module GHC.Err,+ module Polysemy,+ module Polysemy.AtomicState,+ module Relude,+) where++import qualified Data.String.Interpolate as Interpolate+import GHC.Err (undefined)+import Language.Haskell.TH.Quote (QuasiQuoter)+import Polysemy (+ Effect,+ EffectRow,+ Embed,+ Final,+ InterpreterFor,+ Member,+ Members,+ Sem,+ WithTactics,+ embed,+ embedToFinal,+ interpret,+ makeSem,+ pureT,+ raise,+ raiseUnder,+ raiseUnder2,+ raiseUnder3,+ reinterpret,+ runFinal,+ )+import Polysemy.AtomicState (AtomicState, atomicGet, atomicGets, atomicModify', atomicPut, runAtomicStateTVar)+import Relude hiding (+ Reader,+ State,+ Sum,+ Type,+ ask,+ asks,+ evalState,+ filterM,+ get,+ gets,+ hoistEither,+ modify,+ modify',+ put,+ readFile,+ runReader,+ runState,+ state,+ trace,+ traceShow,+ undefined,+ )++qt :: QuasiQuoter+qt =+ Interpolate.i+{-# INLINE qt #-}
+ lib/Polysemy/Log/Pure.hs view
@@ -0,0 +1,21 @@+-- |Description: Internal+module Polysemy.Log.Pure where++import Polysemy.Output (Output, output)++import Polysemy.Log.Data.Log (Log(Log))+import Polysemy.Log.Data.LogMessage (LogMessage)++-- |Interpret 'Log' in terms of 'Output'.+interpretLogOutput ::+ Member (Output LogMessage) r =>+ InterpreterFor Log r+interpretLogOutput =+ interpret \case+ Log msg -> output msg++-- |Interpret 'Log' by discarding all messages.+interpretLogNull :: InterpreterFor Log r+interpretLogNull =+ interpret \case+ Log _ -> pure ()
+ lib/Prelude.hs view
@@ -0,0 +1,5 @@+module Prelude (+ module Polysemy.Log.Prelude,+) where++import Polysemy.Log.Prelude
+ polysemy-log.cabal view
@@ -0,0 +1,210 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: polysemy-log+version: 0.1.0.0+synopsis: Polysemy effects for logging+description: See <https://hackage.haskell.org/package/polysemy-log/docs/Polysemy-Log.html>+category: Logging+homepage: https://github.com/tek/polysemy-log#readme+bug-reports: https://github.com/tek/polysemy-log/issues+author: Torsten Schmits+maintainer: tek@tryp.io+copyright: 2021 Torsten Schmits+license: BSD-2-Clause-Patent+license-file: LICENSE+build-type: Simple+extra-source-files:+ readme.md+ Changelog.md++source-repository head+ type: git+ location: https://github.com/tek/polysemy-log++library+ exposed-modules:+ Polysemy.Log+ Polysemy.Log.Atomic+ Polysemy.Log.Data.DataLog+ Polysemy.Log.Data.Log+ Polysemy.Log.Data.LogEntry+ Polysemy.Log.Data.LogMessage+ Polysemy.Log.Data.LogMetadata+ Polysemy.Log.Data.Severity+ Polysemy.Log.Format+ Polysemy.Log.Log+ Polysemy.Log.Prelude+ Polysemy.Log.Pure+ other-modules:+ Prelude+ Paths_polysemy_log+ autogen-modules:+ Paths_polysemy_log+ hs-source-dirs:+ lib+ default-extensions:+ AllowAmbiguousTypes+ ApplicativeDo+ BangPatterns+ BinaryLiterals+ BlockArguments+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveTraversable+ DerivingStrategies+ DerivingVia+ DisambiguateRecordFields+ DoAndIfThenElse+ DuplicateRecordFields+ EmptyDataDecls+ ExistentialQuantification+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ InstanceSigs+ KindSignatures+ LambdaCase+ LiberalTypeSynonyms+ MultiParamTypeClasses+ MultiWayIf+ NamedFieldPuns+ OverloadedStrings+ OverloadedLists+ PackageImports+ PartialTypeSignatures+ PatternGuards+ PatternSynonyms+ PolyKinds+ QuantifiedConstraints+ QuasiQuotes+ RankNTypes+ RecordWildCards+ RecursiveDo+ ScopedTypeVariables+ StandaloneDeriving+ TemplateHaskell+ TupleSections+ TypeApplications+ TypeFamilies+ TypeFamilyDependencies+ TypeOperators+ TypeSynonymInstances+ UndecidableInstances+ UnicodeSyntax+ ViewPatterns+ ghc-options: -flate-specialise -fspecialise-aggressively -Wall -Wredundant-constraints+ build-depends:+ ansi-terminal >=0.10.0 && <0.11+ , base ==4.*+ , polysemy >=1.3 && <1.5+ , polysemy-time >=0.1.1.0 && <0.2+ , relude >=0.5 && <0.8+ , string-interpolate >=0.2.1+ , template-haskell+ , text+ , time+ mixins:+ base hiding (Prelude)+ default-language: Haskell2010++test-suite polysemy-log-unit+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Polysemy.Log.Test.DataLogTest+ Polysemy.Log.Test.LogEntryTest+ Polysemy.Log.Test.SimpleTest+ Paths_polysemy_log+ hs-source-dirs:+ test+ default-extensions:+ AllowAmbiguousTypes+ ApplicativeDo+ BangPatterns+ BinaryLiterals+ BlockArguments+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveTraversable+ DerivingStrategies+ DerivingVia+ DisambiguateRecordFields+ DoAndIfThenElse+ DuplicateRecordFields+ EmptyDataDecls+ ExistentialQuantification+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ InstanceSigs+ KindSignatures+ LambdaCase+ LiberalTypeSynonyms+ MultiParamTypeClasses+ MultiWayIf+ NamedFieldPuns+ OverloadedStrings+ OverloadedLists+ PackageImports+ PartialTypeSignatures+ PatternGuards+ PatternSynonyms+ PolyKinds+ QuantifiedConstraints+ QuasiQuotes+ RankNTypes+ RecordWildCards+ RecursiveDo+ ScopedTypeVariables+ StandaloneDeriving+ TemplateHaskell+ TupleSections+ TypeApplications+ TypeFamilies+ TypeFamilyDependencies+ TypeOperators+ TypeSynonymInstances+ UndecidableInstances+ UnicodeSyntax+ ViewPatterns+ ghc-options: -flate-specialise -fspecialise-aggressively -Wall -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ ansi-terminal >=0.10.0 && <0.11+ , base ==4.*+ , hedgehog+ , polysemy >=1.3 && <1.5+ , polysemy-log+ , polysemy-test+ , polysemy-time >=0.1.1.0 && <0.2+ , relude >=0.5 && <0.8+ , string-interpolate >=0.2.1+ , tasty+ , tasty-hedgehog+ , template-haskell+ , text+ , time+ mixins:+ base hiding (Prelude)+ , polysemy-log hiding (Prelude)+ , polysemy-log (Polysemy.Log.Prelude as Prelude)+ default-language: Haskell2010
+ readme.md view
@@ -0,0 +1,25 @@+> Log thrice, debug once.+>+> –– Любенов Г.++# About++A common interface for the polysemy logging backend adapters:++```haskell+import Polysemy.Log+import Polysemy.Log.Colog++prog :: Member Log r => Sem r ()+prog = do+ Log.debug "debugging"+ Log.error "failing"++interpretLogColog prog :: Sem [Colog.Log (LogEntry LogMessage), Embed IO] ()+interpretLogStdout prog :: Sem '[Embed IO] ()+```++For more documentation, please consult Hackage:+* [polysemy-log](https://hackage.haskell.org/package/polysemy-log)+* [polysemy-log-co](https://hackage.haskell.org/package/polysemy-log-co)+* [polysemy-log-di](https://hackage.haskell.org/package/polysemy-log-di)
+ test/Main.hs view
@@ -0,0 +1,19 @@+module Main where++import Polysemy.Log.Test.DataLogTest (test_dataLog)+import Polysemy.Log.Test.LogEntryTest (test_logEntry)+import Polysemy.Log.Test.SimpleTest (test_simple)+import Polysemy.Test (unitTest)+import Test.Tasty (TestTree, defaultMain, testGroup)++tests :: TestTree+tests =+ testGroup "core" [+ unitTest "simple" test_simple,+ unitTest "data" test_dataLog,+ unitTest "entry" test_logEntry+ ]++main :: IO ()+main =+ defaultMain tests
+ test/Polysemy/Log/Test/DataLogTest.hs view
@@ -0,0 +1,30 @@+module Polysemy.Log.Test.DataLogTest where++import Polysemy.Test (UnitTest, assertEq, runTestAuto)++import Polysemy.Log.Atomic (interpretDataLogAtomic)+import qualified Polysemy.Log.Data.DataLog as DataLog+import Polysemy.Log.Data.DataLog (DataLog)++data CustomLog =+ User Text+ |+ Fatal Int+ deriving (Eq, Show)++prog ::+ Members [DataLog CustomLog, AtomicState [CustomLog]] r =>+ Sem r [CustomLog]+prog = do+ DataLog.dataLog (User "user")+ DataLog.dataLog (Fatal 5)+ atomicGet++target :: [CustomLog]+target =+ [Fatal 5, User "user"]++test_dataLog :: UnitTest+test_dataLog =+ runTestAuto do+ assertEq @_ @IO target =<< interpretDataLogAtomic @CustomLog prog
+ test/Polysemy/Log/Test/LogEntryTest.hs view
@@ -0,0 +1,39 @@+module Polysemy.Log.Test.LogEntryTest where++import Polysemy.Test (UnitTest, assertEq, runTestAuto)++import Polysemy.Log.Atomic (interpretDataLogAtomic)+import qualified Polysemy.Log.Data.Log as Log+import Polysemy.Log.Data.Log (Log)+import qualified Polysemy.Log.Data.LogEntry as LogEntry+import Polysemy.Log.Data.LogEntry (LogEntry)+import Polysemy.Log.Data.LogMessage (LogMessage (LogMessage))+import Polysemy.Log.Data.Severity (Severity(Crit, Debug))+import Polysemy.Log.Format (formatCaller)+import Polysemy.Log.Log (interpretLogDataLog')++prog ::+ Members [Log, AtomicState [LogEntry LogMessage]] r =>+ Sem r [LogEntry LogMessage]+prog = do+ Log.debug "debug"+ Log.crit "crit"+ atomicGet++target :: [LogMessage]+target =+ [LogMessage Crit "crit", LogMessage Debug "debug"]++sourceTarget :: [Text]+sourceTarget =+ [+ "P.L.T.LogEntryTest#20",+ "P.L.T.LogEntryTest#19"+ ]++test_logEntry :: UnitTest+test_logEntry =+ runTestAuto do+ msgs <- interpretDataLogAtomic @(LogEntry LogMessage) (interpretLogDataLog' prog)+ assertEq @_ @IO target (LogEntry.message <$> msgs)+ assertEq @_ @IO sourceTarget (formatCaller . LogEntry.source <$> msgs)
+ test/Polysemy/Log/Test/SimpleTest.hs view
@@ -0,0 +1,26 @@+module Polysemy.Log.Test.SimpleTest where++import Polysemy.Test (UnitTest, assertEq, runTestAuto)++import Polysemy.Log.Atomic (interpretLogAtomic)+import qualified Polysemy.Log.Data.Log as Log+import Polysemy.Log.Data.Log (Log)+import Polysemy.Log.Data.LogMessage (LogMessage(LogMessage))+import Polysemy.Log.Data.Severity (Severity(Crit, Debug))++prog ::+ Members [Log, AtomicState [LogMessage]] r =>+ Sem r [LogMessage]+prog = do+ Log.debug "debug"+ Log.crit "critical"+ atomicGet++target :: [LogMessage]+target =+ [LogMessage Crit "critical", LogMessage Debug "debug"]++test_simple :: UnitTest+test_simple =+ runTestAuto do+ assertEq @_ @IO target =<< interpretLogAtomic prog