log_warning )
where
-import System.Log.Handler.Simple ( GenericHandler )
+import Control.Monad ( when )
+import System.Log.Formatter ( simpleLogFormatter )
+import System.Log.Handler ( setFormatter )
+import System.Log.Handler.Simple ( GenericHandler, fileHandler )
+import System.Log.Handler.Syslog (
+ Facility ( USER ),
+ openlog )
import System.Log.Logger (
- Priority ( DEBUG, INFO ),
+ Priority ( INFO ),
+ addHandler,
debugM,
errorM,
infoM,
updateGlobalLogger,
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
-init_logging :: Bool -> IO ()
-init_logging use_syslog = do
- let max_level = if use_syslog then INFO else DEBUG
- -- We need to specify the type here; otherwise, setHandlers won't
- -- accept the empty list as an instance of [LogHandler a].
+
+-- | 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
+ -- First set the global log level and clear the default handler.
let no_handlers = [] :: [GenericHandler a]
- -- Removes the default "echo to stdout" handler.
- updateGlobalLogger rootLoggerName (setLevel max_level
- . setHandlers no_handlers)
+ updateGlobalLogger rootLoggerName (setLevel log_level .
+ setHandlers no_handlers)
+
+ when syslog $ do
+ let min_level = INFO
+ let sl_level = if log_level < min_level then min_level else log_level
+
+ -- The syslog handle gets its own level which will cowardly refuse
+ -- to log all debug info (i.e. the entire feed) to syslog.
+ sl_handler' <- openlog rootLoggerName [] USER sl_level
+
+ -- Syslog should output the date by itself.
+ let sl_formatter = simpleLogFormatter "htsn[$pid] $prio: $msg"
+ let sl_handler = setFormatter sl_handler' sl_formatter
+
+ updateGlobalLogger rootLoggerName (addHandler sl_handler)
+
+ case log_file of
+ Nothing -> return ()
+ Just lf -> do
+ lf_handler' <- fileHandler lf log_level
+ let lf_formatter = simpleLogFormatter "$time: htsn[$pid] $prio: $msg"
+ let lf_handler = setFormatter lf_handler' lf_formatter
+ updateGlobalLogger rootLoggerName (addHandler lf_handler)