X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FLogging.hs;h=63101c6f3735da2dbbbc1b913ae6ec1bc7719105;hb=da61a6744550e974688d46b23b11f1a842e4da2e;hp=8e80ac96414e7f5ad8bfc9d6cdd278bfde641acd;hpb=160caf38b6e936b6541b31b3c9bbe952ba0a4b15;p=dead%2Fhtsn.git diff --git a/src/Logging.hs b/src/Logging.hs index 8e80ac9..63101c6 100644 --- a/src/Logging.hs +++ b/src/Logging.hs @@ -7,6 +7,7 @@ module Logging ( 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 ) @@ -26,20 +27,30 @@ import System.Log.Logger ( 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 --- | Why don't we take a Configuration as an argument? Because it +-- | 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' configuration items. +-- +-- Why don't we take a Configuration as an argument? Because it -- would create circular imports! init_logging :: Maybe FilePath -> Priority -> Bool -> IO () init_logging log_file log_level syslog = do @@ -57,7 +68,9 @@ init_logging log_file log_level syslog = do sl_handler' <- openlog rootLoggerName [] USER sl_level -- Syslog should output the date by itself. - let sl_formatter = simpleLogFormatter "htsn[$pid] $prio: $msg" + 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)