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 (
16 import System.Log.Logger (
29 -- | Log a message at the DEBUG level.
30 log_debug :: String -> IO ()
31 log_debug = debugM rootLoggerName
33 -- | Log a message at the ERROR level.
34 log_error :: String -> IO ()
35 log_error = errorM rootLoggerName
37 -- | Log a message at the INFO level.
38 log_info :: String -> IO ()
39 log_info = infoM rootLoggerName
41 -- | Log a message at the WARNING level.
42 log_warning :: String -> IO ()
43 log_warning = warningM rootLoggerName
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.
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)
63 let sl_level = if log_level < min_level then min_level else log_level
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
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
73 updateGlobalLogger rootLoggerName (addHandler sl_handler)
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)