Logging.hs

-- | Provide convenience functions for logging to the HSLogger \"root\"
--   logger.
module Network.Services.TSN.Logging (
  init_logging,
  log_debug,
  log_error,
  log_info,
  log_warning )
where

import Control.Monad ( when )
import System.Environment ( getProgName )
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@ arguments.
--
--   If @syslog@ is 'False' and @log_file@ is 'Nothing'; then nothing
--   will be logged and the @log_level@ will essentially be ignored
--   (even though the root logger will have its level set).
--
init_logging :: Priority       -- ^ The priority at and above which
                               --   to log messages.
             -> Maybe FilePath -- ^ Path to the log file (optional)
             -> Bool           -- ^ Log to syslog?
             -> IO ()
init_logging log_level log_file 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.
    program_name <- getProgName
    let sl_formatter = simpleLogFormatter $
                         program_name ++ "[$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)