[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 dc514c5078330e4bde1b140b437c02604250c4ef
Author: John Goerzen <jgoerzen at complete.org>
Date:   Fri Oct 8 23:38:01 2004 +0100

    Have a working basis for logging
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--1.0--patch-55)

diff --git a/ChangeLog b/ChangeLog
index ac7f7c8..1dfacce 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,21 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--1.0
 #
 
+2004-10-08 17:38:01 GMT	John Goerzen <jgoerzen at complete.org>	patch-55
+
+    Summary:
+      Have a working basis for logging
+    Revision:
+      missingh--head--1.0--patch-55
+
+
+    new files:
+     libsrc/MissingH/Logging/Logger.hs
+
+    modified files:
+     ChangeLog Makefile
+
+
 2004-10-08 15:32:58 GMT	John Goerzen <jgoerzen at complete.org>	patch-54
 
     Summary:
diff --git a/Makefile b/Makefile
index 8c951ec..50cfb23 100644
--- a/Makefile
+++ b/Makefile
@@ -30,7 +30,7 @@ libmissingH.a: $(OBJS)
 	ar q libmissingH.a $(OBJS)
 
 %.o: %.hs
-	ghc -ilibsrc --make `echo $< | sed -e s,libsrc/,, -e s,.hs$$,, -e s,/,.,g`
+	ghc -fglasgow-exts -ilibsrc --make `echo $< | sed -e s,libsrc/,, -e s,.hs$$,, -e s,/,.,g`
 
 doc:
 	-rm -rf html
@@ -52,7 +52,9 @@ test-hugs:
 	runhugs -P:$(PWD)/libsrc:$(PWD)/testsrc testsrc/runtests.hs
 
 interact-hugs:
-	hugs -P:$(PWD)/libsrc
+	hugs -98 -P:$(PWD)/libsrc
+
+interact: interact-hugs
 
 test: test-ghc6 test-hugs
 
diff --git a/libsrc/MissingH/Logging/Logger.hs b/libsrc/MissingH/Logging/Logger.hs
new file mode 100644
index 0000000..5583ebd
--- /dev/null
+++ b/libsrc/MissingH/Logging/Logger.hs
@@ -0,0 +1,67 @@
+{- arch-tag: Logger main definition
+Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+-}
+
+{- | Definition of log handler support
+
+For some handlers, check out "MissingH.Logging.Handler.Simple" and
+"MissingH.Logging.Handler.Syslog".
+
+Written by John Goerzen, jgoerzen\@complete.org
+-}
+
+module MissingH.Logging.Logger(-- * Basic Types
+                               Logger(..)
+                               ) where
+import MissingH.Logging
+import MissingH.Logging.Handler
+import MissingH.Logging.Handler.Simple
+import IO
+import System.IO.Unsafe
+import Data.IORef
+import Data.List(map)
+
+data HandlerT = forall a. LogHandler a => HandlerT a
+
+data Logger = Logger { priority :: Priority,
+                       handlers :: [HandlerT]}
+
+rootLogger :: IORef Logger
+rootLogger = unsafePerformIO $ do
+                               h <- streamHandler stdout DEBUG
+                               newIORef (Logger 
+                                         {priority = NOTICE,
+                                          handlers = [HandlerT h]})
+
+callHandler :: Priority -> String -> HandlerT -> IO ()
+callHandler pri msg ht =
+    case ht of
+            HandlerT x -> handle x (pri, msg)
+
+handlerActions :: Priority -> String -> IO [IO ()]
+handlerActions pri msg = do
+                         l <- readIORef rootLogger
+                         let h = map (callHandler pri msg) (handlers l)
+                         return h
+                         
+log :: Priority -> String -> IO ()
+log pri msg = do
+              l <- readIORef rootLogger
+              a <- handlerActions pri msg
+              if (pri >= priority l) 
+                 then sequence_ a
+                 else return ()

-- 
haskell-testpack