diff --git a/src/System/Logger.hs b/src/System/Logger.hs index ef31a9604bb908be578c824e2c0dc584eb781499..91df5afe6f1cd1e7ef5947212ab5b2458c426f40 100644 --- a/src/System/Logger.hs +++ b/src/System/Logger.hs @@ -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 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" diff --git a/src/System/Logger/Class.hs b/src/System/Logger/Class.hs index 8df116be50bf480d6917864b57a3241419ac5592..1b4943f9e30311d0014776b3e1cab22d18ca523d 100644 --- a/src/System/Logger/Class.hs +++ b/src/System/Logger/Class.hs @@ -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 diff --git a/src/System/Logger/Settings.hs b/src/System/Logger/Settings.hs new file mode 100644 index 0000000000000000000000000000000000000000..f9890d13c4a69c8cb664376370a6445ec3f4040f --- /dev/null +++ b/src/System/Logger/Settings.hs @@ -0,0 +1,93 @@ +-- 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 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 + diff --git a/tinylog.cabal b/tinylog.cabal index 995fe66f3d959dcc1c3932a1af8a95530c6d56eb..1d2887490f65763398984d3b2ae94fb0f1491462 100644 --- a/tinylog.cabal +++ b/tinylog.cabal @@ -1,5 +1,5 @@ name: tinylog -version: 0.9 +version: 0.10 synopsis: Simplistic logging using fast-logger. author: Toralf Wittner maintainer: Toralf Wittner @@ -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