Add support for logger-specific log-levels.

0.11

-----------------------------------------------------------------------------

- Add support for logger-specific log-levels.

- Changed logger `name` in settings to `Maybe Text`.

0.10

-----------------------------------------------------------------------------

- Introduce `Settings` module.

-- 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

    , name

    , setName

      -- * Type definitions

    , Logger

    , Level      (..)

    , Output     (..)

    , DateFormat

    , iso8601UTC

    , Logger

      -- * Core API

    , new

    , create

    , level

    , clone

    , settings

      -- ** Logging

    , log

    , trace

    , debug

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

-- 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"

    g <- fn (output s) (fromMaybe (bufSize s) n)

    let s' = setLogLevel (fromMaybe (logLevel s) l)

    !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)

    Logger g s' <$> mkGetDate (format s)

  where

    fn StdOut   = FL.newStdoutLoggerSet

    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

{-# 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 ()

    , netstrings

    , setNetStrings

    , logLevel

    , logLevelMap

    , logLevelOf

    , setLogLevel

    , setLogLevelMap

    , setLogLevelOf

    , name

    , setName

    , nameMsg

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

    , _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 <http://cr.yp.to/proto/netstrings.txt netstrings> encoding (fixes delimiter to \",\")

    , _bufSize    :: !Int           -- ^ how many bytes to buffer before commiting to sink

    , _name       :: !Text       -- ^ logger name

    , _name       :: Maybe Text     -- ^ logger name

    , _nameMsg    :: Msg -> Msg

    }

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

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 <http://cr.yp.to/proto/netstrings.txt netstring>

-- encoding for log lines.

netstrings :: Settings -> Bool

netstrings = _netstrings

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

--

--   * '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

name:                 tinylog

version:              0.10.5

version:              0.11

synopsis:             Simplistic logging using fast-logger.

author:               Toralf Wittner

maintainer:           Toralf Wittner <tw@dtex.org>

    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

    build-depends:

          base       == 4.*

        , bytestring

        , criterion  >= 1.0.0.2 && < 2.0

        , criterion  >= 1.0.0.2

        , tinylog