heavy-logger 0.1.0.0 → 0.3.0.0
raw patch · 15 files changed
+1319/−220 lines, 15 filesdep +containersdep +data-defaultdep +lifted-basedep ~text-format-heavy
Dependencies added: containers, data-default, lifted-base, th-lift, th-lift-instances, thread-local-storage
Dependency ranges changed: text-format-heavy
Files
- ChangeLog.md +21/−1
- README.md +75/−16
- examples/Test.hs +36/−0
- examples/TestIO.hs +61/−0
- examples/TestTH.hs +61/−0
- heavy-logger.cabal +15/−4
- src/System/Log/Heavy.hs +112/−20
- src/System/Log/Heavy/Backends.hs +229/−88
- src/System/Log/Heavy/Format.hs +120/−28
- src/System/Log/Heavy/IO.hs +133/−0
- src/System/Log/Heavy/Level.hs +98/−0
- src/System/Log/Heavy/LoggingT.hs +63/−0
- src/System/Log/Heavy/Shortcuts.hs +10/−10
- src/System/Log/Heavy/TH.hs +107/−0
- src/System/Log/Heavy/Types.hs +178/−53
ChangeLog.md view
@@ -1,5 +1,25 @@ # Revision history for heavy-logger -## 0.1.0.0 -- YYYY-mm-dd+## 0.1.0.0 -- 2017-10-15 * First version. Released on an unsuspecting world.++## 0.2.0.0 -- 2017-10-16++* Major rewrite of internal interfaces. Incompatible API changes.+ Was not released to Hackage.+* Added the Shortcuts module.++## 0.3.0.0 -- 2017-10-24++* Introduced parallel logging backend.+* Introduced filtering logging backend.+* Logging context stacks support introduced.+* More flexible severity levels system. This is incompatible API change.+ Conversion functions are provided for integration with monad-logger's+ LogLevel type.+* Internal modules rearrangement.+* Added the TH module.+* Added the IO module.+* Introduced null logging backend.+
README.md view
@@ -1,26 +1,85 @@ heavy-logger README =================== -This is Haskell logging library, which prefers functionality and extendability over light weight and simplicity.-It can use [fast-logger][1] as backend and is compatible with [monad-logger][2] interface, so it can be used in [WAI][3] projects.-heavy-logger is integrated with [text-format-heavy][4] string formatting library.+This is Haskell logging library, which prefers functionality and extendability+over light weight and simplicity.+It can use [fast-logger][1] as backend and is compatible with [monad-logger][2]+interface, so it can be used in projects that already use monad-logger.+heavy-logger is integrated with [text-format-heavy][3] string formatting library. Most notable features of heavy-logger are: -* Several backends and possibility to write your own backends. The provided backends are:- * Fast-logger backend. It allows to write messages to stdout, stderr or arbitrary file.+* Several backends and possibility to write your own backends. The provided+ backends are:+ * Fast-logger backend. It allows to write messages to stdout, stderr or+ arbitrary file. * Syslog backend.- * Chan backend. Writes messages to a Chan, so they can be read from the other side.-* Possibility to define log message format in the output file. For example, do you want to- see event severity level first, and then time, or vice versa?-* Possibility to easily set up message filtering based on message source and severity level.- For example, you may want to write only Info messages, but also Debug messages from one module.-* Text formatting library integration. Formatting of messages by `text-format-heavy` is done lazily;- so, you can issue a lot of debug messages, that include data that take time to present as a string;- the formatting will be executed only in the case when debug output for this module is actually enabled- by the filter.+ * Chan backend. Writes messages to a Chan, so they can be read from the other+ side.+* Possiblity to write messages to several backends in parallel.+* Logging backend settings can be defined dynamically; it is not necessary to+ hardcode which backend you will use, you can load settings in runtime.+* Sane default set of logging message severity levels and possibility to define+ custom severity levels.+* Logging context stacks support (aka mapped diagnostic contexts, MDC). Each+ logging context stack frame contains a set of named variables. These+ variables can be writen to the log.+* Possibility to define log message format in the output file. For example, do+ you want to see event severity level first, and then time, or vice versa? It+ is possible to use variables from logging context stack in the formatting+ string.+* Flexible events filtering mechanism. Messages are filtered based on message+ source and severity level. For example, you may want to write only Info+ messages, but also Debug messages from one module. Filtering can be+ performed on two stages:+ * Before event is passed to backend. This stage is context-sensitive; for+ example, you can enable logging only for events that happened during+ transaction. Context-level filters also support negation; for example, it+ is possible to explicitly forbid debug messages from one contexts, while+ debug is enabled for the whole system.+ * In the backend. For example, you can forbid to write any debug into file,+ but allow to write all debug into syslog.+* Text formatting library integration. Formatting of messages by+ `text-format-heavy` is done lazily; so, you can issue a lot of debug+ messages, that include data that take time to present as a string; the+ formatting will be executed only in the case when debug output for this+ module is actually enabled by the filter. +This package is mostly writen with ideas of "open architecture". It exposes all+internal logical pieces, so they can be combined in other order in specific+applications.++All functions provided by the package work within any monad, which should be an+instance of one of type classes defined by package: `HasLogger`, `HasLogBackend`,+`HasLogContext`. Each function's signature declares only specific constraint, so+if you do not need all functionality, you can implement instances only of that +classes that you actually need.++There are, in general, following ways to use this package:++* Use `LoggingT` monad transformer. It can be the simplest, if you already have+ monadic transformers stack of 1-2 transformers and you do not mind to add yet+ another. With `LoggingT`, you do not need to write any adapter instances, since+ `LoggingT` is already an instance of all required classes. This implementation+ automatically solves all threading-related problems, since in fact it does not+ have any shared state.+* Use `System.Log.Heavy.IO` module. If you do not have monadic transformers at all,+ and your application works in pure IO, this may be the simplest way. However,+ this is a bit fragile, because you have to be sure that you always call logging+ functions only when logging state is initialized, i.e. within `withLoggingIO`+ call. This implementation stores required state in thread-local storage.+* Implement required class instances for monadic stack that you already use in+ your application. For example, if you already have something like+ `ReaderT StateT ExceptT IO`, it will be probably better to add a couple of + fields to StateT's state to track logging state, than change your stack to+ `ReaderT StateT LoggingT ExceptT IO`. If you wish to store logging state in some+ kind of shared storage (global IORef or whatever), then you should think about+ thread-safety by yourself.++Please refer to Haddock documentation and examples in the `examples/` directory+for more detailed information.+ [1]: https://hackage.haskell.org/package/fast-logger [2]: https://hackage.haskell.org/package/monad-logger-[3]: https://hackage.haskell.org/package/wai-[4]: https://hackage.haskell.org/package/text-format-heavy+[3]: https://hackage.haskell.org/package/text-format-heavy+
+ examples/Test.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleContexts #-}++import Control.Monad.Trans+import System.Environment+import System.IO+import System.Log.Heavy+import System.Log.Heavy.Shortcuts+import Data.Text.Format.Heavy++logFormat :: Format+logFormat = "{time} [{level}] {appname} {source}: {message}\n"++selectBackend :: String -> LoggingSettings+selectBackend "syslog" = LoggingSettings $ defaultSyslogSettings {ssFormat = logFormat}+selectBackend "stderr" = LoggingSettings $ defStderrSettings {lsFormat = logFormat}+selectBackend "stdout" = LoggingSettings $ defStdoutSettings {lsFormat = logFormat}+selectBackend "null" = LoggingSettings $ NullLogSettings+selectBackend "parallel" =+ LoggingSettings $ ParallelLogSettings [LoggingSettings defStderrSettings, LoggingSettings defaultSyslogSettings]+selectBackend path = LoggingSettings $ defFileSettings path++main :: IO ()+main = do+ [bstr] <- getArgs+ let settings = selectBackend bstr+ let contextVariables = [("appname", Variable ("hello world" :: String))]+ withLoggingT settings $ withLogContext (LogContextFrame contextVariables (include defaultLogFilter)) $ do+ liftIO $ putStr "Your name? "+ liftIO $ hFlush stdout+ name <- liftIO $ getLine+ info "name was {}" (Single name)+ liftIO $ putStrLn $ "Hello, " ++ name++++
+ examples/TestIO.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleContexts, TemplateHaskell #-}++import Control.Monad (forM_, replicateM)+import Control.Concurrent+import System.Environment+import System.IO+import System.Log.Heavy+import System.Log.Heavy.TH+import System.Log.Heavy.IO+import Data.Text.Format.Heavy++logFormat :: Format+logFormat = "{time} [{level:~t}] Thread #{thread}: {message}\nSource: {file} +{line}\n"++selectBackend :: String -> LoggingSettings+selectBackend "syslog" = LoggingSettings $ defaultSyslogSettings {ssFormat = logFormat}+selectBackend "stderr" = LoggingSettings $ defStderrSettings {lsFormat = logFormat}+selectBackend "stdout" = LoggingSettings $ defStdoutSettings {lsFormat = logFormat}+selectBackend "null" = LoggingSettings $ NullLogSettings+selectBackend "parallel" =+ LoggingSettings $ ParallelLogSettings [+ LoggingSettings defStderrSettings {lsFormat = logFormat},+ LoggingSettings defaultSyslogSettings {ssFormat = logFormat}+ ]+selectBackend path = LoggingSettings $ defFileSettings path++main :: IO ()+main = do+ [bstr] <- getArgs+ let settings = selectBackend bstr+ testHello settings+ testThreads settings++testHello :: LoggingSettings -> IO ()+testHello settings = do+ withLoggingIO settings $ withLogVariable "thread" ("hello" :: String) $ do+ putStr "Your name? "+ hFlush stdout+ name <- getLine+ $info "name was {}" (Single name)+ putStrLn $ "Hello, " ++ name++testThreads :: LoggingSettings -> IO ()+testThreads settings = do+ let startIdxs = [100, 200, 300] :: [Int]+ withLoggingIO settings $ withLogVariable "thread" ("test" :: String) $ do + -- MVars are used for synchronization+ mvs <- replicateM (length startIdxs) newEmptyMVar+ $info "Running {} threads" (Single $ length startIdxs)+ forM_ (zip startIdxs mvs) $ \(start, mvar) -> do+ forkIO $+ withLoggingIO settings $ withLogVariable "thread" start $ do+ $info "Thread started" ()+ forM_ [start .. start + 30] $ \counter -> do+ $info "Counter is {}" (Single counter)+ threadDelay $ 500 * 1000+ putMVar mvar () -- mark thread as done+ $info "Thread finished" ()+ forM_ mvs takeMVar -- read for all threads to finish.+ $info "All threads finished" ()+
+ examples/TestTH.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleContexts, TemplateHaskell #-}++import Control.Monad (forM_, replicateM)+import Control.Monad.Trans+import Control.Concurrent+import System.Environment+import System.IO+import System.Log.Heavy+import System.Log.Heavy.TH+import Data.Text.Format.Heavy++logFormat :: Format+logFormat = "{time} [{level:~l}] #{thread} ({file} +{line}): {message}\n"++selectBackend :: String -> LoggingSettings+selectBackend "syslog" = LoggingSettings $ defaultSyslogSettings {ssFormat = logFormat}+selectBackend "stderr" = LoggingSettings $ defStderrSettings {lsFormat = logFormat}+selectBackend "stdout" = LoggingSettings $ defStdoutSettings {lsFormat = logFormat}+selectBackend "null" = LoggingSettings $ NullLogSettings+selectBackend "parallel" =+ LoggingSettings $ ParallelLogSettings [+ LoggingSettings defStderrSettings {lsFormat = logFormat},+ LoggingSettings defaultSyslogSettings {ssFormat = logFormat}+ ]+selectBackend path = LoggingSettings $ defFileSettings path++main :: IO ()+main = do+ [bstr] <- getArgs+ let settings = selectBackend bstr+ testHello settings+ testThreads settings++testHello :: LoggingSettings -> IO ()+testHello settings = do+ withLoggingT settings $ withLogVariable "thread" ("hello" :: String) $ do+ liftIO $ putStr "Your name? "+ liftIO $ hFlush stdout+ name <- liftIO $ getLine+ $info "name was {}" (Single name)+ liftIO $ putStrLn $ "Hello, " ++ name++testThreads :: LoggingSettings -> IO ()+testThreads settings = do+ let startIdxs = [100, 200, 300] :: [Int]+ withLoggingT settings $ withLogVariable "thread" ("hello" :: String) $ do+ -- MVars are used for synchronization+ mvs <- liftIO $ replicateM (length startIdxs) newEmptyMVar+ $info "Running {} threads" (Single $ length startIdxs)+ forM_ (zip startIdxs mvs) $ \(start, mvar) -> do+ liftIO $ forkIO $+ withLoggingT settings $ withLogVariable "thread" start $ do+ $info "Thread started" ()+ forM_ [start .. start + 30] $ \counter -> do+ $info "Counter is {}" (Single counter)+ liftIO $ threadDelay $ 500 * 1000+ liftIO $ putMVar mvar () -- mark thread as done+ $info "Thread finished" ()+ liftIO $ forM_ mvs takeMVar -- read for all threads to finish.+ $info "All threads finished" ()+
heavy-logger.cabal view
@@ -1,9 +1,9 @@ name: heavy-logger-version: 0.1.0.0+version: 0.3.0.0 synopsis: Full-weight logging based on fast-logger description: This is Haskell logging library, which prefers functionality and extendability over light weight and simplicity. It can use fast-logger as backend, and is compatible - with monad-logger interface, so it can be used in WAI projects.+ with monad-logger interface, so it can be used in projects that already use monad-logger. heavy-logger is also integrated with text-format-heavy string formatting library. license: BSD3 license-file: LICENSE@@ -12,32 +12,43 @@ -- copyright: category: System build-type: Simple-extra-source-files: ChangeLog.md+extra-source-files: ChangeLog.md, examples/Test.hs, examples/TestTH.hs, examples/TestIO.hs extra-doc-files: README.md cabal-version: >=1.18 library exposed-modules: System.Log.Heavy+ System.Log.Heavy.Level System.Log.Heavy.Types+ System.Log.Heavy.LoggingT System.Log.Heavy.Format System.Log.Heavy.Backends System.Log.Heavy.Shortcuts+ System.Log.Heavy.TH+ System.Log.Heavy.IO -- other-modules: -- other-extensions: build-depends: base >=4.8 && <5.0, mtl >= 2.2.1,+ containers >= 0.5, transformers-base >= 0.4.4,+ data-default >= 0.7, monad-control >= 1.0.1.0,+ lifted-base >= 0.2.3, template-haskell >= 2.10.0,+ th-lift >= 0.7,+ th-lift-instances >= 0.1, bytestring >= 0.10.6, text >= 1.2.2.1, attoparsec >= 0.13.1.0, fast-logger >= 2.4.10, monad-logger >= 0.3.22, hsyslog >= 5,- text-format-heavy >= 0.1.2.0+ text-format-heavy >= 0.1.5.0,+ thread-local-storage >= 0.1.1 hs-source-dirs: src default-language: Haskell2010+ ghc-options: -fwarn-unused-imports Source-repository head type: git
src/System/Log/Heavy.hs view
@@ -1,49 +1,141 @@-{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances #-}---- | This is the main module of @heavy-logger@ package. You usually need to import only this module.--- All generally required modules are re-exported.------ For simple usage cases, you may also want to import System.Log.Heavy.Shortcuts module.+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, FlexibleContexts, Rank2Types, ScopedTypeVariables #-}+-- | This is the main module of @heavy-logger@ package. In most cases, you need+-- to import this module. You will also need other modules in specific cases.+-- All modules that are required always are re-exported by this module. -- -- Example of usage is: -- -- @ -- import System.Log.Heavy+-- import System.Log.Heavy.Shortcuts -- import Data.Text.Format.Heavy -- ... ----- withLogging backend id $ do liftIO $ putStr "Your name? "+-- withLoggingT settings $ do+-- liftIO $ putStr "Your name? " -- liftIO $ hFlush stdout -- name <- liftIO $ getLine--- logMessage $ infoMessage "name was {}" (Single name)+-- info "name was {}" (Single name) -- liftIO $ putStrLn $ "Hello, " ++ name -- @ ----- See also @Test.hs@.+-- Please refer to @examples/@ directory for compiling examples.+-- +-- There are, in general, following ways to use this package:+-- +-- * Use @LoggingT@ monad transformer. It can be the simplest, if you already have+-- monadic transformers stack of 1-2 transformers and you do not mind to add yet+-- another. With @LoggingT@, you do not need to write any adapter instances, since+-- @LoggingT@ is already an instance of all required classes. This implementation+-- automatically solves all threading-related problems, since in fact it does not+-- have any shared state. --+-- * Use @System.Log.Heavy.IO@ module. If you do not have monadic transformers at all,+-- and your application works in pure IO, this may be the simplest way. However,+-- this is a bit fragile, because you have to be sure that you always call logging+-- functions only when logging state is initialized, i.e. within @withLoggingIO@+-- call. This implementation stores required state in thread-local storage.+--+-- * Implement required class instances for monadic stack that you already use in+-- your application. For example, if you already have something like+-- @ReaderT StateT ExceptT IO@, it will be probably better to add a couple of +-- fields to StateT's state to track logging state, than change your stack to+-- @ReaderT StateT LoggingT ExceptT IO@. If you wish to store logging state in some+-- kind of shared storage (global IORef or whatever), then you should think about+-- thread-safety by yourself.+-- +-- When you decided which monadic context you will use, you will call one of+-- @withLogging*@ functions to run the entire thing, and inside that you will construct+-- instances of @LogMessage@ type and call @logMessage@ or @logMessage'@ function on them+-- to actually log a message. You probably will want to use some shortcut functions to+-- construct @LogMessage@ instances and log them. There are some provided+-- by this package:+--+-- * @System.Log.Heavy.Shortcuts@ module exports simple functions, that can be used+-- in simple cases, when you do not want to write or check message source.+--+-- * @System.Log.Heavy.TH@ module exports TH macros, which correctly fill message+-- source and location.+-- module System.Log.Heavy ( -- * Reexports module System.Log.Heavy.Types,+ module System.Log.Heavy.Level,+ module System.Log.Heavy.LoggingT, module System.Log.Heavy.Backends,- withLogging+ withLogging, withLoggingF, withLoggingT,+ isLevelEnabledByBackend, isLevelEnabled, ) where import Control.Monad.Trans-import Control.Monad.Logger (LogLevel (..))+import Control.Monad.Trans.Control+import Control.Exception.Lifted (bracket) import qualified Data.Text.Lazy as TL-import qualified Data.Text.Format.Heavy as F import System.Log.Heavy.Types+import System.Log.Heavy.Level+import System.Log.Heavy.LoggingT import System.Log.Heavy.Backends --- | Run LoggingT monad within some kind of IO monad.-withLogging :: MonadIO m- => LogBackend -- ^ Logging backend settings- -> (m a -> IO a) -- ^ Runner to run @m@ within @IO@. - -- For example this may be @runReader@ or @evalState@.- -- Use @id@ for case when @m@ is @IO@.- -> LoggingT m a -- ^ Actions within @LoggingT@ monad.+-- | Execute actions with logging backend.+-- This is mostly an utility function to be used to construct custom +-- logging frameworks for custom monad transformer stacks.+withLoggingF :: (MonadBaseControl IO m, MonadIO m)+ => LoggingSettings -- ^ Settings of arbitrary logging backend.+ -> (forall b. IsLogBackend b => b -> m a) -- ^ Actions to execute with logging backend.+ -- Note that this type declaration binds argument+ -- to work with *any* implementation of backend. -> m a-withLogging (LogBackend b) = withLoggingB b+withLoggingF (LoggingSettings settings) actions = withLoggingB settings actions++-- | Execute actions with logging.+-- This function can be useful for monad stacks that store logging backend+-- in State-like structure.+withLogging :: (MonadBaseControl IO m, MonadIO m, HasLogger m)+ => LoggingSettings -- ^ Settings of arbitrary logging backend+ -> m a -- ^ Actions to be executed+ -> m a+withLogging (LoggingSettings settings) actions = + bracket (liftIO $ initLogBackend settings)+ (liftIO . cleanupLogBackend)+ (\b -> applyBackend b actions)++-- | Execute actions with logging.+-- This function is most convinient if you use @LoggingT@ as+-- @HasLogging@ implementation.+withLoggingT :: (MonadBaseControl IO m, MonadIO m)+ => LoggingSettings -- ^ Settings of arbitrary logging backend+ -> LoggingT m a -- ^ Actions to be executed+ -> m a+withLoggingT (LoggingSettings settings) actions =+ withLoggingB settings $ \backend ->+ let logger = makeLogger backend+ in runLoggingT actions $ LoggingTState logger (AnyLogBackend backend) []++-- | Check if logging of events of specified level from specified source+-- is enabled by backend.+--+-- This function assumes that if some events filtering is enabled by the+-- backend, it does not depend on message text, only on source and +-- severity level.+isLevelEnabledByBackend :: forall m. (Monad m, HasLogBackend AnyLogBackend m) => LogSource -> Level -> m Bool+isLevelEnabledByBackend src level = do+ backend <- getLogBackend :: m AnyLogBackend+ let msg = LogMessage level src undefined TL.empty () []+ return $ wouldWriteMessage backend msg++-- | Check if logging of events of specified level from specified source+-- is enabled by both context and backend filter.+--+-- This function assumes that if some events filtering is enabled by the+-- backend, it does not depend on message text, only on source and +-- severity level.+isLevelEnabled :: forall m. (Monad m, HasLogBackend AnyLogBackend m, HasLogContext m) => LogSource -> Level -> m Bool+isLevelEnabled src level = do+ let msg = LogMessage level src undefined TL.empty () []+ backend <- getLogBackend :: m AnyLogBackend+ let isEnabledByBackend = wouldWriteMessage backend msg+ isEnabledByContext <- checkContextFilterM msg+ return $ isEnabledByContext && isEnabledByBackend
src/System/Log/Heavy/Backends.hs view
@@ -1,11 +1,18 @@ {-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances #-}-+-- | This module contains implementation of most commonly used logging backends.+-- You can write your own backends, by implementing an instance of @IsLogBackend@+-- type class. module System.Log.Heavy.Backends ( -- $description -- * Backends- FastLoggerSettings (..),- SyslogSettings (..),+ FastLoggerBackend,+ SyslogBackend,+ ChanLoggerBackend,+ ParallelBackend,+ NullBackend,+ Filtering, filtering, excluding,+ LogBackendSettings (..), -- * Default settings defStdoutSettings, defStderrSettings,@@ -13,22 +20,25 @@ defaultSyslogSettings, defaultSyslogFormat, -- * Utilities for other backends implementation- checkLogLevel+ checkLogLevel, checkLogLevel',+ checkContextFilter, checkContextFilter', checkContextFilterM,+ logMessage ) where import Control.Monad import Control.Monad.Trans (liftIO) import Control.Monad.Reader-import Control.Monad.Logger (MonadLogger (..), LogLevel (..)) import Control.Concurrent import Data.List (isPrefixOf)-import qualified Data.Text as T import qualified Data.ByteString.Unsafe as BSU import qualified Data.Text.Format.Heavy as F import qualified System.Posix.Syslog as Syslog import System.Log.FastLogger as FL+import Foreign.C.String (CString, newCString)+import Foreign.Marshal.Alloc (free) import System.Log.Heavy.Types+import System.Log.Heavy.Level import System.Log.Heavy.Format -- $description@@ -45,116 +55,200 @@ -- -- * Chan backend. ------ | Settings of fast-logger backend. This mostly reflects settings of fast-logger itself.-data FastLoggerSettings = FastLoggerSettings {- lsFilter :: LogFilter -- ^ Log messages filter- , lsFormat :: F.Format -- ^ Log message format- , lsType :: FL.LogType -- ^ Fast-logger target settings- }+-- * Null backend. This discards all messages. Can be used to disable logging.+--+-- There are also some backend combinators:+--+-- * Filtering - passes messages, that match specified filter,+-- to underlying backend.+--+-- * Parallel - writes messages to several backends in parallel.+-- -- | Default settings for fast-logger stdout output-defStdoutSettings :: FastLoggerSettings-defStdoutSettings = FastLoggerSettings defaultLogFilter defaultLogFormat (FL.LogStdout FL.defaultBufSize)+defStdoutSettings :: LogBackendSettings FastLoggerBackend+defStdoutSettings = FastLoggerSettings defaultLogFormat (FL.LogStdout FL.defaultBufSize) -- | Default settings for fast-logger stderr output-defStderrSettings :: FastLoggerSettings-defStderrSettings = FastLoggerSettings defaultLogFilter defaultLogFormat (FL.LogStderr FL.defaultBufSize)+defStderrSettings :: LogBackendSettings FastLoggerBackend+defStderrSettings = FastLoggerSettings defaultLogFormat (FL.LogStderr FL.defaultBufSize) -- | Default settings for fast-logger file output. -- This implies log rotation when log file size reaches 10Mb.-defFileSettings :: FilePath -> FastLoggerSettings-defFileSettings path = FastLoggerSettings defaultLogFilter defaultLogFormat (FL.LogFile spec FL.defaultBufSize)+defFileSettings :: FilePath -> LogBackendSettings FastLoggerBackend+defFileSettings path = FastLoggerSettings defaultLogFormat (FL.LogFile spec FL.defaultBufSize) where spec = FL.FileLogSpec path (10*1024*1024) 3 -instance IsLogBackend FastLoggerSettings where- -- withLogging :: (MonadIO m) => FastLoggerSettings -> (m a -> IO a) -> LoggingT m a -> m a- withLoggingB settings runner (LoggingT actions) = do- liftIO $ do- tcache <- newTimeCache simpleTimeFormat'- withTimedFastLogger tcache (lsType settings) $ \logger ->- runner $ runReaderT actions $ mkLogger logger settings- where- mkLogger :: TimedFastLogger -> FastLoggerSettings -> Logger- mkLogger logger s m = do- let fltr = lsFilter s- let format = lsFormat s- when (checkLogLevel fltr m) $ do- logger $ formatLogMessage format m---- | Settings for syslog backend. This mostly reflects syslog API.-data SyslogSettings = SyslogSettings {- ssFilter :: LogFilter -- ^ Log messages filter- , ssFormat :: F.Format -- ^ Log message format. Usually you do not want to put time here,- -- because syslog writes time to log by itself by default.- , ssIdent :: String -- ^ Syslog source identifier. Usually the name of your program.- , ssOptions :: [Syslog.Option] -- ^ Syslog options- , ssFacility :: Syslog.Facility -- ^ Syslog facility. It is usally User, if you are writing user-space- -- program.+-- | Fast-logger logging backend.+data FastLoggerBackend = FastLoggerBackend {+ flbSettings :: LogBackendSettings FastLoggerBackend,+ flbTimedLogger :: TimedFastLogger,+ flbCleanup :: IO () } +instance IsLogBackend FastLoggerBackend where+ -- | Settings of fast-logger backend. This mostly reflects settings of fast-logger itself.+ data LogBackendSettings FastLoggerBackend = FastLoggerSettings {+ lsFormat :: F.Format -- ^ Log message format+ , lsType :: FL.LogType -- ^ Fast-logger target settings+ }++ initLogBackend settings = do+ tcache <- newTimeCache simpleTimeFormat'+ (logger, cleanup) <- newTimedFastLogger tcache (lsType settings)+ return $ FastLoggerBackend settings logger cleanup++ cleanupLogBackend b = do+ flbCleanup b++ makeLogger backend msg = do+ let settings = flbSettings backend+ let format = lsFormat settings+ let logger = flbTimedLogger backend+ logger $ formatLogMessage format msg+ -- | Default settings for syslog backend-defaultSyslogSettings :: SyslogSettings-defaultSyslogSettings = SyslogSettings defaultLogFilter defaultSyslogFormat "application" [] Syslog.User+defaultSyslogSettings :: LogBackendSettings SyslogBackend+defaultSyslogSettings = SyslogSettings defaultSyslogFormat "application" [] Syslog.User -- | Default log message format fof syslog backend: -- @[{level}] {source}: {message}@ defaultSyslogFormat :: F.Format defaultSyslogFormat = "[{level}] {source}: {message}" -instance IsLogBackend SyslogSettings where- withLoggingB settings runner (LoggingT actions) = do- liftIO $ do- tcache <- newTimeCache simpleTimeFormat'- Syslog.withSyslog (ssIdent settings) (ssOptions settings) (ssFacility settings) $ do- let logger = mkSyslogLogger tcache settings- runner $ runReaderT actions logger- where- mkSyslogLogger :: IO FormattedTime -> SyslogSettings -> Logger- mkSyslogLogger tcache s m = do- let fltr = ssFilter s- format = ssFormat s- facility = ssFacility s- when (checkLogLevel fltr m) $ do- time <- tcache- let str = formatLogMessage format m time- BSU.unsafeUseAsCStringLen (fromLogStr str) $- Syslog.syslog (Just facility) (levelToPriority $ lmLevel m)+-- | Syslog logging backend.+data SyslogBackend = SyslogBackend {+ sbSettings :: LogBackendSettings SyslogBackend,+ sbIdent :: CString,+ sbTimeCache :: IO FormattedTime+ } - levelToPriority :: LogLevel -> Syslog.Priority- levelToPriority LevelDebug = Syslog.Debug- levelToPriority LevelInfo = Syslog.Info- levelToPriority LevelWarn = Syslog.Warning- levelToPriority LevelError = Syslog.Error- levelToPriority (LevelOther level) =- case level of- "Emergency" -> Syslog.Emergency- "Alert" -> Syslog.Alert- "Critical" -> Syslog.Critical- "Notice" -> Syslog.Notice- _ -> error $ "unknown log level: " ++ T.unpack level+instance IsLogBackend SyslogBackend where+ -- | Settings for syslog backend. This mostly reflects syslog API.+ data LogBackendSettings SyslogBackend = SyslogSettings {+ ssFormat :: F.Format -- ^ Log message format. Usually you do not want to put time here,+ -- because syslog writes time to log by itself by default.+ , ssIdent :: String -- ^ Syslog source identifier. Usually the name of your program.+ , ssOptions :: [Syslog.Option] -- ^ Syslog options+ , ssFacility :: Syslog.Facility -- ^ Syslog facility. It is usally User, if you are writing user-space+ -- program.+ } + initLogBackend settings = do+ ident <- newCString (ssIdent settings)+ tcache <- newTimeCache simpleTimeFormat'+ Syslog.openlog ident (ssOptions settings) (ssFacility settings)+ return $ SyslogBackend settings ident tcache++ cleanupLogBackend backend = do+ free $ sbIdent backend+ Syslog.closelog++ makeLogger backend msg = do+ let settings = sbSettings backend+ let format = ssFormat settings+ facility = ssFacility settings+ tcache = sbTimeCache backend+ time <- tcache+ let str = formatLogMessage format msg time+ BSU.unsafeUseAsCStringLen (fromLogStr str) $+ Syslog.syslog (Just facility) (levelToPriority $ lmLevel msg)+ -- | Logging backend which writes all messages to the @Chan@-data ChanLoggerSettings = ChanLoggerSettings {- clFilter :: LogFilter -- ^ Log messages filter- , clChan :: Chan LogMessage -- ^ @Chan@ where write messages to+data ChanLoggerBackend = ChanLoggerBackend {+ clChan :: Chan LogMessage -- ^ @Chan@ where write messages to } -instance IsLogBackend ChanLoggerSettings where- withLoggingB settings runner (LoggingT actions) = do- runReaderT actions logger- where- logger m = do- let fltr = clFilter settings- when (checkLogLevel fltr m) $ do- liftIO $ writeChan (clChan settings) m+instance IsLogBackend ChanLoggerBackend where+ data LogBackendSettings ChanLoggerBackend =+ ChanLoggerSettings (Chan LogMessage) + initLogBackend (ChanLoggerSettings chan) =+ return $ ChanLoggerBackend chan++ cleanupLogBackend _ = return ()++ makeLogger backend msg = do+ liftIO $ writeChan (clChan backend) msg++-- | Logging backend that writes log messages to several other backends in parallel.+data ParallelBackend = ParallelBackend ![AnyLogBackend]++instance IsLogBackend ParallelBackend where+ data LogBackendSettings ParallelBackend = ParallelLogSettings [LoggingSettings]++ wouldWriteMessage (ParallelBackend list) msg =+ or [wouldWriteMessage backend msg | backend <- list]++ makeLogger (ParallelBackend list) msg =+ forM_ list $ \(AnyLogBackend backend) -> makeLogger backend msg++ initLogBackend (ParallelLogSettings list) = do+ backends <- do + forM list $ \(LoggingSettings settings) -> do+ backend <- initLogBackend settings+ return $ AnyLogBackend backend+ return $ ParallelBackend backends+ + cleanupLogBackend (ParallelBackend list) =+ forM_ (reverse list) $ \(AnyLogBackend backend) -> cleanupLogBackend backend++-- | Messages filtering backend. This backend passes a message to underlying backend,+-- if this message conforms to specified filter.+data Filtering b = FilteringBackend (LogMessage -> Bool) b++-- | Specify filter as @LogFilter@.+filtering :: IsLogBackend b => LogFilter -> LogBackendSettings b -> LogBackendSettings (Filtering b)+filtering fltr b = Filtering (checkLogLevel fltr) b++-- | Exclude messages by filter.+excluding :: IsLogBackend b => LogFilter -> LogBackendSettings b -> LogBackendSettings (Filtering b)+excluding fltr b = Filtering ex b+ where+ ex msg = not $ checkContextFilter' [LogContextFilter Nothing (Just fltr)] (lmSource msg) (lmLevel msg)++instance IsLogBackend b => IsLogBackend (Filtering b) where+ data LogBackendSettings (Filtering b) = Filtering (LogMessage -> Bool) (LogBackendSettings b)++ wouldWriteMessage (FilteringBackend fltr _) msg = fltr msg++ makeLogger (FilteringBackend fltr backend) msg = do+ when (fltr msg) $ do+ makeLogger backend msg++ initLogBackend (Filtering fltr settings) = do+ backend <- initLogBackend settings+ return $ FilteringBackend fltr backend++ cleanupLogBackend (FilteringBackend _ b) = cleanupLogBackend b++-- | Null logging backend, which discards all messages+-- (passes them to @/dev/null@, if you wish).+-- This can be used to disable logging.+data NullBackend = NullBackend++instance IsLogBackend NullBackend where+ data LogBackendSettings NullBackend = NullLogSettings++ wouldWriteMessage _ _ = False++ makeLogger _ _ = return ()++ initLogBackend _ = return NullBackend++ cleanupLogBackend _ = return ()+ -- | Check if message level matches given filter. checkLogLevel :: LogFilter -> LogMessage -> Bool checkLogLevel fltr m =- case lookup (bestMatch (lmSource m) (map fst fltr)) fltr of+ checkLogLevel' fltr (lmSource m) (lmLevel m)++-- | Check if message level matches given filter.+checkLogLevel' :: LogFilter -> LogSource -> Level -> Bool+checkLogLevel' fltr source level =+ case lookup (bestMatch source (map fst fltr)) fltr of Nothing -> False- Just level -> lmLevel m >= level+ Just min -> level <= min where bestMatch :: LogSource -> [LogSource] -> LogSource bestMatch src list = go [] src list@@ -164,4 +258,51 @@ | src == x = x | x `isPrefixOf` src && length x > length best = go x src xs | otherwise = go best src xs++-- | Check if message source and level passes specified filters.+--+-- The message is passed if:+--+-- * No @include@ filters are defined in context stack, OR the message conforms to ANY of @include@ filters;+--+-- * AND the message does not conform to any of @exclude@ filters in the stack.+--+checkContextFilter' :: [LogContextFilter] -> LogSource -> Level -> Bool+checkContextFilter' filters source level =+ let includeFilters = [fltr | LogContextFilter (Just fltr) _ <- filters]+ excludeFilters = [fltr | LogContextFilter _ (Just fltr) <- filters]+ includeOk = null includeFilters || or [checkLogLevel' fltr source level | fltr <- includeFilters]+ excludeOk = or [checkLogLevel' fltr source level | fltr <- excludeFilters]+ in includeOk && not excludeOk++-- | Check if message matches filters from logging context.+--+-- The message is passed if:+--+-- * No @include@ filters are defined in context stack, OR the message conforms to ANY of @include@ filters;+--+-- * AND the message does not conform to any of @exclude@ filters in the stack.+--+checkContextFilter :: LogContext -> LogMessage -> Bool+checkContextFilter context msg =+ checkContextFilter' (map lcfFilter context) (lmSource msg) (lmLevel msg)++-- | Check if message matches filters from logging context.+-- This function is similar to @checkContextFilter@, but uses current context+-- from monadic state.+checkContextFilterM :: HasLogContext m => LogMessage -> m Bool+checkContextFilterM msg = do+ context <- getLogContext+ return $ checkContextFilter context msg++-- | Log a message. This will add current context to context specified+-- in the message.+-- This function checks current context filter.+logMessage :: forall m. (HasLogging m, MonadIO m) => LogMessage -> m ()+logMessage msg = do+ ok <- checkContextFilterM msg+ when ok $ do+ context <- getLogContext+ logger <- getLogger+ liftIO $ logger $ msg {lmContext = context ++ lmContext msg}
src/System/Log/Heavy/Format.hs view
@@ -4,16 +4,36 @@ -- -- Log message format is defined by using @text-format-heavy@ syntax. Variables available are: ----- * level - message severity level+-- * level - message severity level. Variable format can be specified in form of+-- @selector[~convert]@, where: --+-- * @selector@ is @name@ for level name, @value@ for level integer value,+-- @syslog@ for name of syslog equivalent of the level.+--+-- * @convert@ is @u@ for upper case, @l@ for lower case, @t@ for title case+-- (all words capitalized).+-- +-- Default format corresponds to @name@. For example, use @{level:~l}@ to+-- output level name in lower case.+-- -- * source - message source (module name) ----- * location - location from where message was logged (line in source file)+-- * location - location from where message was logged (in form of @(line, column)@). --+-- * line - source file line number from where message was logged.+--+-- * file - source file name from where message was logged.+--+-- * package - name of the package from where message was logged.+-- -- * time - message time -- -- * message - message string itself --+-- * fullcontext - full set of current context variable values, in @name=value; name=value;@ form.+--+-- * Also all variables from context are available.+-- module System.Log.Heavy.Format ( defaultLogFormat, formatLogMessage@@ -21,22 +41,112 @@ import Control.Applicative import Control.Monad-import Control.Monad.Logger (MonadLogger (..), LogLevel (..))-import Data.List (intersperse, intercalate)-import Data.String-import Data.Char+import Data.List (intercalate) import Data.Maybe-import qualified Data.Text as T+import Data.Monoid+import Data.Default+import qualified Data.Map as M import qualified Data.Text.Lazy as TL-import qualified Data.ByteString as B--- import Data.Attoparsec.ByteString+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Text.Lazy.Builder.Int as Builder import System.Log.FastLogger import qualified Data.Text.Format.Heavy as F import qualified Data.Text.Format.Heavy.Parse as PF+import Data.Text.Format.Heavy.Formats (Conversion (..))+import Data.Text.Format.Heavy.Build (convertText)+import Data.Attoparsec.Text+import Language.Haskell.TH.Syntax (Loc (..)) import Prelude hiding (takeWhile) import System.Log.Heavy.Types+import System.Log.Heavy.Level +data LogMessageWithTime = LogMessageWithTime FormattedTime LogMessage++data LevelFormatSelector = ShowLevelName | ShowLevelValue | ShowSyslog+ deriving (Eq, Show)++data LevelFormat = LevelFormat {+ lfSelector :: LevelFormatSelector+ , lfConvert :: Maybe Conversion+ }+ deriving (Eq, Show)++instance Default LevelFormat where+ def = LevelFormat ShowLevelName Nothing++instance F.IsVarFormat LevelFormat where+ parseVarFormat text = either (Left . show) Right $ doParse $ TL.toStrict text+ where+ pFormat :: Parser LevelFormat+ pFormat = do+ mbSelector <- optionMaybe (pSelector <?> "level detail selector")+ let selector = fromMaybe ShowLevelName mbSelector+ mbConvert <- optionMaybe (pConvert <?> "conversion specification")+ return $ LevelFormat selector mbConvert++ optionMaybe p = option Nothing (Just <$> p)++ pSelector :: Parser LevelFormatSelector+ pSelector =+ try (string "value" >> return ShowLevelValue) <|>+ try (string "syslog" >> return ShowSyslog) <|>+ (string "name" >> return ShowLevelName)++ pConvert :: Parser Conversion+ pConvert = do+ char '~'+ conv <- satisfy (`elem` ['u', 'l', 't'])+ case conv of+ 'u' -> return UpperCase+ 'l' -> return LowerCase+ 't' -> return TitleCase++ doParse text = parseOnly pFormat text++instance F.Formatable Level where+ formatVar Nothing level = Right $ Builder.fromText (levelName level)+ formatVar (Just fmt) level = do+ lf <- F.parseVarFormat fmt+ let text = case lfSelector lf of+ ShowLevelName -> Builder.fromText (levelName level)+ ShowLevelValue -> Builder.decimal (levelInt level)+ ShowSyslog -> Builder.fromString (show $ levelToPriority level)+ Right $ convertText (lfConvert lf) text++instance F.VarContainer LogMessageWithTime where+ lookupVar name (LogMessageWithTime ftime (LogMessage {..})) =+ case lookup name stdVariables of+ Just value -> Just value+ Nothing -> Just $ fromMaybe (F.Variable TL.empty) $ msum $ map (lookup name) contextVariables+ where+ stdVariables :: [(TL.Text, F.Variable)]+ stdVariables = [("level", F.Variable lmLevel),+ ("source", F.Variable $ intercalate "." lmSource),+ ("location", F.Variable $ show $ loc_start lmLocation),+ ("line", F.Variable $ fst $ loc_start lmLocation),+ ("file", F.Variable $ loc_filename lmLocation),+ ("package", F.Variable $ loc_package lmLocation),+ ("time", F.Variable ftime),+ ("message", F.Variable formattedMessage),+ ("fullcontext", F.Variable fullContext)]++ contextVariables :: [[(TL.Text, F.Variable)]]+ contextVariables = map lcfVariables lmContext++ fullContext :: TL.Text+ fullContext = TL.concat $ map showContextVar $ M.assocs $ M.fromList $ concat contextVariables++ showContextVar :: (TL.Text, F.Variable) -> TL.Text+ showContextVar (name, value) = name <> "=" <> formatVar value <> "; "++ formatVar :: F.Variable -> TL.Text+ formatVar var = either error Builder.toLazyText $ F.formatVar Nothing var++ formattedMessage =+ let fmt = PF.parseFormat' lmFormatString+ in F.format fmt lmFormatVars+ -- | Default log message format. -- Corresponds to: @{time} [{level}] {source}: {message}\\n@ defaultLogFormat :: F.Format@@ -44,23 +154,5 @@ -- | Format log message for output. formatLogMessage :: F.Format -> LogMessage -> FormattedTime -> LogStr-formatLogMessage fmt (LogMessage {..}) ftime =- toLogStr $ F.format fmt variables- where- variables :: [(TL.Text, F.Variable)]- variables = [("level", F.Variable $ showLevel lmLevel),- ("source", F.Variable $ intercalate "." lmSource),- ("location", F.Variable $ show lmLocation),- ("time", F.Variable ftime),- ("message", F.Variable formattedMessage)]-- formattedMessage =- let fmt = PF.parseFormat' lmFormatString- in F.format fmt lmFormatVars-- showLevel LevelDebug = "debug"- showLevel LevelInfo = "info"- showLevel LevelWarn = "warning"- showLevel LevelError = "error"- showLevel (LevelOther x) = T.unpack x+formatLogMessage fmt msg ftime = toLogStr $ F.format fmt $ LogMessageWithTime ftime msg
+ src/System/Log/Heavy/IO.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, AllowAmbiguousTypes, ScopedTypeVariables, FunctionalDependencies, FlexibleContexts, ConstraintKinds #-}+-- | This module contains implementation of @HasLogger@, @HasLogBackend@, @HasLogContext@ instances for IO monad.+-- This implementation uses thread-local storage, so each thread will have it's own logging state (context and logger).+--+-- This module is not automatically re-exported by System.Log.Heavy, because in many cases it is more convinient to maintain+-- logging state within monadic context, than in global variable.+--+-- Note: implementations of @HasLogger@, @HasLogBackend@, @HasLogContext@ for IO, provided by this module, work only inside+-- @withLoggingIO@ call. If you try to call logging functions outside, you will get runtime error.+--+module System.Log.Heavy.IO+ ( withLoggingIO+ ) where++import Control.Exception+import Data.IORef+import Data.TLS.GHC++import System.IO.Unsafe (unsafePerformIO)++import System.Log.Heavy.Types++-- | Logging state stored in TLS (thread-local storage)+data LoggingIOState = LoggingIOState {+ liosLogger :: SpecializedLogger+ , liosBackend :: AnyLogBackend+ , liosContext :: LogContext+ }++-- | This global variable stores logging state.+-- Nothing inside IORef means that logging state is not initialized yet+-- or is already deinitialized.+loggingTLS :: TLS (IORef (Maybe LoggingIOState))+loggingTLS = unsafePerformIO $ mkTLS $ do+ newIORef Nothing+{-# NOINLINE loggingTLS #-}++-- | Execute IO actions with logging.+--+-- Note 1: logging methods calls in IO monad are only valid inside @withLoggingIO@.+-- If you try to call them outside of this function, you will receive runtime error.+-- +-- Note 2: if you will for some reason call @withLoggingIO@ inside @withLoggingIO@ within one+-- thread, you will receive runtime error.+-- +-- Note 3: You can call @withLoggingIO@ syntactically inside @withLoggingIO@, but within other+-- thread. I.e., the construct like following is valid:+--+-- @+-- withLoggingIO settings $ do+-- \$info "message" ()+-- ...+-- forkIO $ do+-- withLoggingIO settings $ do+-- \$info "message" ()+-- ...+-- @+--+withLoggingIO :: LoggingSettings -- ^ Settings of arbitrary logging backend+ -> IO a -- ^ Actions to be executed with logging+ -> IO a+withLoggingIO (LoggingSettings settings) actions =+ bracket (init settings)+ (cleanup)+ (\tls -> withBackend tls actions)+ where+ init settings = do+ ioref <- getTLS loggingTLS+ mbState <- readIORef ioref+ case mbState of+ Just _ -> fail "Logging IO state is already initialized. withLoggingIO was called twice?"+ Nothing -> do+ backend <- initLogBackend settings+ let logger = makeLogger backend+ let st = LoggingIOState logger (AnyLogBackend backend) []+ writeIORef ioref (Just st)+ return st++ cleanup st = do+ ioref <- getTLS loggingTLS+ freeAllTLS loggingTLS+ writeIORef ioref Nothing++ withBackend st actions = actions++-- | Get current logging state. Fail if it is not initialized yet.+getLogginngIOState :: IO LoggingIOState+getLogginngIOState = do+ ioref <- getTLS loggingTLS+ mbState <- readIORef ioref+ case mbState of+ Nothing -> fail "get: Logging IO state is not initialized. See withLoggingIO."+ Just st -> return st++-- | Modify logging state with pure function.+-- Fail if logging state is not initialized yet.+modifyLoggingIOState :: (LoggingIOState -> LoggingIOState) -> IO ()+modifyLoggingIOState fn = do+ ioref <- getTLS loggingTLS+ modifyIORef ioref $ \mbState ->+ case mbState of+ Nothing -> error "modify: Logging IO state is not initialized. See withLoggingIO."+ Just st -> Just (fn st)++instance HasLogBackend AnyLogBackend IO where+ getLogBackend = do+ st <- getLogginngIOState + return $ liosBackend st++instance HasLogger IO where+ getLogger = do+ st <- getLogginngIOState + return $ liosLogger st++ localLogger logger actions = do+ oldLogger <- getLogger+ modifyLoggingIOState $ \st -> st {liosLogger = logger}+ result <- actions+ modifyLoggingIOState $ \st -> st {liosLogger = oldLogger}+ return result++instance HasLogContext IO where+ getLogContext = do+ st <- getLogginngIOState + return $ liosContext st++ withLogContext frame actions = do+ oldContext <- getLogContext+ modifyLoggingIOState $ \st -> st {liosContext = frame:oldContext}+ result <- actions+ modifyLoggingIOState $ \st -> st {liosContext = oldContext}+ return result+
+ src/System/Log/Heavy/Level.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, AllowAmbiguousTypes, ScopedTypeVariables, FunctionalDependencies, FlexibleContexts, ConstraintKinds #-}++-- | This module contains types and functions for log message severities.+module System.Log.Heavy.Level+ ( -- * Data types+ Level (..),+ -- * Utility functions+ levelToLogLevel, logLevelToLevel,+ parseLevel,+ -- * Standard severity levels+ trace_level, debug_level, info_level, warn_level, error_level, fatal_level,+ disable_logging+ ) where++import Control.Monad.Logger (LogLevel (..))+import qualified Data.Text as T+import qualified System.Posix.Syslog as Syslog++-- | Logging message severity level data type+data Level = Level {+ levelName :: T.Text -- ^ Level name, like @"debug"@ or @"info"@+ , levelInt :: Int -- ^ Integer level identifier. Comparation is based on these identifiers.+ , levelToPriority :: Syslog.Priority -- ^ Syslog equivalent of this level.+ } deriving (Eq)++instance Show Level where+ show l = T.unpack (levelName l)++instance Ord Level where+ compare l1 l2 = compare (levelInt l1) (levelInt l2)++-- | TRACE level is supposed to be used for development-stage debugging.+trace_level :: Level+trace_level = Level "TRACE" 600 Syslog.Debug++-- | DEBUG level is supposed to be used for debug logging that can be+-- enabled on production.+debug_level :: Level+debug_level = Level "DEBUG" 500 Syslog.Debug++-- | INFO level: some event occured.+info_level :: Level+info_level = Level "INFO" 400 Syslog.Info++-- | WARN level: something went wrong, but for now it will not affect+-- system's stability.+warn_level :: Level+warn_level = Level "WARN" 300 Syslog.Warning++-- | ERROR level: something went wrong.+error_level :: Level+error_level = Level "ERROR" 200 Syslog.Error++-- | FATAL level: something went terribly wrong, application is to be stopped.+fatal_level :: Level+fatal_level = Level "FATAL" 100 Syslog.Emergency++-- | DISABLED level. This has integer identifier of 0, which is supposed to+-- be less than any other level. This value can be used to disable logging at+-- all.+disable_logging :: Level+disable_logging = Level "DISABLED" 0 Syslog.Emergency++-- | Conversion function+levelToLogLevel :: Level -> LogLevel+levelToLogLevel l =+ case levelName l of+ "DEBUG" -> LevelDebug+ "INFO" -> LevelInfo+ "WARN" -> LevelWarn+ "ERROR" -> LevelError+ name -> LevelOther name++-- | Convertion function. Note that @LevelOther@ is+-- translated to integer level 210 and Syslog's Alert priority,+-- since in @monad-logger@ semantics any LevelOther is more severe+-- than LevelError.+logLevelToLevel :: LogLevel -> Level+logLevelToLevel LevelDebug = debug_level+logLevelToLevel LevelInfo = info_level+logLevelToLevel LevelWarn = warn_level+logLevelToLevel LevelError = error_level+logLevelToLevel (LevelOther name) = Level name 210 Syslog.Alert++-- | Detect @Level@ from it's name. This function+-- is not case-sensitive.+parseLevel :: [Level] -- ^ List of recognized levels+ -> T.Text -- ^ Level name to find+ -> Maybe Level -- ^ Nothing if no match found+parseLevel knownLevels str = go knownLevels+ where+ go [] = Nothing+ go (l:ls)+ | T.toCaseFold (levelName l) == needle = Just l+ | otherwise = go ls++ needle = T.toCaseFold str+
+ src/System/Log/Heavy/LoggingT.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, AllowAmbiguousTypes, ScopedTypeVariables, FunctionalDependencies, FlexibleContexts, ConstraintKinds #-}+-- | This module contains default implementation of @HasLogBackend@,+-- @HasLogContext@, @HasLogger@ instances, based on @ReaderT@ - @LoggingT@+-- monad transformer.+module System.Log.Heavy.LoggingT+ (+ LoggingT (LoggingT), LoggingTState (..),+ runLoggingT+ ) where++import Control.Monad.Reader+import Control.Monad.Base+import Control.Monad.Trans.Control++import System.Log.Heavy.Types++-- | State of @LoggingT@ monad+data LoggingTState = LoggingTState {+ ltsLogger :: SpecializedLogger+ , ltsBackend :: AnyLogBackend+ , ltsContext :: LogContext+ }++-- | Logging monad transformer.+-- This is just a default implementation of @HasLogging@ interface.+-- Applications are free to use this or another implementation.+newtype LoggingT m a = LoggingT {+ runLoggingT_ :: ReaderT LoggingTState m a+ }+ deriving (Functor, Applicative, Monad, MonadReader LoggingTState, MonadTrans)++deriving instance MonadIO m => MonadIO (LoggingT m)++instance MonadIO m => MonadBase IO (LoggingT m) where+ liftBase = liftIO++instance MonadTransControl LoggingT where+ type StT LoggingT a = StT (ReaderT LoggingTState) a+ liftWith = defaultLiftWith LoggingT runLoggingT_+ restoreT = defaultRestoreT LoggingT++instance (MonadBaseControl IO m, MonadIO m) => MonadBaseControl IO (LoggingT m) where+ type StM (LoggingT m) a = ComposeSt LoggingT m a+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM++instance Monad m => HasLogger (LoggingT m) where+ getLogger = asks ltsLogger+ localLogger l actions = LoggingT $ ReaderT $ \lts -> runReaderT (runLoggingT_ actions) $ lts {ltsLogger = l}++instance (Monad m) => HasLogContext (LoggingT m) where+ getLogContext = asks ltsContext++ withLogContext frame actions =+ LoggingT $ ReaderT $ \lts -> runReaderT (runLoggingT_ actions) $ lts {ltsContext = frame: ltsContext lts}++-- | Run logging monad+runLoggingT :: LoggingT m a -> LoggingTState -> m a+runLoggingT actions context = runReaderT (runLoggingT_ actions) context++instance Monad m => HasLogBackend AnyLogBackend (LoggingT m) where+ getLogBackend = asks ltsBackend+
src/System/Log/Heavy/Shortcuts.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, AllowAmbiguousTypes, FlexibleContexts #-} -- | This module contains some shortcut functions that can be of use in simple usage cases. module System.Log.Heavy.Shortcuts@@ -10,46 +10,46 @@ ) where import Control.Monad.Trans-import Control.Monad.Logger (LogLevel (..)) import qualified Data.Text.Lazy as TL import qualified Data.Text.Format.Heavy as F import System.Log.Heavy.Types+import System.Log.Heavy.Level import System.Log.Heavy.Backends -- | Message stub with Info severity. infoMessage :: F.VarContainer vars => TL.Text -> vars -> LogMessage-infoMessage fmt vars = LogMessage LevelInfo [] undefined fmt vars+infoMessage fmt vars = LogMessage info_level [] undefined fmt vars [] -- | Message stub with Debug severity. debugMessage :: F.VarContainer vars => TL.Text -> vars -> LogMessage-debugMessage fmt vars = LogMessage LevelDebug [] undefined fmt vars+debugMessage fmt vars = LogMessage debug_level [] undefined fmt vars [] -- | Message stub with Error severity. errorMessage :: F.VarContainer vars => TL.Text -> vars -> LogMessage-errorMessage fmt vars = LogMessage LevelError [] undefined fmt vars+errorMessage fmt vars = LogMessage error_level [] undefined fmt vars [] -- | Message stub with Warning severity. warnMessage :: F.VarContainer vars => TL.Text -> vars -> LogMessage-warnMessage fmt vars = LogMessage LevelWarn [] undefined fmt vars+warnMessage fmt vars = LogMessage warn_level [] undefined fmt vars [] -- | Log debug message. -- Note: this message will not contain source information.-debug :: (F.VarContainer vars, MonadIO m) => TL.Text -> vars -> LoggingT m ()+debug :: forall m vars. (F.VarContainer vars, MonadIO m, HasLogging m) => TL.Text -> vars -> m () debug fmt vars = logMessage $ debugMessage fmt vars -- | Log info message. -- Note: this message will not contain source information.-info :: (F.VarContainer vars, MonadIO m) => TL.Text -> vars -> LoggingT m ()+info :: forall m vars. (F.VarContainer vars, MonadIO m, HasLogging m) => TL.Text -> vars -> m () info fmt vars = logMessage $ infoMessage fmt vars -- | Log error message. -- Note: this message will not contain source information.-reportError :: (F.VarContainer vars, MonadIO m) => TL.Text -> vars -> LoggingT m ()+reportError :: forall m vars. (F.VarContainer vars, MonadIO m, HasLogging m) => TL.Text -> vars -> m () reportError fmt vars = logMessage $ errorMessage fmt vars -- | Log warning message. -- Note: this message will not contain source information.-warning :: (F.VarContainer vars, MonadIO m) => TL.Text -> vars -> LoggingT m ()+warning :: forall m vars. (F.VarContainer vars, MonadIO m, HasLogging m) => TL.Text -> vars -> m () warning fmt vars = logMessage $ warnMessage fmt vars
+ src/System/Log/Heavy/TH.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE TemplateHaskell #-}+-- | This module contains TemplateHaskell macros, that can be useful in many applications.+-- In more complex applications, however, you probably will have to write your own adapter macros,+-- which better suits your needs.+module System.Log.Heavy.TH+ (putMessage,+ trace, debug, info, warning, reportError, fatal,+ here, thisModule+ ) where++import Control.Monad.Logger (liftLoc)+-- import Language.Haskell.TH+import Language.Haskell.TH.Syntax hiding (reportError)+import Language.Haskell.TH.Lift+import Instances.TH.Lift () -- import instances only+import qualified System.Posix.Syslog as Syslog++import System.Log.Heavy.Types+import System.Log.Heavy.Level++deriveLift ''Syslog.Priority+deriveLift ''Level++-- | TH macro to put message to log. Usage:+--+-- @+-- \$putMessage info_level "Received message #{}" (Single messageId)+-- @+--+-- Use @()@ as last argument if you do not have variables.+--+-- This code will work in any monad that implements @HasLogging@ constraint.+--+putMessage :: Level -> Q Exp+putMessage level = [| \msg vars -> do+ let loc = $(qLocation >>= liftLoc)+ src = splitDots (loc_module loc)+ message = LogMessage $(lift level) src loc msg vars []+ logMessage message+ |]++-- | TH macro to obtain current location in haskell source file.+-- Can be useful to construct @LogMessage@ structures 'by hand'.+here :: Q Exp+here = qLocation >>= liftLoc++-- | TH macro to obtain current module name in form of @LogSource@.+-- Can be useful to construct @LogMessage@ structures 'by hand'.+thisModule :: Q Exp+thisModule = do+ loc <- qLocation+ lift $ splitDots (loc_module loc)++-- | TH macro to log a message with TRACE level. Usage:+--+-- @+-- \$trace "hello, {}!" (Single name)+-- @+--+trace :: Q Exp+trace = putMessage trace_level++-- | TH macro to log a message with DEBUG level. Usage:+--+-- @+-- \$debug "hello, {}!" (Single name)+-- @+--+debug :: Q Exp+debug = putMessage debug_level++-- | TH macro to log a message with INFO level. Usage:+--+-- @+-- \$info "hello, {}!" (Single name)+-- @+--+info :: Q Exp+info = putMessage info_level++-- | TH macro to log a message with WARN level. Usage:+--+-- @+-- \$warning "Beware the {}!" (Single name)+-- @+--+warning :: Q Exp+warning = putMessage warn_level++-- | TH macro to log a message with ERROR level. Usage:+--+-- @+-- \$reportError "Transaction #{} was declined." (Single transactionId)+-- @+--+reportError :: Q Exp+reportError = putMessage error_level++-- | TH macro to log a message with FATAL level. Usage:+--+-- @+-- \$fatal "Cannot establish database connection" ()+-- @+--+fatal :: Q Exp+fatal = putMessage fatal_level+
src/System/Log/Heavy/Types.hs view
@@ -1,108 +1,233 @@-{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, AllowAmbiguousTypes, ScopedTypeVariables, FunctionalDependencies, FlexibleContexts, ConstraintKinds #-} -- | This module contains generic types definition, along with some utilities. module System.Log.Heavy.Types (- LogSource, LogMessage (..), LogFilter,- IsLogBackend (..), LogBackend (..), Logger,- LoggingT (LoggingT), runLoggingT,+ -- * Data types+ LogSource, LogMessage (..), LogFilter, LogContextFrame (..), LogContext,+ IsLogBackend (..), LogBackendSettings (..), LoggingSettings (..),+ AnyLogBackend (..), LogContextFilter (..),+ include, exclude, noChange,+ Logger,SpecializedLogger, + HasLogBackend (..), HasLogContext (..), HasLogging,+ HasLogger (..),+ -- * Main functions+ logMessage',+ applyBackend, defaultLogFilter,+ withLogVariable,+ -- * Utility functions splitString, splitDots,- logMessage ) where import Control.Monad.Reader-import Control.Monad.Logger (MonadLogger (..), LogLevel (..))-import Control.Monad.Base+import Control.Monad.Logger (MonadLogger (..)) import Control.Monad.Trans.Control-import Data.String+import Control.Exception.Lifted (bracket) import Language.Haskell.TH import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL-import System.Log.FastLogger import qualified Data.Text.Format.Heavy as F+import System.Log.FastLogger +import System.Log.Heavy.Level+ -- | Log message source. This is usually a list of program module names, -- for example @[\"System\", \"Log\", \"Heavy\", \"Types\"]@. type LogSource = [String] --- | Log message structure+-- | Log message structure. You usually will want to use some sort+-- of shortcut function to create messages. There are some provided+-- by this package:+--+-- * @System.Log.Heavy.Shortcuts@ module exports simple functions, that can be used+-- in simple cases, when you do not want to write or check message source.+--+-- * @System.Log.Heavy.TH@ module exports TH macros, which correctly fill message+-- source and location.+-- data LogMessage = forall vars. F.VarContainer vars => LogMessage {- lmLevel :: LogLevel -- ^ Log message level+ lmLevel :: Level -- ^ Log message level , lmSource :: LogSource -- ^ Log message source (module) , lmLocation :: Loc -- ^ Log message source (exact location). You usually -- will want to use TH quotes to fill this. , lmFormatString :: TL.Text -- ^ Log message string format (in @Data.Text.Format.Heavy@ syntax) , lmFormatVars :: vars -- ^ Log message substitution variables. Use @()@ if you do not have variables.+ , lmContext :: LogContext -- ^ Logging context. Authomatically filled by @logMessage@. } -- | Log messages filter by source and level. -- -- Semantics under this is that @(source, severity)@ pair allows to write -- messages from @source@ of @severity@ (and all more important messages) to log.-type LogFilter = [(LogSource, LogLevel)]+type LogFilter = [(LogSource, Level)] -- | Default log messages filter. This says pass all messages -- of level Info or higher. defaultLogFilter :: LogFilter-defaultLogFilter = [([], LevelInfo)]+defaultLogFilter = [([], info_level)] +-- | One frame in logging context stack.+data LogContextFrame = LogContextFrame {+ lcfVariables :: [(TL.Text, F.Variable)] -- ^ Context variables+ , lcfFilter :: LogContextFilter -- ^ Context events filter+ }+ deriving (Show)++-- | Events filter for specific logging context.+data LogContextFilter =+ LogContextFilter {+ setInclude :: Maybe LogFilter -- ^ Positive filter (include specified messages)+ , setExclude :: Maybe LogFilter -- ^ Negative filter (exclude specified messages)+ }+ deriving (Eq, Show)++-- | Do not affect context filter settings+noChange :: LogContextFilter+noChange = LogContextFilter Nothing Nothing++-- | Create filter which includes only specified messages+include :: LogFilter -> LogContextFilter+include f = LogContextFilter (Just f) Nothing++-- | Create filter which just excludes specified messages+exclude :: LogFilter -> LogContextFilter+exclude f = LogContextFilter Nothing (Just f)++-- | Logging context stack+type LogContext = [LogContextFrame]+ -- | Logging backend class. class IsLogBackend b where- -- | Run LoggingT within some kind of IO monad- withLoggingB :: (MonadIO m)- => b -- ^ Backend settings- -> (m a -> IO a) -- ^ Runner that allows to run this @m@ within @IO@- -> LoggingT m a -- ^ Actions within @LoggingT@ monad- -> m a+ -- | Logging backend settings data type+ data LogBackendSettings b + -- | Create logger from backend+ makeLogger :: Logger b++ -- | Initialize logging backend from settings+ initLogBackend :: LogBackendSettings b -> IO b++ -- | Should return True if the specified message would be+ -- actually written to the log. Default implementation + -- always returns True.+ wouldWriteMessage :: b -> LogMessage -> Bool+ wouldWriteMessage _ _ = True++ -- | Cleanup logging backend (release resources and so on)+ cleanupLogBackend :: b -> IO ()++ -- | Bracket function. Concrete implementations usually+ -- do not have to override default implementation.+ withLoggingB :: (MonadBaseControl IO m, MonadIO m)+ => LogBackendSettings b+ -> (b -> m a)+ -> m a+ withLoggingB settings actions = do+ bracket (liftIO $ initLogBackend settings)+ (liftIO . cleanupLogBackend)+ (actions)++-- | Container data type for representing arbitrary logging backend.+data AnyLogBackend = forall b. IsLogBackend b => AnyLogBackend b++instance IsLogBackend AnyLogBackend where+ data LogBackendSettings AnyLogBackend =+ AnyLogBackendSettings LoggingSettings++ makeLogger (AnyLogBackend backend) = makeLogger backend++ wouldWriteMessage (AnyLogBackend backend) msg =+ wouldWriteMessage backend msg++ initLogBackend (AnyLogBackendSettings (LoggingSettings settings)) =+ AnyLogBackend `fmap` initLogBackend settings++ cleanupLogBackend (AnyLogBackend backend) = cleanupLogBackend backend++-- | Constraint for monads in which it is possible to obtain logging backend.+class IsLogBackend b => HasLogBackend b m where+ getLogBackend :: m b+ -- | A container for arbitrary logging backend. -- You usually will use this similar to: -- -- @--- getLoggingSettings :: String -> LogBackend--- getLoggingSettings "syslog" = LogBackend defaultsyslogsettings+-- getLoggingSettings :: String -> LoggingSettings+-- getLoggingSettings "syslog" = LoggingSettings defaultsyslogsettings -- @-data LogBackend = forall b. IsLogBackend b => LogBackend b+data LoggingSettings = forall b. IsLogBackend b => LoggingSettings (LogBackendSettings b) --- | Logging monad transformer.-newtype LoggingT m a = LoggingT {- runLoggingT_ :: ReaderT Logger m a- }- deriving (Functor, Applicative, Monad, MonadReader Logger, MonadTrans)+-- | Logging function+type Logger backend = backend -> LogMessage -> IO () -deriving instance MonadIO m => MonadIO (LoggingT m)+-- | Logging function applied to concrete backend+type SpecializedLogger = LogMessage -> IO () -instance MonadIO m => MonadBase IO (LoggingT m) where- liftBase = liftIO+-- | Type class for monads that can write logs+class Monad m => HasLogger m where+ getLogger :: m SpecializedLogger+ + -- | Change logger to specified one locally+ localLogger :: SpecializedLogger -> m a -> m a -instance MonadTransControl LoggingT where- type StT LoggingT a = StT (ReaderT Logger) a- liftWith = defaultLiftWith LoggingT runLoggingT_- restoreT = defaultRestoreT LoggingT+-- instance (Monad m, MonadReader SpecializedLogger m) => HasLogger m where+-- getLogger = ask+-- localLogger l = local (const l) -instance (MonadBaseControl IO m, MonadIO m) => MonadBaseControl IO (LoggingT m) where- type StM (LoggingT m) a = ComposeSt LoggingT m a- liftBaseWith = defaultLiftBaseWith- restoreM = defaultRestoreM+-- | Apply logging backend locally.+applyBackend :: (IsLogBackend b, HasLogger m) => b -> m a -> m a+applyBackend b actions = do+ let logger = makeLogger b+ localLogger logger actions --- | Run logging monad-runLoggingT :: LoggingT m a -> Logger -> m a-runLoggingT actions logger = runReaderT (runLoggingT_ actions) logger+-- | Type class for monads that store logging context+class Monad m => HasLogContext m where+ -- | Execute actions within logging context frame+ withLogContext :: LogContextFrame -> m a -> m a --- | Logging function-type Logger = LogMessage -> IO ()+ -- | Obtain currently active logging context stack+ getLogContext :: m LogContext -textFromLogStr :: ToLogStr str => str -> TL.Text-textFromLogStr str = TL.fromStrict $ TE.decodeUtf8 $ fromLogStr $ toLogStr str+-- GHC will not be able to select instance for LoggingT.+-- instance (Monad m, HasLogBackend b m) => HasLogBackend AnyLogBackend m where+-- getLogBackend = do+-- backend <- getLogBackend :: m b+-- return $ AnyLogBackend backend -instance MonadIO m => MonadLogger (LoggingT m) where- monadLoggerLog loc src level msg =- logMessage $ LogMessage level src' loc (textFromLogStr msg) ()+-- | Convinience constraint synonym.+type HasLogging m = (HasLogger m, HasLogContext m)++-- | Shortcut function to execute actions within logging context frame,+-- which contains only one variable+withLogVariable :: (HasLogContext m, F.Formatable v)+ => TL.Text -- ^ Variable name+ -> v -- ^ Variable value+ -> m a -- ^ Actions to execute within context frame+ -> m a+withLogVariable name value =+ withLogContext (LogContextFrame [(name, F.Variable value)] noChange)++-- | Compatibility instance.+instance (Monad m, MonadIO m, HasLogging m) => MonadLogger m where+ monadLoggerLog loc src level msg = do+ logger <- getLogger+ context <- getLogContext+ liftIO $ logger $ LogMessage {+ lmLevel = logLevelToLevel level,+ lmSource = src',+ lmLocation = loc,+ lmFormatString = textFromLogStr msg,+ lmFormatVars = (),+ lmContext = context+ } where src' = splitDots $ T.unpack src + textFromLogStr :: ToLogStr str => str -> TL.Text+ textFromLogStr str = TL.fromStrict $ TE.decodeUtf8 $ fromLogStr $ toLogStr str+ instance F.Formatable LogStr where formatVar fmt str = F.formatVar fmt $ fromLogStr str @@ -118,9 +243,9 @@ splitDots :: String -> [String] splitDots = splitString '.' --- | Log a message-logMessage :: (MonadIO m) => LogMessage -> LoggingT m ()-logMessage m = do- logger <- ask- liftIO $ logger m+-- | Log a message. This version is for monads that do not know about logging contexts.+logMessage' :: forall m. (HasLogger m, MonadIO m) => LogMessage -> m ()+logMessage' msg = do+ logger <- getLogger+ liftIO $ logger msg