From f34402d2b5e53ec981983419c6437cdbb7f1018a Mon Sep 17 00:00:00 2001 From: Toralf Wittner Date: Thu, 13 Nov 2014 22:10:31 +0100 Subject: [PATCH] Add support for logger-specific log-levels. --- CHANGELOG.md | 5 +++ src/System/Logger.hs | 68 +++++++++++++++++++++++++++-------- src/System/Logger/Settings.hs | 52 ++++++++++++++++++++------- tinylog.cabal | 15 ++++---- 4 files changed, 105 insertions(+), 35 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d12c003..fb17449 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +0.11 +----------------------------------------------------------------------------- +- Add support for logger-specific log-levels. +- Changed logger `name` in settings to `Maybe Text`. + 0.10 ----------------------------------------------------------------------------- - Introduce `Settings` module. diff --git a/src/System/Logger.hs b/src/System/Logger.hs index 5f38fcf..1e441c4 100644 --- a/src/System/Logger.hs +++ b/src/System/Logger.hs @@ -2,15 +2,19 @@ -- License, v. 2.0. If a copy of the MPL was not distributed with this -- file, You can obtain one at http://mozilla.org/MPL/2.0/. +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -- | Small layer on top of @fast-logger@ which adds log-levels and --- timestamp support (using @date-cache@) and not much more. +-- timestamp support and not much more. module System.Logger - ( Settings + ( -- * Settings + Settings , defSettings , logLevel , setLogLevel + , logLevelOf + , setLogLevelOf , output , setOutput , format @@ -24,13 +28,14 @@ module System.Logger , name , setName - , Level (..) - , Output (..) - + -- * Type definitions + , Logger + , Level (..) + , Output (..) , DateFormat , iso8601UTC - , Logger + -- * Core API , new , create , level @@ -39,6 +44,7 @@ module System.Logger , clone , settings + -- ** Logging , log , trace , debug @@ -62,6 +68,7 @@ import System.Environment (lookupEnv) import System.Logger.Message as M import System.Logger.Settings +import qualified Data.Map.Strict as Map import qualified System.Log.FastLogger as FL data Logger = Logger @@ -75,15 +82,38 @@ data Logger = Logger -- the environment variable @LOG_LEVEL@ accordingly. Likewise the buffer -- size can be dynamically set via @LOG_BUFFER@ and netstrings encoding -- can be enabled with @LOG_NETSTR=True@ +-- +-- Since version 0.11 one can also use @LOG_LEVEL_MAP@ to specify log +-- levels per (named) logger. The syntax uses standard haskell syntax for +-- association lists of type @[(Text, Level)]@. For example: +-- +-- @ +-- $ LOG_LEVEL=Info LOG_LEVEL_MAP='[("foo", Warn), ("bar", Trace)]' cabal repl +-- > g1 <- new defSettings +-- > let g2 = clone (Just "foo") g +-- > let g3 = clone (Just "bar") g +-- > let g4 = clone (Just "xxx") g +-- > logLevel (settings g1) +-- Info +-- > logLevel (settings g2) +-- Warn +-- > logLevel (settings g3) +-- Trace +-- > logLevel (settings g4) +-- Info +-- @ new :: MonadIO m => Settings -> m Logger new s = liftIO $ do - n <- fmap (readNote "Invalid LOG_BUFFER") <$> lookupEnv "LOG_BUFFER" - l <- fmap (readNote "Invalid LOG_LEVEL") <$> lookupEnv "LOG_LEVEL" - e <- fmap (readNote "Invalid LOG_NETSTR") <$> lookupEnv "LOG_NETSTR" + !n <- fmap (readNote "Invalid LOG_BUFFER") <$> lookupEnv "LOG_BUFFER" + !l <- fmap (readNote "Invalid LOG_LEVEL") <$> lookupEnv "LOG_LEVEL" + !e <- fmap (readNote "Invalid LOG_NETSTR") <$> lookupEnv "LOG_NETSTR" + !m <- fromMaybe "[]" <$> lookupEnv "LOG_LEVEL_MAP" + let !k = logLevelMap s `mergeWith` m + let !s' = setLogLevel (fromMaybe (logLevel s) l) + . setNetStrings (fromMaybe (netstrings s) e) + . setLogLevelMap k + $ s g <- fn (output s) (fromMaybe (bufSize s) n) - let s' = setLogLevel (fromMaybe (logLevel s) l) - . setNetStrings (fromMaybe (netstrings s) e) - $ s Logger g s' <$> mkGetDate (format s) where fn StdOut = FL.newStdoutLoggerSet @@ -94,6 +124,8 @@ new s = liftIO $ do mkGetDate f = mkAutoUpdate defaultUpdateSettings { updateAction = msg . formatUnixTimeGMT (template f) <$> getUnixTime } + mergeWith m e = Map.fromList (readNote "Invalid LOG_LEVEL_MAP" e) `Map.union` m + -- | Invokes 'new' with default settings and the given output as log sink. create :: MonadIO m => Output -> m Logger create o = new $ setOutput o defSettings @@ -125,10 +157,16 @@ fatal g = log g Fatal {-# INLINE fatal #-} -- | Clone the given logger and optionally give it a name --- (use @(Just \"\")@ to clear). +-- (use @Nothing@ to clear). +-- +-- If 'logLevelOf' returns a custom 'Level' for this name +-- then the cloned logger will use it for its log messages. clone :: Maybe Text -> Logger -> Logger -clone (Just n) g = g { settings = setName n (settings g) } -clone Nothing g = g +clone Nothing g = g { settings = setName Nothing (settings g) } +clone (Just n) g = + let s = settings g + l = fromMaybe (logLevel s) $ logLevelOf n s + in g { settings = setName (Just n) . setLogLevel l $ s } -- | Force buffered bytes to output sink. flush :: MonadIO m => Logger -> m () diff --git a/src/System/Logger/Settings.hs b/src/System/Logger/Settings.hs index 988927a..891b6bf 100644 --- a/src/System/Logger/Settings.hs +++ b/src/System/Logger/Settings.hs @@ -22,7 +22,11 @@ module System.Logger.Settings , netstrings , setNetStrings , logLevel + , logLevelMap + , logLevelOf , setLogLevel + , setLogLevelMap + , setLogLevelOf , name , setName , nameMsg @@ -32,18 +36,20 @@ module System.Logger.Settings import Data.String import Data.ByteString (ByteString) import Data.ByteString.Char8 (pack) +import Data.Map.Strict as Map import Data.Text (Text) import System.Log.FastLogger (defaultBufSize) import System.Logger.Message data Settings = Settings - { _logLevel :: !Level -- ^ messages below this log level will be suppressed - , _output :: !Output -- ^ log sink - , _format :: !DateFormat -- ^ the timestamp format (use \"\" to disable timestamps) - , _delimiter :: !ByteString -- ^ text to intersperse between fields of a log line - , _netstrings :: !Bool -- ^ use encoding (fixes delimiter to \",\") - , _bufSize :: !Int -- ^ how many bytes to buffer before commiting to sink - , _name :: !Text -- ^ logger name + { _logLevel :: !Level -- ^ messages below this log level will be suppressed + , _levelMap :: Map Text Level -- ^ log level per named logger + , _output :: !Output -- ^ log sink + , _format :: !DateFormat -- ^ the timestamp format (use \"\" to disable timestamps) + , _delimiter :: !ByteString -- ^ text to intersperse between fields of a log line + , _netstrings :: !Bool -- ^ use encoding (fixes delimiter to \",\") + , _bufSize :: !Int -- ^ how many bytes to buffer before commiting to sink + , _name :: Maybe Text -- ^ logger name , _nameMsg :: Msg -> Msg } @@ -53,6 +59,7 @@ output = _output setOutput :: Output -> Settings -> Settings setOutput x s = s { _output = x } +-- | The time and date format used for the timestamp part of a log line. format :: Settings -> DateFormat format = _format @@ -65,12 +72,15 @@ bufSize = _bufSize setBufSize :: Int -> Settings -> Settings setBufSize x s = s { _bufSize = max 1 x } +-- | Delimiter string which separates log line parts. delimiter :: Settings -> ByteString delimiter = _delimiter setDelimiter :: ByteString -> Settings -> Settings setDelimiter x s = s { _delimiter = x } +-- | Whether to use +-- encoding for log lines. netstrings :: Settings -> Bool netstrings = _netstrings @@ -83,12 +93,28 @@ logLevel = _logLevel setLogLevel :: Level -> Settings -> Settings setLogLevel x s = s { _logLevel = x } -name :: Settings -> Text +-- | Log level of some named logger. +logLevelOf :: Text -> Settings -> Maybe Level +logLevelOf x s = Map.lookup x (_levelMap s) + +logLevelMap :: Settings -> Map Text Level +logLevelMap = _levelMap + +-- | Specify a log level for the given named logger. When a logger is +-- 'clone'd and given a name, the 'logLevel' of the cloned logger will be +-- the provided here. +setLogLevelOf :: Text -> Level -> Settings -> Settings +setLogLevelOf n x s = s { _levelMap = Map.insert n x (_levelMap s) } + +setLogLevelMap :: Map Text Level -> Settings -> Settings +setLogLevelMap x s = s { _levelMap = x } + +name :: Settings -> Maybe Text name = _name -setName :: Text -> Settings -> Settings -setName "" s = s { _name = "", _nameMsg = id } -setName xs s = s { _name = xs, _nameMsg = "logger" .= xs } +setName :: Maybe Text -> Settings -> Settings +setName Nothing s = s { _name = Nothing, _nameMsg = id } +setName (Just xs) s = s { _name = Just xs, _nameMsg = "logger" .= xs } nameMsg :: Settings -> (Msg -> Msg) nameMsg = _nameMsg @@ -133,8 +159,8 @@ iso8601UTC = "%Y-%0m-%0dT%0H:%0M:%0SZ" -- -- * 'bufSize' = 'FL.defaultBufSize' -- --- * 'name' = \"\" +-- * 'name' = Nothing -- defSettings :: Settings -defSettings = Settings Debug StdOut iso8601UTC ", " False defaultBufSize "" id +defSettings = Settings Debug Map.empty StdOut iso8601UTC ", " False defaultBufSize Nothing id diff --git a/tinylog.cabal b/tinylog.cabal index 6a031f9..90c9609 100644 --- a/tinylog.cabal +++ b/tinylog.cabal @@ -1,5 +1,5 @@ name: tinylog -version: 0.10.5 +version: 0.11 synopsis: Simplistic logging using fast-logger. author: Toralf Wittner maintainer: Toralf Wittner @@ -36,13 +36,14 @@ library build-depends: base == 4.* - , bytestring >= 0.10.4 && < 1.0 + , bytestring >= 0.10.4 , auto-update >= 0.1 && < 0.2 - , double-conversion >= 0.2 && < 3.0 + , containers >= 0.5 + , double-conversion >= 0.2 , fast-logger >= 2.1.4 && < 2.3 - , text >= 0.11 && < 2.0 - , transformers >= 0.3 && < 1.0 - , unix-time >= 0.1 && < 0.4 + , text >= 0.11 + , transformers >= 0.3 + , unix-time >= 0.1 benchmark tinylog-bench type: exitcode-stdio-1.0 @@ -53,5 +54,5 @@ benchmark tinylog-bench build-depends: base == 4.* , bytestring - , criterion >= 1.0.0.2 && < 2.0 + , criterion >= 1.0.0.2 , tinylog -- GitLab