
Following the advice on the hslogger wiki (http://software.complete.org/software/wiki/hslogger) I'm posting my thoughts about hslogger here: What is wired? This piece of code (src/System/Log/Logger.hs): parentHandlers name = let pname = (head . drop 1 . reverse . componentsOfName) name in do [...] next <- parentHandlers pname return ((handlers parent) ++ next) Why? Because when logging to "A.B.C" it splits the String once to get ["A","B","C"], then it drops the last part and runs the same again for "A.B" and so on.. So A string is split > 3 times for one logging action. I think this is a waste of cpu cycles.. I'm going to improve this. While reading the code i noticed two issues: ====================================================================== issue 1 That's not the most awkward thing: When logging to "A.B.C" hslogger does add 3 loggers to the global logger Map: "A" "A.B" "A.B.C" all three inheriting the default priority level of the default rootLogger "" A test application illustrating this (feature ?) module Main where -- packages: hslogger import System.Log.Logger as HL import System.Log.Handler.Simple as HL main = do -- the default logger logs to stderr level WARNING -- that's why the following message should be shown -- a) logM "A.B.C" HL.ALERT "ALERT test, should be shown and should create the sublogger" -- b) updateGlobalLogger rootLoggerName (setLevel EMERGENCY) logM "A.B.C" HL.ALERT "ALERT test, should not be shown cause we have changed to EMERGENCY" which prints: tmp %./test1 /tmp nixos ALERT test, should be shown and should create the sublogger ALERT test, should not be shown cause we have changed to EMERGENCY which is quite confusing because I haven't told hslogger explicitely to use a log level printing ALERTs on "A.B.C". so I'd expect that only the first message is shown. This behaviour is explained by the inheritance of the loglevel when hslogger creates them (without attaching handlers) automatically. I don't want the logging behaviour depend on wether a log line has been emitted before or not. Do you agree? Have I missed something? solution: replacing data Logger = Logger { level :: Priority, handlers :: [HandlerT], name :: String} type LogTree = Map.Map String Logger by a real log tree: data LogTree = LogTree { level :: Priority, -- level only applies to handlers, not to subLoggers handlers :: [HandlerT], subLoggers :: Map.Map String LogTree } ====================================================================== issue 2 The second ineresting point is (bug or feature?) that you can make the root logger shut up by setting different log levels to sub loggers: this sample does illustrate it: module Main where -- packages: hslogger import System.Log.Logger as HL import System.Log.Handler.Simple as HL main = do updateGlobalLogger "" (setLevel DEBUG) updateGlobalLogger "A" (setLevel EMERGENCY) logM "A" HL.ALERT "ALERT test, should not be shown cause we have changed to EMERGENCY" It doesn't print anything although the default log handler on root (="") is set to loglever DEBUG. So there is no way to get all logmessages without removing all all setLevel calls to subloggers? Is this desirable? ====================================================================== my conclusion: About issue 1 I think its a bug About issue 2 I don't know. I think there should be a way to get all log messages. So I feel this is a bug as well. I neither have checkeg the logcxx nor log4j nor the reference implementation in python. Thoughts? Sincerly Marc Weber

On 2009 Jan 31, at 20:28, Marc Weber wrote:
tmp %./test1 /tmp nixos ALERT test, should be shown and should create the sublogger ALERT test, should not be shown cause we have changed to EMERGENCY
which is quite confusing because I haven't told hslogger explicitely to use a log level printing ALERTs on "A.B.C". so I'd expect that only the first message is shown. This behaviour is explained by the inheritance of the loglevel when hslogger creates them (without attaching handlers) automatically.
I don't want the logging behaviour depend on wether a log line has been emitted before or not. Do you agree? Have I missed something?
At least some of what you've missed is that this is inherited from the C syslog library; possibly this should be using withSysLog (options) $ ... to bracket a use of syslog with appropriate openlog()/closelog() and changing top level options should only be attempted in the openlog() call. -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH

====================================================================== issue 1
That's not the most awkward thing: When logging to "A.B.C" hslogger does add 3 loggers to the global logger Map: "A" "A.B" "A.B.C" all three inheriting the default priority level of the default rootLogger ""
A test application illustrating this (feature ?)
module Main where -- packages: hslogger import System.Log.Logger as HL import System.Log.Handler.Simple as HL
main = do -- the default logger logs to stderr level WARNING -- that's why the following message should be shown
-- a) logM "A.B.C" HL.ALERT "ALERT test, should be shown and should create the sublogger"
-- b) updateGlobalLogger rootLoggerName (setLevel EMERGENCY)
logM "A.B.C" HL.ALERT "ALERT test, should not be shown cause we have changed to EMERGENCY"
which prints:
tmp %./test1 /tmp nixos ALERT test, should be shown and should create the sublogger ALERT test, should not be shown cause we have changed to EMERGENCY
I've written some patches increasing speed by 30%. See the benchmark. You can get them by cloning git://mawercer.de/hslogger; (branch hslogger_updates) I've replaced the internal representation (Map name Logger) by a tree. Only logging to a logger does no longer add a new node (which cloned the priority level in the past causing issue 1) The basic interface updateLogger name (set priority or add handlers) and logM is still the same. The logM is based on MonadIO now. So you no longer have to call liftIO yourself.. Also I've removed the standard setup logging to stderr. There is a setupLogging function instead.. Why? I can think of some use cases where logging to stderr doesn't make sense and it took me too much time figuring out how to remve the old stderr logger (I didn't find a nice solution without changing the exposed API) I don't want to start using my "personal" copy of hslogger. That's why I'd like to ask you wether you consider these changes beeing improvements although they break existing code (You'll have do add that initialization line) I also wonder wether it's worth using Bytestrings instead of Strings? I've not spend to much time on updating all the documentation yet.. If you'd like to ensure that a use case sill works add another test case please. You can also push to that git repository. Sincerly Marc Weber

Marc Weber wrote:
I've written some patches increasing speed by 30%. See the benchmark.
Hi Marc, Patches are always great to see! Where is this benchmark? Can you separate out your speed changes (which I take it have no impact on functionality or API) from your other changes? I am not certain that I would want to apply the other changes.
You can get them by cloning git://mawercer.de/hslogger; (branch hslogger_updates)
I've replaced the internal representation (Map name Logger) by a tree. Only logging to a logger does no longer add a new node (which cloned the priority level in the past causing issue 1)
As I said, I'm not really convinced this is a real issue. I'm still open to it though -- but I'm unconvinced that the change in API is worth it at this point.
Also I've removed the standard setup logging to stderr. There is a setupLogging function instead..
I'm not sure what you mean the "standard setup logging to stderr". Do you mean the default root handler?
Why? I can think of some use cases where logging to stderr doesn't make sense and it took me too much time figuring out how to remve the old stderr logger (I didn't find a nice solution without changing the exposed API)
You didn't notice setHandlers? -- | Set the 'Logger'\'s list of handlers to the list supplied. -- All existing handlers are removed first. setHandlers :: LogHandler a => [a] -> Logger -> Logger It is perfectly valid to set the root logger's handlers to [] if you want it to do nothing at all.
I don't want to start using my "personal" copy of hslogger. That's why I'd like to ask you wether you consider these changes beeing improvements although they break existing code (You'll have do add that initialization line)
At this point, I'm not convinced that the API changes are actual improvements. But I'm not saying "never".
I also wonder wether it's worth using Bytestrings instead of Strings?
To what end? The only reason I can think of is UTF-8 output. (does putStr output UTF-8 these days, or still truncate the 24 bits above the low 8 like it used to? I haven't checked.) -- John

Hi John, Yes, a NotSet corresponds to my new "Nothing" setting. Proably you're right that adding that would have been enogh. API changes: Probably you're talking about the introduction of those classes? The idea was to not have to split that String over and over again. This way I thought you could pass over the logger path (LoggerName ["A","B","C"]) directly..
Where do I find the benchmark? Look it up in tests/Benchmark.hs and the .cabal file.
I've added the benchmark first before having done most updates so that it's easier to compare the results. About the Bytestring thing I won't bother you until I'm sure it's worth it. You're right: in a ready to go application you always keep the default logger. But I want to use hslogger also to verify that my application does what I think it should be doing .. And while learning about hslogger you will do things in different order. Maybe its just that the most important parts about hslogger didn't came through to my mind. Maybe one can shorten that all to this. At least that's how my change are supposed to work: The logging sytem is based on a tree. To each tree node you can attach handlers. When a loogging action is performed the tree is traversed from the logger name up to the root. The first node having attached an logging priority will be used to decide wether the message gets logged at all. If its logged all the handlers having been attached to the visited nodes will be called. Conclusions: having this setup: "A.B.C" log priority EMERGENCY "" log priority DEBUG the handlers atteched to "" won't get debug messages send to the "A.B.C" logger. So there is no way to trace all messages without knowing about all sub logger level settings. Something like this would have been enough give me an idea what the library really does. Anyway the least thing I need is the NOTSET logger level setting. Wether we call it Nothing or NOTSET doesn't matter. Sincerly Marc Weber

Hi Marc, I have pushed to my hslogger repo the optional priority for a logger support that we talked about, which is the Haskell version of Python's NOTSET. It is currently untested and represents only a minor API change. Please take a look and let me know your thoughts. It adds one new function to the API (clearLevel) and changes the return type of getLevel. Other than that, the changes are pretty much hidden from the public interface. I looked at your git repo, but I'm not going to pull anything from it right this minute. I would consider your performance change, but it was wrapped up with half a dozen other things in a single commit so I couldn't extract just it. If you would split up your changes into small bite-sized diffs, where each one makes exactly one change and is documented, I would be happy to take another look. As it is, each patch is touching too many unrelated areas for me to really bring them in. (I don't want API changes just for a performance improvement.) hslogger is used by a bunch of code all over the place, so I want to be very careful about what I do to it to avoid causing a lot of hassle for a lot of people. -- John

On Tue, Feb 03, 2009 at 02:55:15PM -0600, John Goerzen wrote:
I looked at your git repo, but I'm not going to pull anything from it right this minute. I would consider your performance change, but it was wrapped up with half a dozen other things in a single commit so I couldn't extract just it.
Also, there is *no way* I will apply any patch that removes my copyright notices, as your git branch does. -- John

You didn't notice setHandlers?
-- | Set the 'Logger'\'s list of handlers to the list supplied. -- All existing handlers are removed first. setHandlers :: LogHandler a => [a] -> Logger -> Logger
It is perfectly valid to set the root logger's handlers to [] if you want it to do nothing at all.
Which type to assign to [] ? Right now I'm using instance HL.LogHandler () where -- doh! find a better way to pass an empty list below setLevel = error "should never be rearched" getLevel = error "should never be rearched" emit = error "should never be rearched" close = error "should never be rearched" HL.updateGlobalLogger "" (HL.addHandler fh . HL.setHandlers ([] :: [()]) ) ... But I'm not satisfied with that. But I couldn't find a better solution either. Eg I've tried [] :: [SyslogHandler] (SyslogHandler is not exported, is it?) [] :: [GenericHandler ()] (GenericHandler isn't exported either?) Sincerly Marc Weber

I haven't had the time to study your question in detail yet, but I would start by directing you here: http://www.python.org/doc/current/library/logging.html#module-logging hslogger is heavily based upon an earlier version of the Python logging module. I had some experience with it and found it to work well, and thus based the hslogger design upon it. -- John Marc Weber wrote:
Following the advice on the hslogger wiki (http://software.complete.org/software/wiki/hslogger) I'm posting my thoughts about hslogger here:
What is wired? This piece of code (src/System/Log/Logger.hs):
parentHandlers name = let pname = (head . drop 1 . reverse . componentsOfName) name in do [...] next <- parentHandlers pname return ((handlers parent) ++ next)
Why? Because when logging to "A.B.C" it splits the String once to get ["A","B","C"], then it drops the last part and runs the same again for "A.B" and so on.. So A string is split > 3 times for one logging action. I think this is a waste of cpu cycles.. I'm going to improve this. While reading the code i noticed two issues:
====================================================================== issue 1
That's not the most awkward thing: When logging to "A.B.C" hslogger does add 3 loggers to the global logger Map: "A" "A.B" "A.B.C" all three inheriting the default priority level of the default rootLogger ""
A test application illustrating this (feature ?)
module Main where -- packages: hslogger import System.Log.Logger as HL import System.Log.Handler.Simple as HL
main = do -- the default logger logs to stderr level WARNING -- that's why the following message should be shown
-- a) logM "A.B.C" HL.ALERT "ALERT test, should be shown and should create the sublogger"
-- b) updateGlobalLogger rootLoggerName (setLevel EMERGENCY)
logM "A.B.C" HL.ALERT "ALERT test, should not be shown cause we have changed to EMERGENCY"
which prints:
tmp %./test1 /tmp nixos ALERT test, should be shown and should create the sublogger ALERT test, should not be shown cause we have changed to EMERGENCY
which is quite confusing because I haven't told hslogger explicitely to use a log level printing ALERTs on "A.B.C". so I'd expect that only the first message is shown. This behaviour is explained by the inheritance of the loglevel when hslogger creates them (without attaching handlers) automatically.
I don't want the logging behaviour depend on wether a log line has been emitted before or not. Do you agree? Have I missed something?
solution:
replacing
data Logger = Logger { level :: Priority, handlers :: [HandlerT], name :: String}
type LogTree = Map.Map String Logger
by a real log tree:
data LogTree = LogTree { level :: Priority, -- level only applies to handlers, not to subLoggers handlers :: [HandlerT], subLoggers :: Map.Map String LogTree }
====================================================================== issue 2
The second ineresting point is (bug or feature?) that you can make the root logger shut up by setting different log levels to sub loggers:
this sample does illustrate it:
module Main where -- packages: hslogger import System.Log.Logger as HL import System.Log.Handler.Simple as HL
main = do updateGlobalLogger "" (setLevel DEBUG) updateGlobalLogger "A" (setLevel EMERGENCY) logM "A" HL.ALERT "ALERT test, should not be shown cause we have changed to EMERGENCY"
It doesn't print anything although the default log handler on root (="") is set to loglever DEBUG. So there is no way to get all logmessages without removing all all setLevel calls to subloggers? Is this desirable?
====================================================================== my conclusion:
About issue 1 I think its a bug About issue 2 I don't know. I think there should be a way to get all log messages. So I feel this is a bug as well.
I neither have checkeg the logcxx nor log4j nor the reference implementation in python.
Thoughts?
Sincerly Marc Weber

Hi John, thank you for your feedback: I've taken the time to rewrite the example (issue1) using the python logging system. I came up with: import logging logging.basicConfig(level=logging.DEBUG, format='%(asctime)s %(levelname)s %(message)s', filename='/tmp/myapp.log', filemode='w') logging.getLogger('').setLevel(logging.DEBUG) loggerSub = logging.getLogger('A.B.C') loggerSub.critical('CRITICAL test, should be shown and should create the sublogger') logging.getLogger('').setLevel(logging.WARNING) loggerSub.debug('WARNING test, should not be shown cause we have changed to WARNING') which only logs the first line but not the second one 2009-02-03 11:14:52,058 CRITICAL CRITICAL test, should be shown and should create the sublogger hackage hslogger does clone the priority setting for A.B.C (in getLogger). The cloned value is no longer affected by when changing the top level logging priority. So this example makes hackage hslogger log both lines. So I consider this a beeing a (small) bug. Sincerly Marc Weber

Marc Weber wrote:
Hi John,
thank you for your feedback: I've taken the time to rewrite the example (issue1) using the python logging system. I came up with:
I think what you're noticing is the NOTSET level in Python. Python creates new loggers with the priority NOTSET, which means it searches up the tree for a logger with a priority /= NOTSET, and uses the first priority it finds. hslogger doesn't have NOTSET, and each logger does have a specific priority. The Python NOTSET priority does sound like a useful addition to hslogger, though. I think it would solve what you're after with minimal invasiveness.
hackage hslogger does clone the priority setting for A.B.C (in getLogger).
Yes, I see that; looks like the docs are incorrect on that point. But this only comes into play if you are changing the logging level on a particular subset of a running program. Does that really happen often in practice? I'd be happy to add NOTSET semantics to hslogger. -- John

Marc Weber wrote:
Following the advice on the hslogger wiki (http://software.complete.org/software/wiki/hslogger) I'm posting my thoughts about hslogger here:
Hi Marc, Thanks for posting this. Let's start with a big-picture architecture overview. What need does hslogger anticipate meeting? * Big applications have varied logging needs. * Small applications want to keep logging simple. * It is often desirable to enable or disable logging about certain types of things. * It is also often desirable to enable or disable logging above a certain threshold of importance. * The vast majority of apps want to set logging preferences once and then forget about them, having decided what to do by reading a config file, command line, or whatever. * There can be many different ways to output logging messages: syslog, stderr, files, etc. A given app may want to use more than one of them. There are a lot of logging frameworks out there. Many of them fail the "keep logging simple" test. Many others fail the "varied needs" test. One that failed neither in my experience was the Python logging infrastructure, so I based hslogger around its interface. hslogger has served me pretty well since, though I wish it were a bit stronger on the simple side.
This piece of code (src/System/Log/Logger.hs):
parentHandlers name = let pname = (head . drop 1 . reverse . componentsOfName) name in do [...] next <- parentHandlers pname return ((handlers parent) ++ next)
Why? Because when logging to "A.B.C" it splits the String once to get ["A","B","C"], then it drops the last part and runs the same again for "A.B" and so on.. So A string is split > 3 times for one logging action. I think this is a waste of cpu cycles.. I'm going to improve this. While reading the code i noticed two issues:
It may be, but really this is trivially tiny. The effort required to do that is almost certainly exceptionally tiny compared just to the effort required to actually output the log message. If you have a simple fix, that's fine, but let's not complicate the code to save a 2 CPU cycles in a process that can't possibly use less than 1000 :-)
====================================================================== issue 1
That's not the most awkward thing: When logging to "A.B.C" hslogger does add 3 loggers to the global logger Map:
Only if you haven't logged to it before.
"A" "A.B" "A.B.C" all three inheriting the default priority level of the default rootLogger ""
According to the docs: First of all, whenever you first access a given logger by name, it magically springs to life. It has a default 'Priority' of 'DEBUG' and an empty handler list -- which means that it will inherit whatever its parents do. It's not setting the priority to the rootLogger default; it's setting it to DEBUG. Your test doesn't invalidate this.
A test application illustrating this (feature ?)
module Main where -- packages: hslogger import System.Log.Logger as HL import System.Log.Handler.Simple as HL
main = do -- the default logger logs to stderr level WARNING -- that's why the following message should be shown
-- a) logM "A.B.C" HL.ALERT "ALERT test, should be shown and should create the sublogger"
-- b) updateGlobalLogger rootLoggerName (setLevel EMERGENCY)
logM "A.B.C" HL.ALERT "ALERT test, should not be shown cause we have changed to EMERGENCY"
which prints:
tmp %./test1 /tmp nixos ALERT test, should be shown and should create the sublogger ALERT test, should not be shown cause we have changed to EMERGENCY
which is quite confusing because I haven't told hslogger explicitely to use a log level printing ALERTs on "A.B.C". so I'd expect that only
No, you told it that things logged to the root logger directly have a certain preference. You have never expressed any preference whatsoever on the A.B.C logger. If you wish to set a global preference on the level of logging to occur, you would be better served to do so in the configuration for the handler. From the docs: To give you one extra little knob to turn, 'LogHandler's can also have importance levels ('Priority') associated with them in the same way that 'Logger's do. They act just like the 'Priority' value in the 'Logger's -- as a filter. It's useful, for instance, to make sure that under no circumstances will a mere 'DEBUG' message show up in your syslog. Since handlers are inherited down the logger chain, you can easily tweak the priority associated with the handlers at the root logger level and have an instant impact on all the others. The point of the priority attached to a logger is to be able to disable messages *about* certain things. The point of the priority attached to a handler is to be able to disable messages *below a certain importance level globally*. So I think you're trying to turn the wrong knob to achieve your desired goal.
====================================================================== issue 2
The second ineresting point is (bug or feature?) that you can make the root logger shut up by setting different log levels to sub loggers:
this sample does illustrate it:
It doesn't illustrate that. You logged to the "A" logger, not the root logger. Let's look at it below.
module Main where -- packages: hslogger import System.Log.Logger as HL import System.Log.Handler.Simple as HL
main = do updateGlobalLogger "" (setLevel DEBUG) updateGlobalLogger "A" (setLevel EMERGENCY) logM "A" HL.ALERT "ALERT test, should not be shown cause we have changed to EMERGENCY"
It doesn't print anything although the default log handler on root (="") is set to loglever DEBUG. So there is no way to get all logmessages
So what you've done here is tell hslogger that for log events regarding "A", you don't want to hear about anything unless it's an EMERGENCY. And hslogger followed your instructions directly.
without removing all all setLevel calls to subloggers? Is this desirable?
I don't understand the problem. If you told hslogger that you didn't want to hear about stuff about "A", why do you not like that it is following your instructions? Note that you didn't actually change the priority of the handler up there. You changed the priority of the *logger*. Remember, logger priorities aren't inherited. As I said, I think your whole problem would be solved if you simply changed the priority of the handler associated with the root logger. -- John

without removing all all setLevel calls to subloggers? Is this desirable?
I don't understand the problem. If you told hslogger that you didn't want to hear about stuff about "A", why do you not like that it is following your instructions?
Because taht >>don't want to hear abuot "A"<< could have been set without my knowledge. When trouble shooting a problem it could be handy to just get all messages. But when such a use case arrives I can still patch hslogger. mlog (attempt to create a minimal alternative) ==== I've tried writing another minimal logging system. The idea was driven by adding the possibility to add a handler logging everything not matter what levels are set to different loggers or handlers. The design is simple: keep a list of log handlers and a list of filters. you can add a filter telling that a log message of "A.B" should not be logged. The actual handler function then looks like this log shouldbeLogged logmessage loggername prio = .... So you can still ignore shouldbeLogged easily. However I couldn't even come close to the speed of hslogger even when caching the list of handlers which are supposed to log the message. [some code snippets see end of mail] without any attached handlers: hslogger*[1] : 4ms mlog[2]: 12ms with one default stderr logger (./test 2> /dev/null) hslogger*[1] : 109ms mlog[2]: 150ms [1]: my modified version of hslogger (git://mawercer.de/hslogger) [2]: (git://mawercer.de/mlog) I've tried doing some investigation figuring out why my lib is that much slower but I failed. I noticed that -O2 had an impact on how often the list of generated test cases is run. But that has been all. I don't even use existential types! So I'll shut up and keep using hslogger. Thanks to you John Goerzen for your support. I've learned that I'm very bad at troubleshooting performance. I really thought I could make mlog faster than hslogger*. Using profiling (-P) didn't reveal the source wasting CPU cycles to me. Sincerly Marc Weber [ some code snippets of mlog] the global logger data looks like this: data GlobalLoggerData = GlobalLoggerData { handlers :: M.Map Int LogHandler -- assign a key so that this logger can be removed easily again ,filters :: M.Map Int GlobalFilter -- allow to add global filters -- cache information about which logger accepts what logging data -- String = Priority : loggername , cached :: M.Map String (Bool, [ LogMessageAction ]) } {-# NOINLINE globalLoggerData #-} globalLoggerData :: MVar GlobalLoggerData globalLoggerData = unsafePerformIO $ newMVar $ GlobalLoggerData M.empty M.empty M.empty -- add default handler: addHandler $ LogHandler { accept = \ln p -> True -- which logging events does this log handler accept? ,logAction = \ln p msg doLog -> hPutStrLn stderr msg ,close = return () }
participants (3)
-
Brandon S. Allbery KF8NH
-
John Goerzen
-
Marc Weber