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

diff --git a/src/Logging.hs b/src/Logging.hs
index db7260a..fb1bfc6 100644
--- a/src/Logging.hs
+++ b/src/Logging.hs
@@ -6,7 +6,12 @@ module Logging (
   log_warning )
 where
 
-import System.Log.Handler.Simple ( GenericHandler )
+import System.Log.Formatter ( simpleLogFormatter )
+import System.Log.Handler ( setFormatter )
+import System.Log.Handler.Simple ( fileHandler )
+import System.Log.Handler.Syslog (
+  Facility ( USER ),
+  openlog )
 import System.Log.Logger (
   Priority ( DEBUG, INFO ),
   debugM,
@@ -18,6 +23,7 @@ import System.Log.Logger (
   updateGlobalLogger,
   warningM )
 
+
 log_debug :: String -> IO ()
 log_debug = debugM rootLoggerName
 
@@ -30,12 +36,22 @@ log_info = infoM rootLoggerName
 log_warning :: String -> IO ()
 log_warning = warningM rootLoggerName
 
-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)
+
+-- | 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