]> gitweb.michael.orlitzky.com - dead/htsn.git/commitdiff
Finally get logging right.
authorMichael Orlitzky <michael@orlitzky.com>
Sat, 21 Dec 2013 23:26:41 +0000 (18:26 -0500)
committerMichael Orlitzky <michael@orlitzky.com>
Sat, 21 Dec 2013 23:26:41 +0000 (18:26 -0500)
Remove *.log files in `make clean`.

makefile
src/Logging.hs
src/Main.hs

index dfc3d1df795431bf5959d0d4a8d26a0eebc83675..f94050d902109f9a5f8274ab370b2bddca4dbe8d 100644 (file)
--- a/makefile
+++ b/makefile
@@ -22,7 +22,7 @@ doc: src/*.hs
 
 clean:
        runghc Setup.hs clean
-
+       rm *.log
 
 $(TESTSUITE_BIN): src/*.hs test/TestSuite.hs
        runghc Setup.hs configure --user --enable-tests
index 94f4f7aa63bc383c23277c13bb8d93dd5b713cb3..fb1bfc658c91a536ff72b81627319681211a9588 100644 (file)
@@ -6,10 +6,11 @@ module Logging (
   log_warning )
 where
 
+import System.Log.Formatter ( simpleLogFormatter )
+import System.Log.Handler ( setFormatter )
 import System.Log.Handler.Simple ( fileHandler )
 import System.Log.Handler.Syslog (
   Facility ( USER ),
-  Option ( PID ),
   openlog )
 import System.Log.Logger (
   Priority ( DEBUG, INFO ),
@@ -22,6 +23,7 @@ import System.Log.Logger (
   updateGlobalLogger,
   warningM )
 
+
 log_debug :: String -> IO ()
 log_debug = debugM rootLoggerName
 
@@ -34,13 +36,21 @@ log_info = infoM rootLoggerName
 log_warning :: String -> IO ()
 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 [PID] USER level
+      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
+      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
index 0182e38196db034cb52b070e61ac8042c2d2e210..f36e2ba502d743e2d9d9f2665d366df385730a16 100644 (file)
@@ -189,7 +189,7 @@ log_in cfg h = do
 
 connect_and_loop :: Configuration -> String -> IO ()
 connect_and_loop cfg host = do
-  report_info $ "Connecting to " ++ host ++ "..."
+  report_info $ "Connecting to " ++ host ++ "."
   bracket acquire_handle release_handle action
   return ()
   where