9 import System.IO ( hPutStr, stderr, stdout )
10 import System.Log ( LogRecord )
11 import System.Log.Formatter ( LogFormatter )
12 import System.Log.Logger (
13 Priority ( DEBUG, ERROR, INFO, WARNING ),
22 import System.Log.Handler.Simple (
26 import Terminal ( hPutBlueStr, hPutRedStr )
28 log_debug :: String -> IO ()
29 log_debug = debugM rootLoggerName
31 log_error :: String -> IO ()
32 log_error = errorM rootLoggerName
34 log_info :: String -> IO ()
35 log_info = infoM rootLoggerName
37 log_warning :: String -> IO ()
38 log_warning = warningM rootLoggerName
40 -- | Debug messages output to the console don't get a prefix, since
41 -- they're used to dump the network chatter.
42 console_formatter :: LogRecord -> IO String
43 console_formatter (DEBUG, msg) = return $ msg ++ "\n"
44 console_formatter (prio, msg) = return $ (show prio) ++ ": " ++ msg ++ "\n"
47 warn_formatter :: LogFormatter a
48 warn_formatter _ x@(WARNING, _) _ = console_formatter x
49 warn_formatter _ x@(ERROR, _) _ = console_formatter x
50 warn_formatter _ _ _ = return ""
52 info_formatter :: LogFormatter a
53 info_formatter _ x@(INFO, _) _ = console_formatter x
54 info_formatter _ _ _ = return ""
56 debug_formatter :: LogFormatter a
57 debug_formatter _ x@(DEBUG, _) _ = console_formatter x
58 debug_formatter _ _ _ = return ""
63 -- Set the root logger to DEBUG level so that it will *attempt* to
64 -- process every message.
65 updateGlobalLogger rootLoggerName (setLevel DEBUG)
67 stdout_handler <- streamHandler stdout DEBUG
68 stderr_handler <- streamHandler stderr WARNING
70 let debug_handler = stdout_handler { formatter = debug_formatter,
73 let info_handler = stdout_handler { formatter = info_formatter,
75 writeFunc = hPutBlueStr }
77 -- This also catches ERRORs.
78 let warn_handler = stderr_handler { formatter = warn_formatter,
80 writeFunc = hPutRedStr }
82 -- Set debug, info, and warn handlers for the root log.
85 (setHandlers [debug_handler, info_handler, warn_handler])