module System.Wlog.Wrapper
( Severity (..)
, initTerminalLogging
, releaseAllHandlers
, setSeverity
, setSeverityMaybe
) where
import Universum
import Control.Concurrent.MVar (withMVar)
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 :: MVar () -> Handle -> Severity -> IO (GenericHandler Handle)
streamHandlerWithLock lock h sev = do
GenericHandler {..} <- streamHandler h sev
pure
GenericHandler
{writeFunc = \a s -> withMVar lock $ const $ writeFunc a s, ..}
initTerminalLogging :: MonadIO m
=> (UTCTime -> Text)
-> Bool
-> Bool
-> Maybe Severity
-> m ()
initTerminalLogging
timeF
isShowTime
isShowTid
(fromMaybe Warning -> defaultSeverity)
= liftIO $ do
lock <- liftIO $ newMVar ()
stdoutHandler <- setStdoutFormatter <$>
streamHandlerWithLock lock stdout defaultSeverity
stderrHandler <- setStderrFormatter <$>
streamHandlerWithLock 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 (LoggerName name) =
liftIO . updateGlobalLogger name . setLevel
setSeverityMaybe
:: MonadIO m
=> LoggerName -> Maybe Severity -> m ()
setSeverityMaybe (LoggerName name) Nothing =
liftIO $ updateGlobalLogger name clearLevel
setSeverityMaybe n (Just x) = setSeverity n x
releaseAllHandlers :: MonadIO m => m ()
releaseAllHandlers = liftIO removeAllHandlers