From a8abe8f8e85662f544235f1d0a43524e5077078a Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sat, 21 Dec 2013 18:26:41 -0500 Subject: [PATCH] Finally get logging right. Remove *.log files in `make clean`. --- makefile | 2 +- src/Logging.hs | 16 +++++++++++++--- src/Main.hs | 2 +- 3 files changed, 15 insertions(+), 5 deletions(-) diff --git a/makefile b/makefile index dfc3d1d..f94050d 100644 --- 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 diff --git a/src/Logging.hs b/src/Logging.hs index 94f4f7a..fb1bfc6 100644 --- a/src/Logging.hs +++ b/src/Logging.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs index 0182e38..f36e2ba 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 -- 2.44.2