Logger.hs

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}

{-|
Module      : Z.IO.Logger
Description : High performance logger
Copyright   : (c) Dong Han, 2017-2018
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

Simple, high performance logger. The design choice of this logger is biased towards simplicity instead of generlization:

    * All log functions lives in 'IO'.
    * By default this logger is connected to stderr, use 'setStdLogger' to customize.
    * When logging each thread will build log 'Builder's into a small 'V.Bytes' with line buffer
      instead of leaving all 'Builder's to the flushing thread:
        * Logger won't keep heap data for too long simply because they're referenced by log's 'Builder'.
        * Each logging thread only need perform a CAS to prepend log 'V.Bytes' into a list,
          which reduces contention.
        * Each log call is atomic, Logging order is preserved under concurrent settings.

Flushing is automatic and throttled for 'debug', 'info', 'warn' to boost performance, but a 'fatal' log will always flush logger's buffer.  This could lead to a problem that if main thread exits too early logs may missed, to add a flushing when program exits, use 'withStdLogger' like:

@
import Z.IO.Logger

main :: IO ()
main = withStdLogger $ do
    ....
    debug "..."   -- So that this log won't be missed
    ...
@
-}

module Z.IO.Logger
  ( -- * A simple Logger type
    Logger
  , LoggerConfig(..)
  , newLogger
  , loggerFlush
  , setStdLogger
  , getStdLogger
  , withStdLogger
    -- * logging functions
  , debug
  , info
  , warn
  , fatal
  , otherLevel
    -- * logging functions with specific logger
  , debugWith
  , infoWith
  , warnWith
  , fatalWith
  , otherLevelWith
  ) where

import Control.Monad
import Z.Data.Vector.Base as V
import Z.IO.LowResTimer
import Z.IO.StdStream
import Z.IO.Buffered
import System.IO.Unsafe (unsafePerformIO)
import Z.IO.Exception
import Data.IORef
import Control.Concurrent.MVar
import qualified Z.Data.Builder.Base as B
import qualified Data.Time as Time

data Logger = Logger
    { loggerFlush           :: IO ()                -- ^ flush logger's buffer to output device
    , loggerThrottledFlush  :: IO ()
    , loggerBytesList       :: {-# UNPACK #-} !(IORef [V.Bytes])
    , loggerConfig          :: {-# UNPACK #-} !LoggerConfig
    }

data LoggerConfig = LoggerConfig
    { loggerMinFlushInterval :: {-# UNPACK #-} !Int -- ^ Minimal flush interval, see Notes on 'debug'
    , loggerTsCache          :: IO (B.Builder ())   -- ^ A IO action return a formatted date/time string
    , loggerLineBufSize      :: {-# UNPACK #-} !Int -- ^ Buffer size to build each log/line
    , loggerShowDebug        :: Bool                -- ^ Set to 'False' to filter debug logs
    , loggerShowTS           :: Bool                -- ^ Set to 'False' to disable auto data/time string prepending
    }

-- | A default logger config with
--
--   * debug ON
--   * 0.1s minimal flush interval
--   * defaultTSCache
--   * line buffer size 128 bytes
--   * show debug True
--   * show timestamp True
--   * 'BufferedOutput' buffer size equals to 'V.defaultChunkSize'.
defaultLoggerConfig :: LoggerConfig
defaultLoggerConfig = LoggerConfig 1 defaultTSCache 128 True True

-- | A default timestamp cache with format @%Y-%m-%dT%H:%M:%S%Z@
defaultTSCache :: IO (B.Builder ())
{-# NOINLINE defaultTSCache #-}
defaultTSCache = unsafePerformIO $ do
    throttle 1 $ do
        t <- Time.getCurrentTime
        return . B.string8 $
            Time.formatTime Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Z" t

flushLog :: (HasCallStack, Output o) => MVar (BufferedOutput o) -> IORef [V.Bytes] -> IO ()
flushLog oLock bList =
    withMVar oLock $ \ o -> do
        bss <- atomicModifyIORef' bList (\ bss -> ([], bss))
        forM_ (reverse bss) (writeBuffer o)
        flushBuffer o

-- | Make a new logger
newLogger :: Output o
          => LoggerConfig
          -> MVar (BufferedOutput o)
          -> IO Logger
newLogger config oLock = do
    bList <- newIORef []
    let flush = flushLog oLock bList
    throttledFlush <- throttleTrailing_ (loggerMinFlushInterval config) flush
    return $ Logger flush throttledFlush bList config

globalLogger :: IORef Logger
{-# NOINLINE globalLogger #-}
globalLogger = unsafePerformIO $
    newIORef =<< newLogger defaultLoggerConfig stderrBuf

-- | Change the global logger.
setStdLogger :: Logger -> IO ()
setStdLogger !logger = atomicWriteIORef globalLogger logger

-- | Get the global logger.
getStdLogger :: IO Logger
getStdLogger = readIORef globalLogger

-- | Manually flush stderr logger.
flushDefaultLogger :: IO ()
flushDefaultLogger = getStdLogger >>= loggerFlush

pushLog :: IORef [V.Bytes] -> Int -> B.Builder () -> IO ()
pushLog blist bfsiz b = do
    let !bs = B.buildBytesWith bfsiz b
    atomicModifyIORef' blist (\ bss -> (bs:bss, ()))

-- | Flush stderr logger when program exits.
withStdLogger :: IO () -> IO ()
withStdLogger = (`finally` flushDefaultLogger)

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

debug :: B.Builder () -> IO ()
debug = otherLevel "DEBUG" False

info :: B.Builder () -> IO ()
info = otherLevel "INFO" False

warn :: B.Builder () -> IO ()
warn = otherLevel "WARN" False

fatal :: B.Builder () -> IO ()
fatal = otherLevel "FATAL" True

otherLevel :: B.Builder ()      -- ^ log level
           -> Bool              -- ^ flush immediately?
           -> B.Builder ()      -- ^ log content
           -> IO ()
otherLevel level flushNow b =
    getStdLogger >>= \ logger -> otherLevelWith logger level flushNow b

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

debugWith :: Logger -> B.Builder () -> IO ()
debugWith logger = otherLevelWith logger "DEBUG" False

infoWith :: Logger -> B.Builder () -> IO ()
infoWith logger = otherLevelWith logger "INFO" False

warnWith :: Logger -> B.Builder () -> IO ()
warnWith logger = otherLevelWith logger "WARN" False

fatalWith :: Logger -> B.Builder () -> IO ()
fatalWith logger = otherLevelWith logger "FATAL" True

otherLevelWith :: Logger
               -> B.Builder ()      -- ^ log level
               -> Bool              -- ^ flush immediately?
               -> B.Builder ()      -- ^ log content
               -> IO ()
otherLevelWith logger level flushNow b = case logger of
    (Logger flush throttledFlush blist (LoggerConfig _ tscache lbsiz showdebug showts)) -> do
        ts <- if showts then tscache else return ""
        when showdebug $ do
            pushLog blist lbsiz $ do
                B.char8 '['
                level
                B.char8 ']'
                B.char8 ' '
                when showts $ ts >> B.char8 ' '
                b
                B.char8 '\n'
            if flushNow then flush else throttledFlush