htsn-0.0.1: src/Logging.hs

module Logging (
  init_logging,
  log_debug,
  log_error,
  log_info,
  log_warning )
where

import Control.Monad ( when )
import System.Log.Formatter ( simpleLogFormatter )
import System.Log.Handler ( setFormatter )
import System.Log.Handler.Simple ( GenericHandler, fileHandler )
import System.Log.Handler.Syslog (
  Facility ( USER ),
  openlog )
import System.Log.Logger (
  Priority ( INFO ),
  addHandler,
  debugM,
  errorM,
  infoM,
  rootLoggerName,
  setHandlers,
  setLevel,
  updateGlobalLogger,
  warningM )


-- | Log a message at the DEBUG level.
log_debug :: String -> IO ()
log_debug = debugM rootLoggerName

-- | Log a message at the ERROR level.
log_error :: String -> IO ()
log_error = errorM rootLoggerName

-- | Log a message at the INFO level.
log_info :: String -> IO ()
log_info = infoM rootLoggerName

-- | Log a message at the WARNING level.
log_warning :: String -> IO ()
log_warning = warningM rootLoggerName


-- | Set up the logging. All logs are handled by the global "root"
--   logger provided by HSLogger. We remove all of its handlers so
--   that it does nothing; then we conditionally add back two handlers
--   -- one for syslog, and one for a normal file -- dependent upon
--   the 'syslog' and 'log_file' configuration items.
--
--   Why don't we take a Configuration as an argument? Because it
--   would create circular imports!
init_logging :: Maybe FilePath -> Priority -> Bool -> IO ()
init_logging log_file log_level syslog = do
  -- First set the global log level and clear the default handler.
  let no_handlers = [] :: [GenericHandler a]
  updateGlobalLogger rootLoggerName (setLevel log_level .
                                              setHandlers no_handlers)

  when syslog $ do
    let min_level = INFO
    let sl_level = if log_level < min_level then min_level else log_level

    -- The syslog handle gets its own level which will cowardly refuse
    -- to log all debug info (i.e. the entire feed) to syslog.
    sl_handler' <- openlog rootLoggerName [] USER sl_level

    -- Syslog should output the date by itself.
    let sl_formatter = simpleLogFormatter "htsn[$pid] $prio: $msg"
    let sl_handler = setFormatter sl_handler' sl_formatter

    updateGlobalLogger rootLoggerName (addHandler sl_handler)

  case log_file of
    Nothing -> return ()
    Just lf -> do
      lf_handler' <- fileHandler lf log_level
      let lf_formatter = simpleLogFormatter "$time: htsn[$pid] $prio: $msg"
      let lf_handler = setFormatter lf_handler' lf_formatter
      updateGlobalLogger rootLoggerName (addHandler lf_handler)