diff --git a/src/System/Logger.hs b/src/System/Logger.hs index 2cb07e0bfe6b34c76c99ede22ae99d600781d40d..01ef70b5ce46d9d524eac10eab7d6edc19c4d9bc 100644 --- a/src/System/Logger.hs +++ b/src/System/Logger.hs @@ -4,6 +4,8 @@ {-# LANGUAGE OverloadedStrings #-} +-- | Small layer on top of @fast-logger@ which adds log-levels and +-- timestamp support and not much more. module System.Logger ( Level (..) , Output (..) @@ -26,14 +28,6 @@ module System.Logger , err , fatal - , logM - , traceM - , debugM - , infoM - , warnM - , errM - , fatalM - , iso8601UTC , module M ) @@ -72,11 +66,11 @@ data Logger = Logger } data Settings = Settings - { logLevel :: Level - , output :: Output - , format :: DateFormat - , delimiter :: ByteString - , bufSize :: BufSize + { 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 + , bufSize :: BufSize -- ^ how many bytes to buffer before commiting to sink } deriving (Eq, Ord, Show) data Output @@ -95,9 +89,25 @@ instance IsString DateFormat where iso8601UTC :: DateFormat iso8601UTC = "%Y-%0m-%0dT%0H:%0M:%0SZ" +-- | Default settings for use with 'new': +-- +-- * 'logLevel' = 'Debug' +-- +-- * 'output' = 'StdOut' +-- +-- * 'format' = 'iso8601UTC' +-- +-- * 'delimiter' = \", \" +-- +-- * 'bufSize' = 'FL.defaultBufSize' +-- defSettings :: Settings defSettings = Settings Debug StdOut iso8601UTC ", " 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 +-- size can be dynamically set via @LOG_BUFFER@. new :: MonadIO m => Settings -> m Logger new s = liftIO $ do n <- fmap (readNote "Invalid LOG_BUFFER") <$> lookupEnv "LOG_BUFFER" @@ -117,6 +127,7 @@ new s = liftIO $ do fmt :: DateFormat -> UnixTime -> IO ByteString fmt d = return . formatUnixTimeGMT (template d) +-- | Invokes 'new' with default settings and the given output as log sink. create :: MonadIO m => Output -> m Logger create p = new defSettings { output = p } @@ -125,14 +136,13 @@ readNote m s = case reads s of [(a, "")] -> a _ -> error m +-- | Logs a message with the given level if greater of equal to the +-- logger's threshold. log :: MonadIO m => Logger -> Level -> (Msg -> Msg) -> m () log g l m = unless (level g > l) . liftIO $ putMsg g l m {-# INLINE log #-} -logM :: MonadIO m => Logger -> Level -> m (Msg -> Msg) -> m () -logM g l m = unless (level g > l) $ m >>= putMsg g l -{-# INLINE logM #-} - +-- | Abbreviation for 'log' using the corresponding log level. trace, debug, info, warn, err, fatal :: MonadIO m => Logger -> (Msg -> Msg) -> m () trace g = log g Trace debug g = log g Debug @@ -147,28 +157,17 @@ fatal g = log g Fatal {-# INLINE err #-} {-# INLINE fatal #-} -traceM, debugM, infoM, warnM, errM, fatalM :: MonadIO m => Logger -> m (Msg -> Msg) -> m () -traceM g = logM g Trace -debugM g = logM g Debug -infoM g = logM g Info -warnM g = logM g Warn -errM g = logM g Error -fatalM g = logM g Fatal -{-# INLINE traceM #-} -{-# INLINE debugM #-} -{-# INLINE infoM #-} -{-# INLINE warnM #-} -{-# INLINE errM #-} -{-# INLINE fatalM #-} - +-- | Force buffered bytes to output sink. flush :: MonadIO m => Logger -> m () 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) +-- | Inspect this logger's threshold. level :: Logger -> Level level = logLevel . _settings {-# INLINE level #-} diff --git a/src/System/Logger/Class.hs b/src/System/Logger/Class.hs new file mode 100644 index 0000000000000000000000000000000000000000..f0536bc0a2fb07b487375999f36c047d5fbc860f --- /dev/null +++ b/src/System/Logger/Class.hs @@ -0,0 +1,52 @@ +-- 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 FlexibleContexts #-} + +module System.Logger.Class + ( MonadLogger (..) + , trace + , debug + , info + , warn + , err + , fatal + + , L.Level (..) + , L.Output (..) + , L.Settings (..) + , L.Logger + , L.DateFormat + + , L.new + , L.create + , L.defSettings + , L.iso8601UTC + + , module M + ) +where + +import Prelude hiding (log) +import Control.Monad.Reader +import System.Logger (Logger, Level (..)) +import System.Logger.Message as M + +import qualified System.Logger as L + +class MonadIO m => MonadLogger m where + log :: Level -> (Msg -> Msg) -> m () + +instance (MonadIO m, MonadReader Logger m) => MonadLogger (ReaderT r m) where + log l m = lift ask >>= \g -> L.log g l m + +-- | Abbreviation for 'log' using the corresponding log level. +trace, debug, info, warn, err, fatal :: MonadLogger m => (Msg -> Msg) -> m () +trace = log Trace +debug = log Debug +info = log Info +warn = log Warn +err = log Error +fatal = log Fatal + diff --git a/src/System/Logger/Message.hs b/src/System/Logger/Message.hs index 6d9a43c312305f32dbb8a0336cd373d9e2535fa8..72c0e3fe972058e1f6b223be42e29002a1807c4d 100644 --- a/src/System/Logger/Message.hs +++ b/src/System/Logger/Message.hs @@ -29,9 +29,9 @@ import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.Encoding as T import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Builder as B -import qualified Data.ByteString.Lazy.Builder.ASCII as B import qualified Data.ByteString.Lazy.Builder.Extras as B +-- | Convert some value to a 'Builder'. class ToBytes a where bytes :: a -> Builder @@ -59,11 +59,14 @@ instance ToBytes Bool where bytes True = val "True" bytes False = val "False" +-- | Type representing log messages. newtype Msg = Msg { builders :: [Builder] } +-- | Log some value. msg :: ToBytes a => a -> Msg -> Msg msg p (Msg m) = Msg (bytes p : m) +-- | Log some field, i.e. a key-value pair delimited by \"=\". field, (=:) :: ToBytes a => ByteString -> a -> Msg -> Msg field k v (Msg m) = Msg $ bytes k <> B.byteString "=" <> bytes v : m @@ -71,12 +74,18 @@ infixr 5 =: (=:) = field infixr 5 +++ + +-- | Concatenate two 'ToBytes' values. (+++) :: (ToBytes a, ToBytes b) => a -> b -> Builder a +++ b = bytes a <> bytes b +-- | Type restriction. Useful to disambiguate string literals when +-- using @OverloadedStrings@ pragma. val :: ByteString -> Builder val = bytes +-- | Intersperse parts of the log message with the given delimiter and +-- render the whole builder into a 'L.ByteString'. render :: ByteString -> (Msg -> Msg) -> L.ByteString render s f = finish . mconcat diff --git a/src/System/LoggerT.hs b/src/System/LoggerT.hs deleted file mode 100644 index 9002eb88f7b8270451b1c2227f162704d856a029..0000000000000000000000000000000000000000 --- a/src/System/LoggerT.hs +++ /dev/null @@ -1,96 +0,0 @@ --- 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 FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module System.LoggerT - ( LoggerT - , MonadLogger (..) - , runLoggerT - - , L.Level (..) - , L.Output (..) - , L.Settings (..) - , L.Logger - , L.DateFormat - - , L.new - , L.create - , L.defSettings - , L.iso8601UTC - - , module M - ) -where - -import Prelude hiding (log) -import Control.Applicative -import Control.Monad.Catch -import Control.Monad.Reader -import System.Logger (Logger, Level (..)) -import System.Logger.Message as M - -import qualified System.Logger as L - -newtype LoggerT m a = LoggerT - { unwrap :: ReaderT Logger m a - } deriving ( Functor - , Applicative - , Monad - , MonadIO - , MonadThrow - , MonadCatch - , MonadReader Logger - , MonadTrans - ) - -class MonadIO m => MonadLogger m where - logger :: m Logger - - prefix :: m (Msg -> Msg) - prefix = return id - - log :: Level -> (Msg -> Msg) -> m () - log l m = do - g <- logger - p <- prefix - L.log g l (p . m) - - logM :: Level -> m (Msg -> Msg) -> m () - logM l m = do - g <- logger - p <- prefix - L.logM g l ((p .) `liftM` m) - - trace, debug, info, warn, err, fatal :: (Msg -> Msg) -> m () - trace = log Trace - debug = log Debug - info = log Info - warn = log Warn - err = log Error - fatal = log Fatal - - traceM, debugM, infoM, warnM, errM, fatalM :: m (Msg -> Msg) -> m () - traceM = logM Trace - debugM = logM Debug - infoM = logM Info - warnM = logM Warn - errM = logM Error - fatalM = logM Fatal - - flush :: m () - flush = logger >>= L.flush - - close :: m () - close = logger >>= L.close - -instance MonadIO m => MonadLogger (LoggerT m) where - logger = LoggerT ask - -instance (MonadIO m, MonadReader Logger m) => MonadLogger (ReaderT r m) where - logger = lift ask - -runLoggerT :: MonadIO m => L.Logger -> LoggerT m a -> m a -runLoggerT l m = runReaderT (unwrap m) l diff --git a/tinylog.cabal b/tinylog.cabal index 6de1f305f99da05c467fc8f324e31f9421b3309b..5a3c24d006138decf9b1f9f848a86cc1df5b5c40 100644 --- a/tinylog.cabal +++ b/tinylog.cabal @@ -1,5 +1,5 @@ name: tinylog -version: 0.7.2 +version: 0.8 synopsis: Simplistic logging using fast-logger. author: Toralf Wittner maintainer: Toralf Wittner @@ -25,14 +25,13 @@ library exposed-modules: System.Logger + , System.Logger.Class , System.Logger.Message - , System.LoggerT build-depends: base == 4.* , bytestring >= 0.10 , date-cache >= 0.3 - , exceptions >= 0.4 , fast-logger >= 2.1.4 && < 2.2 , mtl >= 2.1 , text >= 0.11 && < 1.2