]> gitweb.michael.orlitzky.com - dead/htsn.git/blob - src/Logging.hs
Move the TSN namespace (Xml.hs and FeedHosts.hs) into the top level.
[dead/htsn.git] / 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 Control.Monad ( when )
10 import System.Environment ( getProgName )
11 import System.Log.Formatter ( simpleLogFormatter )
12 import System.Log.Handler ( setFormatter )
13 import System.Log.Handler.Simple ( GenericHandler, fileHandler )
14 import System.Log.Handler.Syslog (
15 Facility ( USER ),
16 openlog )
17 import System.Log.Logger (
18 Priority ( INFO ),
19 addHandler,
20 debugM,
21 errorM,
22 infoM,
23 rootLoggerName,
24 setHandlers,
25 setLevel,
26 updateGlobalLogger,
27 warningM )
28
29
30 -- | Log a message at the DEBUG level.
31 log_debug :: String -> IO ()
32 log_debug = debugM rootLoggerName
33
34 -- | Log a message at the ERROR level.
35 log_error :: String -> IO ()
36 log_error = errorM rootLoggerName
37
38 -- | Log a message at the INFO level.
39 log_info :: String -> IO ()
40 log_info = infoM rootLoggerName
41
42 -- | Log a message at the WARNING level.
43 log_warning :: String -> IO ()
44 log_warning = warningM rootLoggerName
45
46
47 -- | Set up the logging. All logs are handled by the global "root"
48 -- logger provided by HSLogger. We remove all of its handlers so
49 -- that it does nothing; then we conditionally add back two handlers
50 -- -- one for syslog, and one for a normal file -- dependent upon
51 -- the 'syslog' and 'log_file' configuration items.
52 --
53 -- Why don't we take a Configuration as an argument? Because it
54 -- would create circular imports!
55 init_logging :: Maybe FilePath -> Priority -> Bool -> IO ()
56 init_logging log_file log_level syslog = do
57 -- First set the global log level and clear the default handler.
58 let no_handlers = [] :: [GenericHandler a]
59 updateGlobalLogger rootLoggerName (setLevel log_level .
60 setHandlers no_handlers)
61
62 when syslog $ do
63 let min_level = INFO
64 let sl_level = if log_level < min_level then min_level else log_level
65
66 -- The syslog handle gets its own level which will cowardly refuse
67 -- to log all debug info (i.e. the entire feed) to syslog.
68 sl_handler' <- openlog rootLoggerName [] USER sl_level
69
70 -- Syslog should output the date by itself.
71 program_name <- getProgName
72 let sl_formatter = simpleLogFormatter $
73 program_name ++ "[$pid] $prio: $msg"
74 let sl_handler = setFormatter sl_handler' sl_formatter
75
76 updateGlobalLogger rootLoggerName (addHandler sl_handler)
77
78 case log_file of
79 Nothing -> return ()
80 Just lf -> do
81 lf_handler' <- fileHandler lf log_level
82 let lf_formatter = simpleLogFormatter "$time: htsn[$pid] $prio: $msg"
83 let lf_handler = setFormatter lf_handler' lf_formatter
84 updateGlobalLogger rootLoggerName (addHandler lf_handler)