X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn.git;a=blobdiff_plain;f=src%2FLogging.hs;h=8e80ac96414e7f5ad8bfc9d6cdd278bfde641acd;hp=fb1bfc658c91a536ff72b81627319681211a9588;hb=160caf38b6e936b6541b31b3c9bbe952ba0a4b15;hpb=bf31955186e4e3dd4e4f57cbf915fd9fc3d6b793

diff --git a/src/Logging.hs b/src/Logging.hs
index fb1bfc6..8e80ac9 100644
--- a/src/Logging.hs
+++ b/src/Logging.hs
@@ -6,14 +6,16 @@ module Logging (
   log_warning )
 where
 
+import Control.Monad ( when )
 import System.Log.Formatter ( simpleLogFormatter )
 import System.Log.Handler ( setFormatter )
-import System.Log.Handler.Simple ( fileHandler )
+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,
@@ -39,19 +41,31 @@ log_warning = warningM rootLoggerName
 
 -- | Why don't we take a Configuration as an argument? Because it
 --   would create circular imports!
-init_logging :: FilePath -> Priority -> Bool -> IO ()
-init_logging log_file log_level syslog
-  | syslog == True = do
-      handler' <- openlog rootLoggerName [] USER level
-      -- Syslog should output the date by itself.
-      let slf = simpleLogFormatter "htsn[$pid] $prio: $msg"
-      let handler = setFormatter handler' slf
-      updateGlobalLogger rootLoggerName (setLevel level . setHandlers [handler])
-  | otherwise = do
-      handler' <- fileHandler log_file level
-      let slf = simpleLogFormatter "$time: htsn[$pid] $prio: $msg"
-      let handler = setFormatter handler' slf
-      updateGlobalLogger rootLoggerName (setLevel level . setHandlers [handler])
-  where
-    min_level = if syslog then INFO else DEBUG
-    level = if log_level < min_level then min_level else log_level
+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]
+  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)