diff --git a/log-warper.cabal b/log-warper.cabal --- a/log-warper.cabal +++ b/log-warper.cabal @@ -1,123 +1,147 @@ -name: log-warper -version: 1.0.0 -cabal-version: >=1.18 -build-type: Simple -license: MIT -license-file: LICENSE -copyright: 2016-2016 Serokell -maintainer: Serokell -stability: experimental -homepage: https://github.com/serokell/log-warper -synopsis: Flexible, configurable, monadic and pretty logging +name: log-warper +version: 1.0.1 +synopsis: Flexible, configurable, monadic and pretty logging +homepage: https://github.com/serokell/log-warper +license: MIT +license-file: LICENSE +author: Serokell +maintainer: Serokell +copyright: 2016-2016 Serokell +category: Interfaces +stability: experimental +build-type: Simple +cabal-version: >=1.18 description: This package contains nice wrapper around hslogger library. -category: Interfaces -author: Serokell -flag patakdebugskovorodabardaq - description: - Enable debug support - default: False +Flag PatakDebugSkovorodaBARDAQ + default: False + description: Enable debug support library - - if !os(windows) - build-depends: - unix >=2.7.2.0 && <2.8 - - if flag(patakdebugskovorodabardaq) - cpp-options: -DPatakDebugSkovorodaBARDAQ - exposed-modules: - System.Wlog - System.Wlog.CanLog - System.Wlog.FileUtils - System.Wlog.Formatter - System.Wlog.Handler - System.Wlog.Handler.Simple - System.Wlog.Handler.Syslog - System.Wlog.Launcher - System.Wlog.Logger - System.Wlog.LoggerConfig - System.Wlog.LoggerName - System.Wlog.LoggerNameBox - System.Wlog.Roller - System.Wlog.Severity - System.Wlog.Wrapper - build-depends: - aeson >=0.11.2.1 && <0.12, - ansi-terminal >=0.6.2.3 && <0.7, - base >=4.7 && <5, - bytestring >=0.10.8.1 && <0.11, - containers >=0.5.7.0 && <0.6, - directory >=1.2.6.2 && <1.3, - dlist >=0.8.0.2 && <0.9, - errors >=2.1.2 && <2.2, - exceptions >=0.8.3 && <0.9, - extra >=1.4.10 && <1.5, - filepath >=1.4.1 && <1.5, - formatting >=6.2.2 && <6.3, - hashable >=1.2.4.0 && <1.3, - lens ==4.14.*, - monad-control >=1.0.1.0 && <1.1, - monad-loops >=0.4.3 && <0.5, - mtl >=2.2.1 && <2.3, - network >=2.6.3.1 && <2.7, - safecopy >=0.9.1 && <0.10, - text >=1.2.2.0 && <1.3, - text-format >=0.3.1.1 && <0.4, - time >=1.6.0.1 && <1.7, - transformers >=0.5.2 && <0.6, - transformers-base >=0.4.4 && <0.5, - universum ==0.2.*, - unordered-containers >=0.2.7.1 && <0.3, - yaml >=0.8.20 && <0.9 - default-language: Haskell2010 - default-extensions: GeneralizedNewtypeDeriving DeriveDataTypeable - DeriveGeneric OverloadedStrings TypeApplications RecordWildCards - hs-source-dirs: src - other-modules: - System.Wlog.Color - System.Wlog.MemoryQueue - ghc-options: -Wall -fno-warn-orphans + exposed-modules: System.Wlog + System.Wlog.CanLog + System.Wlog.FileUtils + System.Wlog.Formatter + System.Wlog.Handler + System.Wlog.Handler.Simple + System.Wlog.Handler.Syslog + System.Wlog.Launcher + System.Wlog.Logger + System.Wlog.LoggerConfig + System.Wlog.LoggerName + System.Wlog.LoggerNameBox + System.Wlog.Roller + System.Wlog.Severity + System.Wlog.Wrapper + other-modules: System.Wlog.Color + System.Wlog.MemoryQueue + + build-depends: aeson >= 0.11.2.1 + , ansi-terminal >= 0.6.2.3 + , base >= 4.7 && < 5 + , bytestring >= 0.10.8.1 + , containers >= 0.5.7.0 + , directory >= 1.2.6.2 + , dlist >= 0.8.0.2 + , errors >= 2.1.2 + , exceptions >= 0.8.3 + , extra >= 1.4.10 + , filepath >= 1.4.1 + , formatting >= 6.2.2 + , hashable >= 1.2.4.0 + , lens >= 4.14 + , monad-control >= 1.0.1.0 + , monad-loops >= 0.4.3 + , mtl >= 2.2.1 + , network >= 2.6.3.1 + , safecopy >= 0.9.1 + , text >= 1.2.2.0 + , text-format >= 0.3.1.1 + , time >= 1.6.0.1 + , transformers >= 0.5.2 + , transformers-base >= 0.4.4 + , universum >= 0.2 + , unordered-containers >= 0.2.7.1 + , yaml >= 0.8.20 + if !os(windows) + build-depends: unix + + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall -fno-warn-orphans + + default-extensions: GeneralizedNewtypeDeriving + DeriveDataTypeable + DeriveGeneric + OverloadedStrings + TypeApplications + RecordWildCards + + if flag(PatakDebugSkovorodaBARDAQ) + cpp-options: -DPatakDebugSkovorodaBARDAQ + executable play-log - main-is: Playground.hs - build-depends: - base >=4.7 && <5, - exceptions >=0.8.2.1 && <0.9, - log-warper >=1.0.0 && <1.1, - text >=1.2.2.1 && <1.3 - default-language: Haskell2010 - default-extensions: GeneralizedNewtypeDeriving DeriveDataTypeable - DeriveGeneric OverloadedStrings TypeApplications RecordWildCards - hs-source-dirs: examples - ghc-options: -threaded -Wall -fno-warn-orphans + main-is: Playground.hs + build-depends: base >= 4.7 && < 5 + , exceptions >= 0.8.2.1 + , log-warper + , text >= 1.2.2.1 + + hs-source-dirs: examples + default-language: Haskell2010 + ghc-options: -threaded -Wall -fno-warn-orphans + + default-extensions: GeneralizedNewtypeDeriving + DeriveDataTypeable + DeriveGeneric + OverloadedStrings + TypeApplications + RecordWildCards + test-suite log-test - type: exitcode-stdio-1.0 - main-is: Test.hs - build-depends: - async >=2.1.1 && <2.2, - base >=4.9.1.0 && <4.10, - data-default >=0.7.1.1 && <0.8, - directory >=1.2.6.2 && <1.3, - filepath >=1.4.1.0 && <1.5, - hspec >=2.2.4 && <2.3, - HUnit >=1.3.1.2 && <1.4, - lens ==4.14.*, - log-warper >=1.0.0 && <1.1, - QuickCheck >=2.8.2 && <2.9, - universum >=0.2.1 && <0.3, - unordered-containers >=0.2.7.2 && <0.3 - default-language: Haskell2010 - default-extensions: DeriveDataTypeable DeriveGeneric - GeneralizedNewtypeDeriving StandaloneDeriving FlexibleContexts - FlexibleInstances MultiParamTypeClasses FunctionalDependencies - DefaultSignatures NoImplicitPrelude OverloadedStrings - RecordWildCards TypeApplications TupleSections ViewPatterns - LambdaCase MultiWayIf - hs-source-dirs: test - other-modules: - Spec - Test.Wlog.RollingSpec - ghc-options: -threaded -rtsopts -Wall -fno-warn-orphans -with-rtsopts=-N + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Test.hs + other-modules: Spec + Test.Wlog.RollingSpec + + build-depends: async + , base + , data-default + , directory + , filepath + , hspec + , HUnit + , lens + , log-warper + , QuickCheck + , universum + , unordered-containers + + default-language: Haskell2010 + ghc-options: -threaded + -rtsopts + -Wall + -fno-warn-orphans + -with-rtsopts=-N + + default-extensions: DeriveDataTypeable + DeriveGeneric + GeneralizedNewtypeDeriving + StandaloneDeriving + FlexibleContexts + FlexibleInstances + MultiParamTypeClasses + FunctionalDependencies + DefaultSignatures + NoImplicitPrelude + OverloadedStrings + RecordWildCards + TypeApplications + TupleSections + ViewPatterns + LambdaCase + MultiWayIf diff --git a/src/System/Wlog/CanLog.hs b/src/System/Wlog/CanLog.hs --- a/src/System/Wlog/CanLog.hs +++ b/src/System/Wlog/CanLog.hs @@ -24,6 +24,9 @@ , LogEvent (..) , dispatchEvents , runPureLog + , launchPureLog + , runNamedPureLog + , launchNamedPureLog -- * Logging functions , logDebug @@ -34,25 +37,27 @@ , logMessage ) where -import Control.Monad.Base (MonadBase) -import Control.Monad.Except (ExceptT, MonadError) -import qualified Control.Monad.RWS as RWSLazy -import qualified Control.Monad.RWS.Strict as RWSStrict -import Control.Monad.Trans (MonadTrans (lift)) -import Control.Monad.Writer (MonadWriter (tell), WriterT (runWriterT)) -import qualified Data.DList as DL (DList) -import Data.SafeCopy (base, deriveSafeCopySimple) -import Data.Time (getCurrentTime) -import System.IO.Unsafe (unsafePerformIO) +import Control.Monad.Base (MonadBase) +import Control.Monad.Except (ExceptT, MonadError) +import qualified Control.Monad.RWS as RWSLazy +import qualified Control.Monad.RWS.Strict as RWSStrict +import qualified Control.Monad.State.Strict as StateStrict +import Control.Monad.Trans (MonadTrans (lift)) +import Control.Monad.Writer (MonadWriter (tell), WriterT (runWriterT)) +import qualified Data.DList as DL (DList) +import Data.SafeCopy (base, deriveSafeCopySimple) +import Data.Time (getCurrentTime) +import System.IO.Unsafe (unsafePerformIO) import Universum -import System.Wlog.Formatter (formatLogMessageColors, getRoundedTime) -import System.Wlog.Logger (logM) -import System.Wlog.LoggerName (LoggerName (..)) -import System.Wlog.LoggerNameBox (HasLoggerName (..), LoggerNameBox (..)) -import System.Wlog.MemoryQueue (MemoryQueue) -import qualified System.Wlog.MemoryQueue as MQ -import System.Wlog.Severity (Severity (..)) +import System.Wlog.Formatter (formatLogMessageColors, getRoundedTime) +import System.Wlog.Logger (logM) +import System.Wlog.LoggerName (LoggerName (..)) +import System.Wlog.LoggerNameBox (HasLoggerName (..), LoggerNameBox (..), + usingLoggerName) +import System.Wlog.MemoryQueue (MemoryQueue) +import qualified System.Wlog.MemoryQueue as MQ +import System.Wlog.Severity (Severity (..)) -- | Type alias for constraints 'CanLog' and 'HasLoggerName'. @@ -92,6 +97,7 @@ instance CanLog m => CanLog (LoggerNameBox m) instance CanLog m => CanLog (ReaderT r m) instance CanLog m => CanLog (StateT s m) +instance CanLog m => CanLog (StateStrict.StateT s m) instance CanLog m => CanLog (ExceptT s m) instance (CanLog m, Monoid w) => CanLog (RWSLazy.RWST r w s m) instance (CanLog m, Monoid w) => CanLog (RWSStrict.RWST r w s m) @@ -124,12 +130,32 @@ runPureLog :: Monad m => PureLogger m a -> m (a, [LogEvent]) runPureLog = fmap (second toList) . runWriterT . runPureLogger +-- | Return log of pure logging action as list of 'LogEvent', +-- using logger name provided by context. +runNamedPureLog + :: (Monad m, HasLoggerName m) + => PureLogger (LoggerNameBox m) a -> m (a, [LogEvent]) +runNamedPureLog action = + getLoggerName >>= (`usingLoggerName` runPureLog action) + -- | Logs all 'LogEvent'`s from given list. This function supposed to -- be used after 'runPureLog'. -dispatchEvents :: WithLogger m => [LogEvent] -> m () +dispatchEvents :: CanLog m => [LogEvent] -> m () dispatchEvents = mapM_ dispatchLogEvent where dispatchLogEvent (LogEvent name sev t) = dispatchMessage name sev t + +-- | Performs actual logging once given action completes. +launchPureLog :: CanLog m => PureLogger m a -> m a +launchPureLog action = do + (res, logs) <- runPureLog action + dispatchEvents logs + return res + +-- | Similar as `launchPureLog`, but provides logger name from current context. +launchNamedPureLog :: WithLogger m => PureLogger (LoggerNameBox m) a -> m a +launchNamedPureLog action = + getLoggerName >>= (`usingLoggerName` launchPureLog action) -- | Shortcut for 'logMessage' to use according severity. logDebug, logInfo, logNotice, logWarning, logError