module System.Wlog.Wrapper
( Severity (..)
, convertSeverity
, initTerminalLogging
, releaseAllHandlers
, setSeverity
, setSeverityMaybe
) where
import Universum
import Control.Concurrent.MVar (MVar, newMVar, withMVar)
import System.IO (Handle, stderr, stdout)
import System.Log.Handler.Simple (GenericHandler (..), streamHandler)
import System.Log.Logger (Priority (DEBUG, ERROR), clearLevel,
removeAllHandlers, rootLoggerName,
setHandlers, setLevel, updateGlobalLogger)
import System.Wlog.Formatter (setStderrFormatter, setStdoutFormatter)
import System.Wlog.LoggerName (LoggerName (..))
import System.Wlog.Severity (Severity (..), convertSeverity)
streamHandlerWithLock :: MVar () -> Handle -> Priority -> IO (GenericHandler Handle)
streamHandlerWithLock lock h p = do
GenericHandler{..} <- streamHandler h p
return GenericHandler
{ priority = priority
, formatter = formatter
, privData = privData
, writeFunc = \a s -> withMVar lock $ const $ writeFunc a s
, closeFunc = closeFunc
}
initTerminalLogging :: MonadIO m => Bool -> Maybe Severity -> m ()
initTerminalLogging isShowTime (fromMaybe Warning -> defaultSeverity) = liftIO $ do
lock <- liftIO $ newMVar ()
stdoutHandler <- setStdoutFormatter isShowTime <$>
streamHandlerWithLock lock stdout DEBUG
stderrHandler <- setStderrFormatter <$>
streamHandlerWithLock lock stderr ERROR
updateGlobalLogger rootLoggerName $
setHandlers [stderrHandler, stdoutHandler]
updateGlobalLogger rootLoggerName $
setLevel (convertSeverity defaultSeverity)
setSeverity :: MonadIO m => LoggerName -> Severity -> m ()
setSeverity (LoggerName name) =
liftIO . updateGlobalLogger name . setLevel . convertSeverity
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