[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit e61af1b078ef700650d6082dec2f95aa20be7ddb
Author: John Goerzen <jgoerzen at complete.org>
Date:   Sat Oct 9 02:19:18 2004 +0100

    Logging is working
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--1.0--patch-59)

diff --git a/ChangeLog b/ChangeLog
index 408cd56..9763fc1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,18 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--1.0
 #
 
+2004-10-08 20:19:18 GMT	John Goerzen <jgoerzen at complete.org>	patch-59
+
+    Summary:
+      Logging is working
+    Revision:
+      missingh--head--1.0--patch-59
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Logging/Logger.hs
+
+
 2004-10-08 19:24:13 GMT	John Goerzen <jgoerzen at complete.org>	patch-58
 
     Summary:
diff --git a/libsrc/MissingH/Logging/Logger.hs b/libsrc/MissingH/Logging/Logger.hs
index b75748b..df79f93 100644
--- a/libsrc/MissingH/Logging/Logger.hs
+++ b/libsrc/MissingH/Logging/Logger.hs
@@ -26,7 +26,13 @@ Written by John Goerzen, jgoerzen\@complete.org
 
 module MissingH.Logging.Logger(-- * Basic Types
                                Logger,
-                               componentsOfName
+                               -- * Finding Loggers
+                               getLogger, getRootLogger,
+                               -- * Logging Messages
+                               logM,
+                               -- * Modifying Loggers
+                               addHandler, getLevel, setLevel,
+                               updateGlobalLogger
 
                                ) where
 import MissingH.Str
@@ -49,6 +55,7 @@ data Logger = Logger { level :: Priority,
                        handlers :: [HandlerT],
                        name :: String}
 
+
 type LogTree = FiniteMap String Logger
 
 -----------------------------------------------------------------------
@@ -111,22 +118,27 @@ createLoggers (x:xs) =
 getLogger :: String -> IO Logger
 getLogger lname =
     do
+    --putStrLn lname
     lt <- readIORef logTree
+    --putStrLn (show (keysFM lt))
     case lookupFM lt lname of
-         Just x -> return x
+         Just x ->  return x
          Nothing -> do
+                    --print "Missed it."
                     -- Add it.  Then call myself to retrieve it.
                     createLoggers (componentsOfName lname)
+                    --putStrLn "createLoggers done"
                     getLogger lname
+
                             
 -- | Returns the root logger.
 
 getRootLogger :: IO Logger
 getRootLogger = getLogger ""
 
--- | Log a message, assuming the current logger's
-log :: Logger -> Priority -> String -> IO ()
-log l pri msg = handle l (pri, msg)
+-- | Log a message, assuming the current logger's level permits it.
+logM :: Logger -> Priority -> String -> IO ()
+logM l pri msg = handle l (pri, msg)
 
 -- | Handle a log request.
 handle :: Logger -> LogRecord -> IO ()
@@ -138,7 +150,7 @@ handle l (pri, msg) =
             case (name l) of
                 "" -> return ()
                 x -> do 
-                     parent <- (getLogger . head . reverse . componentsOfName) x
+                     parent <- (getLogger . head . drop 1 . reverse . componentsOfName) x
                      handle parent (pri, msg)
        else return ()
 
@@ -153,7 +165,24 @@ callHandler lr ht =
 handlerActions :: [HandlerT] -> LogRecord -> [IO ()]
 handlerActions h lr = map (callHandler lr) h
                          
--- | Add handler to logger.
+-- | Add handler to 'Logger'.  Returns a new 'Logger'.
 addHandler :: LogHandler a => Logger -> a -> Logger
 addHandler l h = l{handlers = (HandlerT h) : (handlers l)}
 
+-- | Returns the "level" of the logger.  Items beneath this
+-- level will be ignored.
+
+getLevel :: Logger -> Priority
+getLevel l = level l
+
+-- | Sets the "level" of the 'Logger'.  Returns a new
+-- 'Logger' object with the new level.
+
+setLevel :: Logger -> Priority -> Logger
+setLevel l p = l{level = p}
+
+-- | Updates the global record for the given logger to take into
+-- account any changes you may have made.
+
+updateGlobalLogger :: Logger -> IO ()
+updateGlobalLogger l = modifyIORef logTree (\a -> addToFM a (name l) l)

-- 
haskell-testpack