X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FLogging.hs;h=db7260a1fc74c3600088684974075ffce56c1171;hb=52e788e676ea2a67ad20b23d2e5c5b351f27b834;hp=d8f9ed484f63b22fa1db553a10e8940b77ab9147;hpb=49c23c133221c9686dde0d52d06904db8d048724;p=dead%2Fhtsn.git

diff --git a/src/Logging.hs b/src/Logging.hs
index d8f9ed4..db7260a 100644
--- a/src/Logging.hs
+++ b/src/Logging.hs
@@ -6,11 +6,9 @@ module Logging (
   log_warning )
 where
 
-import System.IO ( hPutStr, stderr, stdout )
-import System.Log ( LogRecord )
-import System.Log.Formatter ( LogFormatter )
+import System.Log.Handler.Simple ( GenericHandler )
 import System.Log.Logger (
-  Priority ( DEBUG, ERROR, INFO, WARNING ),
+  Priority ( DEBUG, INFO ),
   debugM,
   errorM,
   infoM,
@@ -19,11 +17,6 @@ import System.Log.Logger (
   setLevel,
   updateGlobalLogger,
   warningM )
-import System.Log.Handler.Simple (
-  GenericHandler(..),
-  streamHandler )
-
-import Terminal ( hPutBlueStr, hPutRedStr )
 
 log_debug :: String -> IO ()
 log_debug = debugM rootLoggerName
@@ -37,49 +30,12 @@ log_info = infoM rootLoggerName
 log_warning :: String -> IO ()
 log_warning = warningM rootLoggerName
 
--- | Debug messages output to the console don't get a prefix, since
---   they're used to dump the network chatter.
-console_formatter :: LogRecord -> IO String
-console_formatter (DEBUG, msg) = return $ msg ++ "\n"
-console_formatter (prio, msg) = return $ (show prio) ++ ": " ++ msg ++ "\n"
-
-
-warn_formatter :: LogFormatter a
-warn_formatter  _ x@(WARNING, _) _ = console_formatter x
-warn_formatter  _ x@(ERROR, _) _ = console_formatter x
-warn_formatter  _ _ _ = return ""
-
-info_formatter :: LogFormatter a
-info_formatter  _ x@(INFO, _) _ = console_formatter x
-info_formatter  _ _ _ = return ""
-
-debug_formatter :: LogFormatter a
-debug_formatter  _ x@(DEBUG, _) _ = console_formatter x
-debug_formatter  _ _ _ = return ""
-
-
-init_logging :: IO ()
-init_logging = do
-  -- Set the root logger to DEBUG level so that it will *attempt* to
-  -- process every message.
-  updateGlobalLogger rootLoggerName (setLevel DEBUG)
-
-  stdout_handler <- streamHandler stdout DEBUG
-  stderr_handler <- streamHandler stderr WARNING
-
-  let debug_handler = stdout_handler { formatter = debug_formatter,
-                                       writeFunc = hPutStr }
-
-  let info_handler = stdout_handler { formatter = info_formatter,
-                                      priority = INFO,
-                                      writeFunc = hPutBlueStr }
-
-  -- This also catches ERRORs.
-  let warn_handler = stderr_handler { formatter = warn_formatter,
-                                      priority = WARNING,
-                                      writeFunc = hPutRedStr }
-
-  -- Set debug, info, and warn handlers for the root log.
-  updateGlobalLogger
-    rootLoggerName
-    (setHandlers [debug_handler, info_handler, warn_handler])
+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].
+  let no_handlers = [] :: [GenericHandler a]
+  -- Removes the default "echo to stdout" handler.
+  updateGlobalLogger rootLoggerName (setLevel max_level
+                                     . setHandlers no_handlers)