{-|
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(..)
  , setStdLogger
  , getStdLogger
  , withStdLogger
  , newLogger
    -- * logging functions
  , debug
  , info
  , warn
  , fatal
  , otherLevel
    -- * logging functions with specific logger
  , debugTo
  , infoTo
  , warnTo
  , fatalTo
  , otherLevelTo
    -- * Helper to write new logger
  , defaultTSCache
  , defaultFmtCallStack
  , LogFormatter, defaultFmt
  , flushLog
  ) 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 GHC.Stack
import qualified Z.Data.Builder as B
import qualified Data.Time as Time

type LogFormatter = Maybe (B.Builder ())     -- ^ data/time string
                    -> B.Builder ()          -- ^ log level
                    -> B.Builder ()          -- ^ log content
                    -> CallStack             -- ^ call stack trace
                    -> B.Builder ()

data Logger = Logger
    { loggerPushBuilder     :: B.Builder () -> IO () -- ^ push log into buffer
    , flushLogger           :: IO ()                -- ^ flush logger's buffer to output device
    , flushLoggerThrottled  :: IO ()                -- ^ throttled flush, e.g. use 'throttleTrailing_' from "Z.IO.LowResTimer"
    , loggerTSCache         :: IO (Maybe (B.Builder ())) -- ^ A IO action return a formatted date/time string
    , loggerFmt             :: LogFormatter
    }

data LoggerConfig = LoggerConfig
    { loggerMinFlushInterval :: {-# UNPACK #-} !Int -- ^ Minimal flush interval, see Notes on 'debug'
    , 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
    , loggerShowSourceLoc    :: Bool                -- ^ Set to 'True' to enable source location line
    }

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

-- | A default timestamp cache with format @%Y-%m-%dT%H:%M:%S%Z@
--
-- The timestamp will updated in 0.1s granularity to ensure a seconds level precision.
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

-- | Use this function to implement a simple 'IORef' based concurrent logger.
--
-- @
-- bList <- newIORef []
-- let flush = flushLog buffered bList
-- ..
-- return $ Logger (pushLog bList) flush ...
-- @
--
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 simple 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 (pushLog bList) flush throttledFlush tsCache (defaultFmt (loggerShowSourceLoc config))
  where
    tsCache = if (loggerShowTS config) then Just <$> defaultTSCache else pure Nothing
    pushLog bList b = do
        let !bs = B.buildBytesWith (loggerLineBufSize config) b
        atomicModifyIORef' bList (\ bss -> (bs:bss, ()))

-- | A default log formatter
--
-- @ [DEBUG][2020-10-09T07:44:14UTC][<interactive>:7:1]This a debug message@
defaultFmt :: Bool          -- ^ show call stack info?
           -> LogFormatter
defaultFmt showcstack maybeTS level content cstack = do
    B.square level
    forM_ maybeTS $ \ ts -> B.square ts
    when showcstack (B.square $ defaultFmtCallStack cstack)
    content

-- | Default stack formatter which fetch the logging source and location.
defaultFmtCallStack :: CallStack -> B.Builder ()
defaultFmtCallStack cs =
 case reverse $ getCallStack cs of
   [] -> "<no call stack found>"
   (_, loc):_ -> do
      B.string8 (srcLocFile loc)
      B.char8 ':'
      B.int (srcLocStartLine loc)
      B.char8 ':'
      B.int (srcLocStartCol loc)

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

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

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

debug :: HasCallStack => B.Builder () -> IO ()
debug = otherLevel_ "DEBUG" False callStack

info :: HasCallStack => B.Builder () -> IO ()
info = otherLevel_ "INFO" False callStack

warn :: HasCallStack => B.Builder () -> IO ()
warn = otherLevel_ "WARN" False callStack

fatal :: HasCallStack => B.Builder () -> IO ()
fatal = otherLevel_ "FATAL" True callStack

otherLevel :: HasCallStack
           => B.Builder ()      -- ^ log level
           -> Bool              -- ^ flush immediately?
           -> B.Builder ()      -- ^ log content
           -> IO ()
otherLevel level flushNow bu = otherLevel_ level flushNow callStack bu

otherLevel_ :: B.Builder () -> Bool -> CallStack -> B.Builder () -> IO ()
otherLevel_ level flushNow cstack bu = do
    logger <- getStdLogger
    otherLevelTo_ level flushNow cstack logger bu

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

debugTo :: HasCallStack => Logger -> B.Builder () -> IO ()
debugTo = otherLevelTo_ "DEBUG" False callStack

infoTo :: HasCallStack => Logger -> B.Builder () -> IO ()
infoTo = otherLevelTo_ "INFO" False callStack

warnTo :: HasCallStack => Logger -> B.Builder () -> IO ()
warnTo = otherLevelTo_ "WARN" False callStack

fatalTo :: HasCallStack => Logger -> B.Builder () -> IO ()
fatalTo = otherLevelTo_ "FATAL" True callStack

otherLevelTo :: HasCallStack
             => Logger
             -> B.Builder ()      -- ^ log level
             -> Bool              -- ^ flush immediately?
             -> B.Builder ()      -- ^ log content
             -> IO ()
otherLevelTo logger level flushNow =
    otherLevelTo_ level flushNow callStack logger

otherLevelTo_ :: B.Builder () -> Bool -> CallStack -> Logger -> B.Builder () -> IO ()
otherLevelTo_ level flushNow cstack logger bu = do
    ts <- loggerTSCache logger
    (loggerPushBuilder logger) $ (loggerFmt logger) ts level bu cstack
    if flushNow
    then flushLogger logger
    else flushLoggerThrottled logger