module System.Wlog.Wrapper
( Severity (..)
, initTerminalLogging
, releaseAllHandlers
, setSeverity
, setSeverityMaybe
) where
import Universum
import Data.Time (UTCTime)
import System.IO (Handle, stderr, stdout)
import System.Wlog.Formatter (stderrFormatter, stdoutFormatter)
import System.Wlog.Handler (LogHandler (setFormatter))
import System.Wlog.Handler.Simple (GenericHandler (..), streamHandler)
import System.Wlog.Logger (clearLevel, removeAllHandlers,
rootLoggerName, setHandlers, setLevel,
updateGlobalLogger)
import System.Wlog.LoggerName (LoggerName (..))
import System.Wlog.Severity (Severity (..))
streamHandlerWithLock :: (Handle -> Text -> IO ())
-> MVar ()
-> Handle
-> Severity
-> IO (GenericHandler Handle)
streamHandlerWithLock customTerminalAction lock handle severity =
streamHandler handle customTerminalAction lock severity
initTerminalLogging :: MonadIO m
=> (UTCTime -> Text)
-> (Handle -> Text -> IO ())
-> Bool
-> Bool
-> Maybe Severity
-> m ()
initTerminalLogging
timeF
customConsoleAction
isShowTime
isShowTid
(fromMaybe Warning -> defaultSeverity)
= liftIO $ do
lock <- liftIO $ newMVar ()
stdoutHandler <- setStdoutFormatter <$>
streamHandlerWithLock customConsoleAction lock stdout defaultSeverity
stderrHandler <- setStderrFormatter <$>
streamHandlerWithLock customConsoleAction lock stderr Error
updateGlobalLogger rootLoggerName $
setHandlers [stderrHandler, stdoutHandler]
updateGlobalLogger rootLoggerName $
setLevel defaultSeverity
where
setStdoutFormatter = (`setFormatter` stdoutFormatter timeF isShowTime isShowTid)
setStderrFormatter = (`setFormatter` stderrFormatter timeF isShowTid)
setSeverity :: MonadIO m => LoggerName -> Severity -> m ()
setSeverity name =
liftIO . updateGlobalLogger name . setLevel
setSeverityMaybe
:: MonadIO m
=> LoggerName -> Maybe Severity -> m ()
setSeverityMaybe name Nothing =
liftIO $ updateGlobalLogger name clearLevel
setSeverityMaybe n (Just x) = setSeverity n x
releaseAllHandlers :: MonadIO m => m ()
releaseAllHandlers = liftIO removeAllHandlers