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 System.Log.Formatter ( simpleLogFormatter )
  10 import System.Log.Handler ( setFormatter )
  11 import System.Log.Handler.Simple ( fileHandler )
  12 import System.Log.Handler.Syslog (
  13   Facility ( USER ),
  14   openlog )
  15 import System.Log.Logger (
  16   Priority ( DEBUG, INFO ),
  17   debugM,
  18   errorM,
  19   infoM,
  20   rootLoggerName,
  21   setHandlers,
  22   setLevel,
  23   updateGlobalLogger,
  24   warningM )
  25
  26
  27 log_debug :: String -> IO ()
  28 log_debug = debugM rootLoggerName
  29
  30 log_error :: String -> IO ()
  31 log_error = errorM rootLoggerName
  32
  33 log_info :: String -> IO ()
  34 log_info = infoM rootLoggerName
  35
  36 log_warning :: String -> IO ()
  37 log_warning = warningM rootLoggerName
  38
  39
  40 -- | Why don't we take a Configuration as an argument? Because it
  41 --   would create circular imports!
  42 init_logging :: FilePath -> Priority -> Bool -> IO ()
  43 init_logging log_file log_level syslog
  44   | syslog == True = do
  45       handler' <- openlog rootLoggerName [] USER level
  46       -- Syslog should output the date by itself.
  47       let slf = simpleLogFormatter "htsn[$pid] $prio: $msg"
  48       let handler = setFormatter handler' slf
  49       updateGlobalLogger rootLoggerName (setLevel level . setHandlers [handler])
  50   | otherwise = do
  51       handler' <- fileHandler log_file level
  52       let slf = simpleLogFormatter "$time: htsn[$pid] $prio: $msg"
  53       let handler = setFormatter handler' slf
  54       updateGlobalLogger rootLoggerName (setLevel level . setHandlers [handler])
  55   where
  56     min_level = if syslog then INFO else DEBUG
  57     level = if log_level < min_level then min_level else log_level