{-# LANGUAGE LambdaCase #-}

{-|
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 live in 'IO'.
* By default this logger is connected to stderr, use 'setDefaultLogger' 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', 'warning' to boost
performance, but a 'fatal' and 'critical' 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 'withDefaultLogger' like:

@
import Z.IO.Logger

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

module Z.IO.Logger
  ( -- * A simple Logger type
    Logger
  , LoggerConfig(..)
  , defaultLoggerConfig
  , defaultJSONLoggerConfig
  , setDefaultLogger
  , getDefaultLogger
  , flushDefaultLogger
  , withDefaultLogger

    -- * Create a new logger
  , newLogger
  , newStdLogger
  , newFileLogger

    -- * logging functions
  , debug
  , info
  , warning
  , fatal
  , critical
  , otherLevel

    -- * logging functions with specific logger
  , debugTo
  , infoTo
  , warningTo
  , fatalTo
  , otherLevelTo

    -- * Helpers to write new log formatter
  , LogFormatter, defaultFmt, defaultColoredFmt, defaultJSONFmt
  , defaultFmtCallStack
  , defaultLevelFmt

    -- * Constants
    -- ** Level
  , Level
  , pattern DEBUG
  , pattern INFO
  , pattern WARNING
  , pattern FATAL
  , pattern CRITICAL
  , pattern NOTSET
  ) where

import           Control.Concurrent.MVar
import           Control.Monad
import           Data.Bits               ((.|.))
import           Data.IORef
import           Foreign.C.Types         (CInt (..))
import           GHC.Conc.Sync           (ThreadId (..), myThreadId)
import           GHC.Exts                (ThreadId#)
import           GHC.Stack
import           System.IO.Unsafe        (unsafePerformIO)
import qualified Z.Data.Builder          as B
import qualified Z.Data.CBytes           as CB
import qualified Z.Data.JSON.Builder     as JB
import           Z.Data.Vector.Base      as V
import           Z.IO.Buffered
import           Z.IO.Exception
import qualified Z.IO.FileSystem         as ZF
import           Z.IO.LowResTimer
import           Z.IO.Resource
import           Z.IO.StdStream
import           Z.IO.StdStream.Ansi     (AnsiColor (..), color)
import           Z.IO.Time

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

type LogFormatter = B.Builder ()            -- ^ data\/time string(second precision)
                  -> Level                  -- ^ log level
                  -> B.Builder ()           -- ^ log content
                  -> CallStack              -- ^ call stack trace
                  -> ThreadId               -- ^ logging thread id
                  -> B.Builder ()

-- | Extensible logger type.
data Logger = Logger
    { Logger -> Builder () -> IO ()
loggerPushBuilder    :: B.Builder () -> IO ()
    -- ^ Push log into buffer
    , Logger -> IO ()
flushLogger          :: IO ()
    -- ^ Flush logger's buffer to output device
    , Logger -> IO ()
flushLoggerThrottled :: IO ()
    -- ^ Throttled flush, e.g. use 'throttleTrailing_' from "Z.IO.LowResTimer"
    , Logger -> IO (Builder ())
loggerTSCache        :: IO (B.Builder ())
    -- ^ An IO action return a formatted date\/time string
    , Logger -> LogFormatter
loggerFmt            :: LogFormatter
    -- ^ Log formatter
    , Logger -> Level
loggerLevel          :: {-# UNPACK #-} !Level
    -- ^ Output logs if level is equal or higher than this value.
    }

-- | Logger config type used in this module.
data LoggerConfig = LoggerConfig
    { LoggerConfig -> Level
loggerMinFlushInterval :: {-# UNPACK #-} !Int
    -- ^ Minimal flush interval, see Notes on 'debug'
    , LoggerConfig -> Level
loggerLineBufSize      :: {-# UNPACK #-} !Int
    -- ^ Buffer size to build each log line
    , LoggerConfig -> Level
loggerConfigLevel      :: {-# UNPACK #-} !Level
    -- ^ Config log's filter level
    , LoggerConfig -> LogFormatter
loggerFormatter        :: LogFormatter
    -- ^ Log formatter
    }

-- | A default logger config with
--
-- * 0.1s minimal flush interval
-- * line buffer size 240 bytes
-- * show everything by default
-- * 'defaultFmt'
defaultLoggerConfig :: LoggerConfig
defaultLoggerConfig :: LoggerConfig
defaultLoggerConfig = Level -> Level -> Level -> LogFormatter -> LoggerConfig
LoggerConfig Level
1 Level
240 Level
NOTSET LogFormatter
defaultFmt

-- | A default logger config with
--
-- * 0.5s minimal flush interval
-- * line buffer size 1000 bytes
-- * show everything by default
-- * 'defaultJSONFmt'
defaultJSONLoggerConfig :: LoggerConfig
defaultJSONLoggerConfig :: LoggerConfig
defaultJSONLoggerConfig = Level -> Level -> Level -> LogFormatter -> LoggerConfig
LoggerConfig Level
5 Level
1000 Level
NOTSET LogFormatter
defaultJSONFmt

-- | A default timestamp cache with format @%Y-%m-%dT%H:%M:%S%Z@('iso8061DateFormat').
--
-- The timestamp will updated in 0.1s granularity to ensure a seconds level precision.
defaultTSCache :: IO (B.Builder ())
{-# NOINLINE defaultTSCache #-}
defaultTSCache :: IO (Builder ())
defaultTSCache = IO (IO (Builder ())) -> IO (Builder ())
forall a. IO a -> a
unsafePerformIO (IO (IO (Builder ())) -> IO (Builder ()))
-> IO (IO (Builder ())) -> IO (Builder ())
forall a b. (a -> b) -> a -> b
$ do
    Level -> IO (Builder ()) -> IO (IO (Builder ()))
forall a. Level -> IO a -> IO (IO a)
throttle Level
1 (IO (Builder ()) -> IO (IO (Builder ())))
-> IO (Builder ()) -> IO (IO (Builder ()))
forall a b. (a -> b) -> a -> b
$ do
        SystemTime
t <- IO SystemTime
HasCallStack => IO SystemTime
getSystemTime'
        CBytes -> Builder ()
CB.toBuilder (CBytes -> Builder ()) -> IO CBytes -> IO (Builder ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CBytes -> SystemTime -> IO CBytes
formatSystemTime CBytes
iso8061DateFormat SystemTime
t

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

-- | Make a new logger with given write device.
newLogger :: LoggerConfig
          -> MVar BufferedOutput
          -> IO Logger
newLogger :: LoggerConfig -> MVar BufferedOutput -> IO Logger
newLogger LoggerConfig{Level
LogFormatter
loggerFormatter :: LogFormatter
loggerConfigLevel :: Level
loggerLineBufSize :: Level
loggerMinFlushInterval :: Level
loggerFormatter :: LoggerConfig -> LogFormatter
loggerConfigLevel :: LoggerConfig -> Level
loggerLineBufSize :: LoggerConfig -> Level
loggerMinFlushInterval :: LoggerConfig -> Level
..} MVar BufferedOutput
oLock = do
    IORef [Bytes]
logsRef <- [Bytes] -> IO (IORef [Bytes])
forall a. a -> IO (IORef a)
newIORef []
    let flush :: IO ()
flush = HasCallStack => MVar BufferedOutput -> IORef [Bytes] -> IO ()
MVar BufferedOutput -> IORef [Bytes] -> IO ()
flushLogIORef MVar BufferedOutput
oLock IORef [Bytes]
logsRef
    IO ()
throttledFlush <- Level -> IO () -> IO (IO ())
throttleTrailing_ Level
loggerMinFlushInterval IO ()
flush
    Logger -> IO Logger
forall (m :: * -> *) a. Monad m => a -> m a
return (Logger -> IO Logger) -> Logger -> IO Logger
forall a b. (a -> b) -> a -> b
$ (Builder () -> IO ())
-> IO ()
-> IO ()
-> IO (Builder ())
-> LogFormatter
-> Level
-> Logger
Logger (IORef [Bytes] -> Level -> Builder () -> IO ()
pushLogIORef IORef [Bytes]
logsRef Level
loggerLineBufSize)
                    IO ()
flush IO ()
throttledFlush IO (Builder ())
defaultTSCache LogFormatter
loggerFormatter
                    Level
loggerConfigLevel

-- | Make a new logger write to 'stderrBuf'.
newStdLogger :: LoggerConfig -> IO Logger
newStdLogger :: LoggerConfig -> IO Logger
newStdLogger LoggerConfig
config = LoggerConfig -> MVar BufferedOutput -> IO Logger
newLogger LoggerConfig
config MVar BufferedOutput
stderrBuf

-- | Make a new file based logger with 'defaultFmt'.
--
-- The file will be opened in append mode.
newFileLogger :: LoggerConfig -> CB.CBytes -> IO Logger
newFileLogger :: LoggerConfig -> CBytes -> IO Logger
newFileLogger LoggerConfig
config CBytes
path = do
    let res :: Resource File
res = HasCallStack => CBytes -> FileFlag -> FileFlag -> Resource File
CBytes -> FileFlag -> FileFlag -> Resource File
ZF.initFile CBytes
path (FileFlag
ZF.O_CREAT FileFlag -> FileFlag -> FileFlag
forall a. Bits a => a -> a -> a
.|. FileFlag
ZF.O_RDWR FileFlag -> FileFlag -> FileFlag
forall a. Bits a => a -> a -> a
.|. FileFlag
ZF.O_APPEND) FileFlag
ZF.DEFAULT_FILE_MODE
    (File
file, IO ()
_closeFunc) <- Resource File -> IO (File, IO ())
forall a. Resource a -> IO (a, IO ())
acquire Resource File
res
    MVar BufferedOutput
oLock <- BufferedOutput -> IO (MVar BufferedOutput)
forall a. a -> IO (MVar a)
newMVar (BufferedOutput -> IO (MVar BufferedOutput))
-> IO BufferedOutput -> IO (MVar BufferedOutput)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< File -> IO BufferedOutput
forall o. Output o => o -> IO BufferedOutput
newBufferedOutput File
file
    LoggerConfig -> MVar BufferedOutput -> IO Logger
newLogger LoggerConfig
config MVar BufferedOutput
oLock

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

-- | Use 'pushLogIORef' and 'pushLogIORef' to implement a simple 'IORef' based concurrent logger.
--
-- @
-- logsRef <- newIORef []
-- let push = pushLogIORef logsRef lineBufSize
--     flush = flushLogIORef stderrBuf logsRef
--     throttledFlush <- throttleTrailing_ flushInterval flush
-- ..
-- return $ Logger push flush throttledFlush ...
-- @
--
pushLogIORef :: IORef [V.Bytes]     -- ^ logs stored in a list, new log will be CASed into it.
             -> Int                 -- ^ buffer size to build each log
             -> B.Builder ()        -- ^ formatted log
             -> IO ()
pushLogIORef :: IORef [Bytes] -> Level -> Builder () -> IO ()
pushLogIORef IORef [Bytes]
logsRef Level
loggerLineBufSize Builder ()
b = do
    let !bs :: Bytes
bs = Level -> Builder () -> Bytes
forall a. Level -> Builder a -> Bytes
B.buildWith Level
loggerLineBufSize Builder ()
b
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bytes -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Bytes
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef [Bytes] -> ([Bytes] -> ([Bytes], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [Bytes]
logsRef (\ [Bytes]
bss -> (Bytes
bsBytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
bss, ()))

flushLogIORef :: HasCallStack => MVar BufferedOutput -> IORef [V.Bytes] -> IO ()
flushLogIORef :: MVar BufferedOutput -> IORef [Bytes] -> IO ()
flushLogIORef MVar BufferedOutput
oLock IORef [Bytes]
logsRef =
    MVar BufferedOutput -> (BufferedOutput -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar BufferedOutput
oLock ((BufferedOutput -> IO ()) -> IO ())
-> (BufferedOutput -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BufferedOutput
o -> do
        [Bytes]
bss <- IORef [Bytes] -> ([Bytes] -> ([Bytes], [Bytes])) -> IO [Bytes]
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [Bytes]
logsRef (\ [Bytes]
bss -> ([], [Bytes]
bss))
        [Bytes] -> (Bytes -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse [Bytes]
bss) (HasCallStack => BufferedOutput -> Bytes -> IO ()
BufferedOutput -> Bytes -> IO ()
writeBuffer BufferedOutput
o)
        HasCallStack => BufferedOutput -> IO ()
BufferedOutput -> IO ()
flushBuffer BufferedOutput
o

-- | A default log formatter
--
-- @[FATAL][2021-02-01T15:03:30+0800][<interactive>:31:1][thread#669]...@
defaultFmt :: LogFormatter
defaultFmt :: LogFormatter
defaultFmt Builder ()
ts Level
level Builder ()
content CallStack
cstack (ThreadId ThreadId#
tid#) = do
    Builder () -> Builder ()
B.square (Level -> Builder ()
defaultLevelFmt Level
level)
    Builder () -> Builder ()
B.square Builder ()
ts
    Builder () -> Builder ()
B.square (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ CallStack -> Builder ()
defaultFmtCallStack CallStack
cstack
    Builder () -> Builder ()
B.square (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Builder ()
"thread#" Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FileFlag -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int (ThreadId# -> FileFlag
getThreadId ThreadId#
tid#)
    Builder ()
content
    Char -> Builder ()
B.char8 Char
'\n'

-- | A default colored log formatter
--
-- DEBUG level is 'Cyan', WARNING level is 'Yellow', FATAL and CRITICAL level are 'Red'.
defaultColoredFmt :: LogFormatter
defaultColoredFmt :: LogFormatter
defaultColoredFmt Builder ()
ts Level
level Builder ()
content CallStack
cstack (ThreadId ThreadId#
tid#) = do
    let blevel :: Builder ()
blevel = Level -> Builder ()
defaultLevelFmt Level
level
    Builder () -> Builder ()
B.square (case Level
level of
        Level
DEBUG    -> AnsiColor -> Builder () -> Builder ()
color AnsiColor
Cyan Builder ()
blevel
        Level
WARNING  -> AnsiColor -> Builder () -> Builder ()
color AnsiColor
Yellow Builder ()
blevel
        Level
FATAL    -> AnsiColor -> Builder () -> Builder ()
color AnsiColor
Red Builder ()
blevel
        Level
CRITICAL -> AnsiColor -> Builder () -> Builder ()
color AnsiColor
Red Builder ()
blevel
        Level
_        -> Builder ()
blevel)
    Builder () -> Builder ()
B.square Builder ()
ts
    Builder () -> Builder ()
B.square (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ CallStack -> Builder ()
defaultFmtCallStack CallStack
cstack
    Builder () -> Builder ()
B.square (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Builder ()
"thread#" Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FileFlag -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int (ThreadId# -> FileFlag
getThreadId ThreadId#
tid#)
    Builder ()
content
    Char -> Builder ()
B.char8 Char
'\n'

-- | A default JSON log formatter.
--
-- > {"level":"FATAL","time":"2021-02-01T15:02:19+0800","loc":"<interactive>:27:1","theadId":606,"content":"..."}\n
defaultJSONFmt :: LogFormatter
defaultJSONFmt :: LogFormatter
defaultJSONFmt Builder ()
ts Level
level Builder ()
content CallStack
cstack (ThreadId ThreadId#
tid#) = do
    Builder () -> Builder ()
B.curly (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
        Text
"level" Text -> Builder () -> Builder ()
`JB.kv` Builder () -> Builder ()
B.quotes (Level -> Builder ()
defaultLevelFmt Level
level)
        Builder ()
B.comma
        Text
"time" Text -> Builder () -> Builder ()
`JB.kv` Builder () -> Builder ()
B.quotes Builder ()
ts
        Builder ()
B.comma
        Text
"loc" Text -> Builder () -> Builder ()
`JB.kv` Builder () -> Builder ()
B.quotes (CallStack -> Builder ()
defaultFmtCallStack CallStack
cstack)
        Builder ()
B.comma
        Text
"thead" Text -> Builder () -> Builder ()
`JB.kv`  FileFlag -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int (ThreadId# -> FileFlag
getThreadId ThreadId#
tid#)
        Builder ()
B.comma
        Text
"content" Text -> Builder () -> Builder ()
`JB.kv` Text -> Builder ()
JB.string (Builder () -> Text
forall a. Builder a -> Text
B.unsafeBuildText Builder ()
content)
    Char -> Builder ()
B.char8 Char
'\n'

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

globalLogger :: IORef Logger
{-# NOINLINE globalLogger #-}
globalLogger :: IORef Logger
globalLogger = IO (IORef Logger) -> IORef Logger
forall a. IO a -> a
unsafePerformIO (IO (IORef Logger) -> IORef Logger)
-> IO (IORef Logger) -> IORef Logger
forall a b. (a -> b) -> a -> b
$
    Logger -> IO (IORef Logger)
forall a. a -> IO (IORef a)
newIORef (Logger -> IO (IORef Logger)) -> IO Logger -> IO (IORef Logger)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LoggerConfig -> IO Logger
newStdLogger LoggerConfig
defaultLoggerConfig{
        loggerFormatter :: LogFormatter
loggerFormatter = (if StdStream -> Bool
isStdStreamTTY StdStream
stderr then LogFormatter
defaultColoredFmt else LogFormatter
defaultFmt)
    }

-- | Change the global logger.
setDefaultLogger :: Logger -> IO ()
setDefaultLogger :: Logger -> IO ()
setDefaultLogger !Logger
logger = IORef Logger -> Logger -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef Logger
globalLogger Logger
logger

-- | Get the global logger.
--
-- This is a logger connected to stderr, if stderr is connect to TTY,
-- then use 'defaultColoredFmt', otherwise use 'defaultFmt'.
getDefaultLogger :: IO Logger
getDefaultLogger :: IO Logger
getDefaultLogger = IORef Logger -> IO Logger
forall a. IORef a -> IO a
readIORef IORef Logger
globalLogger

-- | Manually flush global logger.
flushDefaultLogger :: IO ()
flushDefaultLogger :: IO ()
flushDefaultLogger = IO Logger
getDefaultLogger IO Logger -> (Logger -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Logger -> IO ()
flushLogger

-- | Flush global logger when program exits.
withDefaultLogger :: IO () -> IO ()
withDefaultLogger :: IO () -> IO ()
withDefaultLogger = (IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` IO ()
flushDefaultLogger)

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

-- | Logging Levels
--
-- We following the Python logging levels, for details,
-- see: <https://docs.python.org/3/howto/logging.html#logging-levels>
--
-- +----------+---------------+
-- | Level    | Numeric value |
-- +----------+---------------+
-- | CRITICAL | 50            |
-- +----------+---------------+
-- | FATAL    | 40            |
-- +----------+---------------+
-- | WARNING  | 30            |
-- +----------+---------------+
-- | INFO     | 20            |
-- +----------+---------------+
-- | DEBUG    | 10            |
-- +----------+---------------+
-- | NOTSET   | 0             |
-- +----------+---------------+
--
type Level = Int

pattern CRITICAL :: Level
pattern $bCRITICAL :: Level
$mCRITICAL :: forall r. Level -> (Void# -> r) -> (Void# -> r) -> r
CRITICAL = 50

pattern FATAL :: Level
pattern $bFATAL :: Level
$mFATAL :: forall r. Level -> (Void# -> r) -> (Void# -> r) -> r
FATAL = 40

pattern WARNING :: Level
pattern $bWARNING :: Level
$mWARNING :: forall r. Level -> (Void# -> r) -> (Void# -> r) -> r
WARNING = 30

pattern INFO :: Level
pattern $bINFO :: Level
$mINFO :: forall r. Level -> (Void# -> r) -> (Void# -> r) -> r
INFO = 20

pattern DEBUG :: Level
pattern $bDEBUG :: Level
$mDEBUG :: forall r. Level -> (Void# -> r) -> (Void# -> r) -> r
DEBUG = 10

pattern NOTSET :: Level
pattern $bNOTSET :: Level
$mNOTSET :: forall r. Level -> (Void# -> r) -> (Void# -> r) -> r
NOTSET = 0

-- | Format 'DEBUG' to 'DEBUG', etc.
--
-- Level other than built-in ones, are formatted in decimal numeric format, i.e.
-- @defaultLevelFmt 60 == "LEVEL60"@
defaultLevelFmt :: Level -> B.Builder ()
defaultLevelFmt :: Level -> Builder ()
defaultLevelFmt Level
level = case Level
level of
    Level
CRITICAL -> Builder ()
"CRITICAL"
    Level
FATAL    -> Builder ()
"FATAL"
    Level
WARNING  -> Builder ()
"WARNING"
    Level
INFO     -> Builder ()
"INFO"
    Level
DEBUG    -> Builder ()
"DEBUG"
    Level
NOTSET   -> Builder ()
"NOTSET"
    Level
level'   -> Builder ()
"LEVEL" Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Level -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
B.int Level
level'

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

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

warning :: HasCallStack => B.Builder () -> IO ()
warning :: Builder () -> IO ()
warning = Level -> Bool -> CallStack -> Builder () -> IO ()
otherLevel_ Level
WARNING Bool
False CallStack
HasCallStack => CallStack
callStack

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

critical :: HasCallStack => B.Builder () -> IO ()
critical :: Builder () -> IO ()
critical = Level -> Bool -> CallStack -> Builder () -> IO ()
otherLevel_ Level
CRITICAL Bool
True CallStack
HasCallStack => CallStack
callStack

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

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

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

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

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

warningTo :: HasCallStack => Logger -> B.Builder () -> IO ()
warningTo :: Logger -> Builder () -> IO ()
warningTo = Level -> Bool -> CallStack -> Logger -> Builder () -> IO ()
otherLevelTo_ Level
WARNING Bool
False CallStack
HasCallStack => CallStack
callStack

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

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

otherLevelTo_ :: Level -> Bool -> CallStack -> Logger -> B.Builder () -> IO ()
otherLevelTo_ :: Level -> Bool -> CallStack -> Logger -> Builder () -> IO ()
otherLevelTo_ Level
level Bool
flushNow CallStack
cstack Logger
logger Builder ()
bu = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Level
level Level -> Level -> Bool
forall a. Ord a => a -> a -> Bool
>= Logger -> Level
loggerLevel Logger
logger) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Builder ()
ts <- Logger -> IO (Builder ())
loggerTSCache Logger
logger
    ThreadId
tid <- IO ThreadId
myThreadId
    (Logger -> Builder () -> IO ()
loggerPushBuilder Logger
logger) (Builder () -> IO ()) -> Builder () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Logger -> LogFormatter
loggerFmt Logger
logger) Builder ()
ts Level
level Builder ()
bu CallStack
cstack ThreadId
tid
    if Bool
flushNow
    then Logger -> IO ()
flushLogger Logger
logger
    else Logger -> IO ()
flushLoggerThrottled Logger
logger

foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt