Commit cf6c2330 authored by Toralf Wittner's avatar Toralf Wittner
Browse files

Introduce `Settings` module.

parent 07490f8b

src/System/Logger.hs

+40 −80
Original line number Diff line number Diff line
@@ -7,19 +7,37 @@ 
-- | Small layer on top of @fast-logger@ which adds log-levels and

-- timestamp support (using @date-cache@) and not much more.

module System.Logger

    ( Level    (..)

    ( Settings

    , defSettings

    , logLevel

    , setLogLevel

    , output

    , setOutput

    , format

    , setFormat

    , delimiter

    , setDelimiter

    , netstrings

    , setNetStrings

    , bufSize

    , setBufSize

    , name

    , setName



    , Level    (..)

    , Output   (..)

    , Settings (..)

    , Logger



    , DateFormat

    , iso8601UTC



    , Logger

    , new

    , create

    , defSettings

    , level

    , flush

    , close

    , clone

    , settings



    , log

    , trace
@@ -29,7 +47,6 @@ module System.Logger 
    , err

    , fatal



    , iso8601UTC

    , module M

    ) where
@@ -38,81 +55,23 @@ import Control.Applicative 
import Control.Monad

import Control.Monad.IO.Class

import Data.ByteString (ByteString)

import Data.ByteString.Char8 (pack)

import Data.Maybe (fromMaybe)

import Data.String

import Data.Text (Text)

import Data.UnixTime

import System.Date.Cache

import System.Environment (lookupEnv)

import System.Log.FastLogger (BufSize)

import System.Logger.Message as M

import System.Logger.Settings



import qualified Data.Text             as T

import qualified System.Log.FastLogger as FL



data Level

    = Trace

    | Debug

    | Info

    | Warn

    | Error

    | Fatal

    deriving (Eq, Ord, Read, Show)



data Logger = Logger

    { _logger    :: FL.LoggerSet

    , _settings  :: Settings

    , _getDate   :: Maybe DateCacheGetter

    , _closeDate :: Maybe DateCacheCloser

    { logger    :: FL.LoggerSet

    , settings  :: Settings

    , getDate   :: Maybe DateCacheGetter

    , closeDate :: Maybe DateCacheCloser

    }



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

    , bufSize    :: BufSize    -- ^ how many bytes to buffer before commiting to sink

    , name       :: Text       -- ^ logger name (use \"\" to unset)

    } deriving (Eq, Ord, Show)



data Output

    = StdOut

    | StdErr

    | Path FilePath

    deriving (Eq, Ord, Show)



newtype DateFormat = DateFormat

    { template :: ByteString

    } deriving (Eq, Ord, Show)



instance IsString DateFormat where

    fromString = DateFormat . pack



-- | ISO 8601 date-time format.

iso8601UTC :: DateFormat

iso8601UTC = "%Y-%0m-%0dT%0H:%0M:%0SZ"



-- | Default settings for use with 'new':

--

--   * 'logLevel'   = 'Debug'

--

--   * 'output'     = 'StdOut'

--

--   * 'format'     = 'iso8601UTC'

--

--   * 'delimiter'  = \", \"

--

--   * 'netstrings' = False

--

--   * 'bufSize'    = 'FL.defaultBufSize'

--

--   * 'name'       = \"\"

--

defSettings :: Settings

defSettings = Settings Debug StdOut iso8601UTC ", " False FL.defaultBufSize ""



-- | Create a new 'Logger' with the given 'Settings'.

-- Please note that the 'logLevel' can be dynamically adjusted by setting

-- the environment variable @LOG_LEVEL@ accordingly. Likewise the buffer
@@ -170,34 +129,35 @@ fatal g = log g Fatal 
{-# INLINE err   #-}

{-# INLINE fatal #-}



-- | Clone the given logger and optionally give it a name.

-- | Clone the given logger and optionally give it a name

-- (use @(Just \"\")@ to clear).

clone :: Maybe Text -> Logger -> Logger

clone (Just n) g = g { _settings = (_settings g) { name = n } }

clone (Just n) g = g { settings = setName n  (settings g) }

clone Nothing  g = g



-- | Force buffered bytes to output sink.

flush :: MonadIO m => Logger -> m ()

flush = liftIO . FL.flushLogStr . _logger

flush = liftIO . FL.flushLogStr . logger



-- | Closes the logger.

close :: MonadIO m => Logger -> m ()

close g = liftIO $ do

    fromMaybe (return ()) (_closeDate g)

    FL.rmLoggerSet (_logger g)

    fromMaybe (return ()) (closeDate g)

    FL.rmLoggerSet (logger g)



-- | Inspect this logger's threshold.

level :: Logger -> Level

level = logLevel . _settings

level = logLevel . settings

{-# INLINE level #-}



putMsg :: MonadIO m => Logger -> Level -> (Msg -> Msg) -> m ()

putMsg g l f = liftIO $ do

    d <- maybe (return id) (liftM msg) (_getDate g)

    let n = netstrings $ _settings g

    let x = delimiter  $ _settings g

    let s = name       $ _settings g

    let m = render x n (d . msg (l2b l) . (if T.null s then id else "logger" .= s) . f)

    FL.pushLogStr (_logger g) (FL.toLogStr m)

    d <- maybe (return id) (liftM msg) (getDate g)

    let n = netstrings $ settings g

    let x = delimiter  $ settings g

    let s = nameMsg    $ settings g

    let m = render x n (d . msg (l2b l) . s . f)

    FL.pushLogStr (logger g) (FL.toLogStr m)

  where

    l2b :: Level -> ByteString

    l2b Trace = "T"

src/System/Logger/Class.hs

+31 −11
Original line number Diff line number Diff line
@@ -6,24 +6,44 @@ 


-- | The 'MonadLogger' type-class and associated functions.

module System.Logger.Class

    ( MonadLogger (..)

    , trace

    , debug

    , info

    , warn

    , err

    , fatal

    ( L.Settings

    , L.defSettings

    , L.logLevel

    , L.setLogLevel

    , L.output

    , L.setOutput

    , L.format

    , L.setFormat

    , L.delimiter

    , L.setDelimiter

    , L.netstrings

    , L.setNetStrings

    , L.bufSize

    , L.setBufSize

    , L.name

    , L.setName



    , L.Level    (..)

    , L.Output   (..)

    , L.Settings (..)

    , L.Logger



    , L.DateFormat

    , L.iso8601UTC



    , L.new

    , L.create

    , L.defSettings

    , L.iso8601UTC

    , L.level

    , L.flush

    , L.close

    , L.clone

    , L.settings



    , MonadLogger (..)

    , trace

    , debug

    , info

    , warn

    , err

    , fatal



    , module M

    ) where

src/System/Logger/Settings.hs

0 → 100644
+93 −0
Original line number Diff line number Diff line 
-- This Source Code Form is subject to the terms of the Mozilla Public

-- 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 OverloadedStrings #-}



module System.Logger.Settings where



import Data.String

import Data.ByteString (ByteString)

import Data.ByteString.Char8 (pack)

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

    , nameMsg    :: Msg -> Msg

    }



setOutput :: Output -> Settings -> Settings

setOutput x s = s { output = x }



setFormat :: DateFormat -> Settings -> Settings

setFormat x s = s { format = x }



setBufSize :: Int -> Settings -> Settings

setBufSize x s = s { bufSize = max 1 x }



setDelimiter :: ByteString -> Settings -> Settings

setDelimiter x s = s { delimiter = x }



setNetStrings :: Bool -> Settings -> Settings

setNetStrings x s = s { netstrings = x }



setLogLevel :: Level -> Settings -> Settings

setLogLevel x s = s { logLevel = x }



setName :: Text -> Settings -> Settings

setName "" s = s { name = "", nameMsg = id }

setName xs s = s { name = xs, nameMsg = "logger" .= xs }



data Level

    = Trace

    | Debug

    | Info

    | Warn

    | Error

    | Fatal

    deriving (Eq, Ord, Read, Show)



data Output

    = StdOut

    | StdErr

    | Path FilePath

    deriving (Eq, Ord, Show)



newtype DateFormat = DateFormat

    { template :: ByteString

    } deriving (Eq, Ord, Show)



instance IsString DateFormat where

    fromString = DateFormat . pack



-- | ISO 8601 date-time format.

iso8601UTC :: DateFormat

iso8601UTC = "%Y-%0m-%0dT%0H:%0M:%0SZ"



-- | Default settings:

--

--   * 'logLevel'   = 'Debug'

--

--   * 'output'     = 'StdOut'

--

--   * 'format'     = 'iso8601UTC'

--

--   * 'delimiter'  = \", \"

--

--   * 'netstrings' = False

--

--   * 'bufSize'    = 'FL.defaultBufSize'

--

--   * 'name'       = \"\"

--

defSettings :: Settings

defSettings = Settings Debug StdOut iso8601UTC ", " False defaultBufSize "" id

tinylog.cabal

+4 −1
Original line number Diff line number Diff line 
name:                 tinylog

version:              0.9

version:              0.10

synopsis:             Simplistic logging using fast-logger.

author:               Toralf Wittner

maintainer:           Toralf Wittner <tw@dtex.org>
@@ -31,6 +31,9 @@ library 
        System.Logger.Class

        System.Logger.Message



    other-modules:

        System.Logger.Settings



    build-depends:

          base              == 4.*

        , bytestring        >= 0.10.4 && < 0.11