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