src/Network/Services/TSN/Logging.hs

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