src/Logging.hs

   1 module Logging (
   2   init_logging,
   3   log_debug,
   4   log_error,
   5   log_info,
   6   log_warning )
   7 where
   8
   9 import Control.Monad ( when )
  10 import System.Environment ( getProgName )
  11 import System.Log.Formatter ( simpleLogFormatter )
  12 import System.Log.Handler ( setFormatter )
  13 import System.Log.Handler.Simple ( GenericHandler, fileHandler )
  14 import System.Log.Handler.Syslog (
  15   Facility ( USER ),
  16   openlog )
  17 import System.Log.Logger (
  18   Priority ( INFO ),
  19   addHandler,
  20   debugM,
  21   errorM,
  22   infoM,
  23   rootLoggerName,
  24   setHandlers,
  25   setLevel,
  26   updateGlobalLogger,
  27   warningM )
  28
  29
  30 -- | Log a message at the DEBUG level.
  31 log_debug :: String -> IO ()
  32 log_debug = debugM rootLoggerName
  33
  34 -- | Log a message at the ERROR level.
  35 log_error :: String -> IO ()
  36 log_error = errorM rootLoggerName
  37
  38 -- | Log a message at the INFO level.
  39 log_info :: String -> IO ()
  40 log_info = infoM rootLoggerName
  41
  42 -- | Log a message at the WARNING level.
  43 log_warning :: String -> IO ()
  44 log_warning = warningM rootLoggerName
  45
  46
  47 -- | Set up the logging. All logs are handled by the global "root"
  48 --   logger provided by HSLogger. We remove all of its handlers so
  49 --   that it does nothing; then we conditionally add back two handlers
  50 --   -- one for syslog, and one for a normal file -- dependent upon
  51 --   the 'syslog' and 'log_file' configuration items.
  52 --
  53 --   Why don't we take a Configuration as an argument? Because it
  54 --   would create circular imports!
  55 init_logging :: Maybe FilePath -> Priority -> Bool -> IO ()
  56 init_logging log_file log_level syslog = do
  57   -- First set the global log level and clear the default handler.
  58   let no_handlers = [] :: [GenericHandler a]
  59   updateGlobalLogger rootLoggerName (setLevel log_level .
  60                                               setHandlers no_handlers)
  61
  62   when syslog $ do
  63     let min_level = INFO
  64     let sl_level = if log_level < min_level then min_level else log_level
  65
  66     -- The syslog handle gets its own level which will cowardly refuse
  67     -- to log all debug info (i.e. the entire feed) to syslog.
  68     sl_handler' <- openlog rootLoggerName [] USER sl_level
  69
  70     -- Syslog should output the date by itself.
  71     program_name <- getProgName
  72     let sl_formatter = simpleLogFormatter $
  73                          program_name ++ "[$pid] $prio: $msg"
  74     let sl_handler = setFormatter sl_handler' sl_formatter
  75
  76     updateGlobalLogger rootLoggerName (addHandler sl_handler)
  77
  78   case log_file of
  79     Nothing -> return ()
  80     Just lf -> do
  81       lf_handler' <- fileHandler lf log_level
  82       let lf_formatter = simpleLogFormatter "$time: htsn[$pid] $prio: $msg"
  83       let lf_handler = setFormatter lf_handler' lf_formatter
  84       updateGlobalLogger rootLoggerName (addHandler lf_handler)