hslogger 1.0.12 → 1.1.0

raw patch · 8 files changed

+214/−68 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hslogger.cabal +2/−2
• src/System/Log/Formatter.hs +109/−0
• src/System/Log/Handler.hs +8/−1
• src/System/Log/Handler/Growl.hs +6/−1
• src/System/Log/Handler/Log4jXML.hs +18/−22
• src/System/Log/Handler/Simple.hs +11/−16
• src/System/Log/Handler/Syslog.hs +36/−25
• src/System/Log/Logger.hs +24/−1

@@ -1,5 +1,5 @@ Name: hslogger-Version: 1.0.12+Version: 1.1.0 License: LGPL Maintainer: John Goerzen <jgoerzen@complete.org> Author: John Goerzen@@ -37,7 +37,7 @@  Library     Exposed-Modules: -      System.Log, System.Log.Handler,+      System.Log, System.Log.Handler, System.Log.Formatter,         System.Log.Handler.Simple, System.Log.Handler.Syslog,         System.Log.Handler.Growl, System.Log.Handler.Log4jXML,         System.Log.Logger

@@ -0,0 +1,109 @@+{- |++Definition of log formatter support++A few basic, and extendable formatters are defined.+++Please see "System.Log.Logger" for extensive documentation on the+logging system.++-}+++module System.Log.Formatter( LogFormatter+                           , nullFormatter+                           , simpleLogFormatter+                           , tfLogFormatter+                           , varFormatter+                           ) where+import Data.List+import Control.Applicative ((<$>))+import Control.Concurrent (myThreadId)+#ifndef mingw32_HOST_OS+import System.Posix.Process (getProcessID)+#endif++import System.Locale (defaultTimeLocale)+import Data.Time (getZonedTime,getCurrentTime,formatTime)++import System.Log++-- | A LogFormatter is used to format log messages.  Note that it is paramterized on the+-- 'Handler' to allow the formatter to use information specific to the handler+-- (an example of can be seen in the formatter used in 'System.Log.Handler.Syslog')+type LogFormatter a = a -- ^ The LogHandler that the passed message came from +                    -> LogRecord -- ^ The log message and priority+                    -> String -- ^ The logger name+                    -> IO String -- ^ The formatted log message++-- | Returns the passed message as is, ie. no formatting is done.+nullFormatter :: LogFormatter a+nullFormatter _ (_,msg) _ = return msg++-- | Takes a format string, and returns a formatter that may be used to+--   format log messages.  The format string may contain variables prefixed with+--   a $-sign which will be replaced at runtime with corresponding values.  The +--   currently supported variables are:+--+--    * @$msg@ - The actual log message+--+--    * @$loggername@ - The name of the logger+--+--    * @$prio@ - The priority level of the message+--+--    * @$tid@  - The thread ID+--+--    * @$pid@  - Process ID  (Not available on windows)+--+--    * @$time@ - The current time +--+--    * @$utcTime@ - The current time in UTC Time+simpleLogFormatter :: String -> LogFormatter a+simpleLogFormatter format h (prio, msg) loggername = +    tfLogFormatter "%F %X %Z" format h (prio,msg) loggername++-- | Like 'simpleLogFormatter' but allow the time format to be specified in the first+-- parameter (this is passed to 'Date.Time.Format.formatTime')+tfLogFormatter :: String -> String -> LogFormatter a+tfLogFormatter timeFormat format = do+  varFormatter [("time", formatTime defaultTimeLocale timeFormat <$> getZonedTime)+               ,("utcTime", formatTime defaultTimeLocale timeFormat <$> getCurrentTime)+               ]+      format++-- | An extensible formatter that allows new substition /variables/ to be defined.+-- Each variable has an associated IO action that is used to produce the+-- string to substitute for the variable name.  The predefined variables are the same+-- as for 'simpleLogFormatter' /excluding/ @$time@ and @$utcTime@.+varFormatter :: [(String, IO String)] -> String -> LogFormatter a+varFormatter vars format h (prio,msg) loggername = do+    outmsg <- replaceVarM (vars++[("msg", return msg)+                                 ,("prio", return $ show prio)+                                 ,("loggername", return loggername)+                                 ,("tid", show <$> myThreadId)+#ifndef mingw32_HOST_OS+                                 ,("pid", show <$> getProcessID)+#endif+                                 ]+                          ) +                  format+    return outmsg+++-- | Replace some '$' variables in a string with supplied values+replaceVarM :: [(String, IO String)] -- ^ A list of (variableName, action to get the replacement string) pairs+           -> String   -- ^ String to perform substitution on+           -> IO String   -- ^ Resulting string+replaceVarM _ [] = return []+replaceVarM keyVals (s:ss) | s=='$' = do (f,rest) <- replaceStart keyVals ss+                                         repRest <- replaceVarM keyVals rest+                                         return $ f ++ repRest+                           | otherwise = replaceVarM keyVals ss >>= return . (s:)+    where+      replaceStart [] str = return ("$",str)+      replaceStart ((k,v):kvs) str | k `isPrefixOf` str = do vs <- v+                                                             return (vs, drop (length k) str)+                                   | otherwise = replaceStart kvs str+                +

@@ -40,6 +40,7 @@                                 LogHandler(..)                                ) where import System.Log+import System.Log.Formatter import System.IO  {- | All log handlers should adhere to this. -}@@ -53,13 +54,18 @@                    setLevel :: a -> Priority -> a                    -- | Gets the current level.                    getLevel :: a -> Priority+                   -- | Set a log formatter to customize the log format for this Handler+                   setFormatter :: a -> LogFormatter a -> a+                   getFormatter :: a -> LogFormatter a+                   getFormatter h = nullFormatter                    -- | Logs an event if it meets the requirements                    -- given by the most recent call to 'setLevel'.                    handle :: a -> LogRecord -> String-> IO ()                     handle h (pri, msg) logname =                         if pri >= (getLevel h)-                          then emit h (pri, msg) logname+                          then do formattedMsg <- (getFormatter h) h (pri,msg) logname+                                  emit h (pri, formattedMsg) logname                           else return ()                    -- | Forces an event to be logged regardless of                    -- the configured level.@@ -67,6 +73,7 @@                    -- | Closes the logging system, causing it to close                    -- any open files, etc.                    close :: a -> IO ()+   

@@ -39,8 +39,10 @@ import Network.BSD import System.Log import System.Log.Handler+import System.Log.Formatter  data GrowlHandler = GrowlHandler { priority :: Priority,+                                   formatter :: LogFormatter GrowlHandler,                                    appName :: String,                                    skt :: Socket,                                    targets :: [HostAddress] }@@ -50,6 +52,9 @@     setLevel gh p = gh { priority = p }      getLevel = priority+               +    setFormatter gh f = gh { formatter = f }+    getFormatter = formatter      emit gh lr _ = let pkt = buildNotification gh nmGeneralMsg lr 		   in mapM_ (sendNote (skt gh) pkt) (targets gh)@@ -81,7 +86,7 @@              -> IO GrowlHandler growlHandler nm pri =     do { s <- socket AF_INET Datagram 0-       ; return GrowlHandler { priority = pri, appName = nm,+       ; return GrowlHandler { priority = pri, appName = nm, formatter=nullFormatter,                                skt = s, targets = [] }        } 

@@ -130,34 +130,30 @@ import System.Locale (defaultTimeLocale) import Data.Time import System.Log-import System.Log.Handler.Simple (GenericHandler (..))+import System.Log.Handler+import System.Log.Handler.Simple (streamHandler, GenericHandler(..))   -- Handler that logs to a handle rendering message priorities according -- to the supplied function. log4jHandler :: (Priority -> String) -> Handle -> Priority -> IO (GenericHandler Handle) log4jHandler showPrio h pri = do-    lock <- newMVar ()-    let mywritefunc hdl (prio, msg) loggername = withMVar lock (\_ -> do-        time   <- getCurrentTime-        thread <- myThreadId-        hPutStrLn hdl (show $ createMessage loggername time prio thread msg)-        hFlush hdl-        )-    return (GenericHandler { priority  = pri,-                             privData  = h,-                             writeFunc = mywritefunc,-                             closeFunc = \x -> return () })-    where-        -- Creates an XML element representing a log4j event/message.-        createMessage :: String -> UTCTime -> Priority -> ThreadId -> String -> XML-        createMessage logger time prio thread msg = Elem "log4j:event"-            [ ("logger"   , logger       )-            , ("timestamp", millis time  )-            , ("level"    , showPrio prio)-            , ("thread"   , show thread  )-            ]-            (Just $ Elem "log4j:message" [] (Just $ CDATA msg))+    hndlr <- streamHandler h pri+    return $ setFormatter hndlr xmlFormatter++   where+        -- A Log Formatter that creates an XML element representing a log4j event/message.+        xmlFormatter :: a -> (Priority,String) -> String -> IO String+        xmlFormatter _ (prio,msg) logger = do+              time <- getCurrentTime+              thread <- myThreadId+              return . show $ Elem "log4j:event"+                         [ ("logger"   , logger       )+                         , ("timestamp", millis time  )+                         , ("level"    , showPrio prio)+                         , ("thread"   , show thread  )+                         ]+                         (Just $ Elem "log4j:message" [] (Just $ CDATA msg))             where                 -- This is an ugly hack to get a unix epoch with milliseconds.                 -- The use of "take 3" causes the milliseconds to always be

@@ -41,20 +41,24 @@  import System.Log import System.Log.Handler+import System.Log.Formatter import System.IO import Control.Concurrent.MVar  {- | A helper data type. -}  data GenericHandler a = GenericHandler {priority :: Priority,+                                        formatter :: LogFormatter (GenericHandler a),                                         privData :: a,-                                        writeFunc :: a -> LogRecord -> String -> IO (),+                                        writeFunc :: a -> String -> IO (),                                         closeFunc :: a -> IO () }  instance LogHandler (GenericHandler a) where     setLevel sh p = sh{priority = p}     getLevel sh = priority sh-    emit sh lr loggername = (writeFunc sh) (privData sh) lr loggername+    setFormatter sh f = sh{formatter = f}+    getFormatter sh = formatter sh+    emit sh (_,msg) _ = (writeFunc sh) (privData sh) msg     close sh = (closeFunc sh) (privData sh)  @@ -66,11 +70,12 @@ streamHandler :: Handle -> Priority -> IO (GenericHandler Handle) streamHandler h pri =     do lock <- newMVar ()-       let mywritefunc hdl (_, msg) _ =+       let mywritefunc hdl msg =                withMVar lock (\_ -> do writeToHandle hdl msg                                        hFlush hdl                              )        return (GenericHandler {priority = pri,+                               formatter = nullFormatter,                                privData = h,                                writeFunc = mywritefunc,                                closeFunc = \x -> return ()})@@ -100,16 +105,6 @@ {- | Like 'streamHandler', but note the priority and logger name along with each message. -} verboseStreamHandler :: Handle -> Priority -> IO (GenericHandler Handle)-verboseStreamHandler h pri =-    do lock <- newMVar ()-       let mywritefunc hdl (prio, msg) loggername = -               withMVar lock (\_ -> do hPutStrLn hdl ("[" ++ loggername -                                                          ++ "/" ++-                                                          show prio ++-                                                          "] " ++ msg)-                                       hFlush hdl-                             )-       return (GenericHandler {priority = pri,-                               privData = h,-                               writeFunc = mywritefunc,-                               closeFunc = \x -> return ()})+verboseStreamHandler h pri = let fmt = simpleLogFormatter "[$loggername/$prio] $msg"+                             in do hndlr <- streamHandler h pri+                                   return $ setFormatter hndlr fmt

@@ -60,6 +60,7 @@                                        ) where  import System.Log+import System.Log.Formatter import System.Log.Handler import Data.Bits import Network.Socket@@ -147,7 +148,9 @@                                     identity :: String,                                     logsocket :: Socket,                                     address :: SockAddr,-                                    priority :: Priority}+                                    priority :: Priority,+                                    formatter :: LogFormatter SyslogHandler+                                   }  {- | Initialize the Syslog system using the local system's default interface, \/dev\/log.  Will return a new 'System.Log.Handler.LogHandler'.@@ -166,6 +169,8 @@  #ifdef mingw32_HOST_OS openlog = openlog_remote AF_INET "localhost" 514+#elif darwin_HOST_OS+openlog = openlog_local "/var/run/syslog" #else openlog = openlog_local "/dev/log" #endif@@ -219,39 +224,45 @@                             identity = ident,                             logsocket = sock,                             address = addr,-                            priority = pri})+                            priority = pri,+                            formatter = syslogFormatter+                          }) -instance LogHandler SyslogHandler where-    setLevel sh p = sh{priority = p}-    getLevel sh = priority sh-    emit sh (p, msg) loggername = -        let code = makeCode (facility sh) p-            getpid :: IO String-            getpid = if (elem PID (options sh))-                     then do+syslogFormatter :: LogFormatter SyslogHandler+syslogFormatter sh (p,msg) logname =+    let code = makeCode (facility sh) p+        getpid :: IO String+        getpid =  #ifndef mingw32_HOST_OS-                          pid <- getProcessID+                     getProcessID >>= return . show #else-                          let pid = "windows"+                     return "windows" #endif-                          return ("[" ++ show pid ++ "]")-                     else return ""-                     +        vars = [("code", return $ show code)+               ,("identity", return $ identity sh)+               ,("pid", getpid)]+        withPid = if (elem PID (options sh)) then "[$pid]" else ""+        format = "<$code>$identity"++withPid++": [$loggername/$prio] $msg"+    in varFormatter vars format sh (p,msg) logname+++instance LogHandler SyslogHandler where+    setLevel sh p = sh{priority = p}+    getLevel sh = priority sh+    setFormatter sh f = sh{formatter = f}+    getFormatter sh = formatter sh+    emit sh (_, msg) _ = +        let                                   sendstr :: String -> IO String             sendstr [] = return []             sendstr omsg = do                            sent <- sendTo (logsocket sh) omsg (address sh)                            sendstr (genericDrop sent omsg)-            in-            do-            pidstr <- getpid-            let outstr = "<" ++ (show code) ++ ">" -                         ++ (identity sh) ++ pidstr ++ ": "-                         ++ "[" ++ loggername ++ "/" ++ (show p) ++ "] " ++ msg-            if (elem PERROR (options sh))-               then hPutStrLn stderr outstr+        in do+          if (elem PERROR (options sh))+               then hPutStrLn stderr msg                else return ()-            sendstr (outstr ++ "\0")-            return ()+          sendstr (msg ++ "\0")+          return ()     close sh = sClose (logsocket sh) 

@@ -96,10 +96,18 @@ there will be called for every message.  You can use 'getRootLogger' to get it or 'rootLoggerName' to work with it by name. +The formatting of log messages may be customized by setting a 'LogFormatter'+on the desired 'LogHandler'.  There are a number of simple formatters defined +in "System.Log.Formatter", which may be used directly, or extend to create+your own formatter.+ Here's an example to illustrate some of these concepts:  > import System.Log.Logger > import System.Log.Handler.Syslog+> import System.Log.Handler.Simple+> import System.Log.Handler (setFormatter)+> import System.Log.Formatter >  > -- By default, all messages of level WARNING and above are sent to stderr. > -- Everything else is ignored.@@ -134,7 +142,21 @@ >  >        -- This message goes nowhere. >        debugM "MyApp.WorkingComponent" "Hello"-+>+>        -- Now we decide we'd also like to log everything from BuggyComponent at DEBUG+>        -- or higher to a file for later diagnostics.  We'd also like to customize the+>        -- format of the log message, so we use a 'simpleLogFormatter'+>+>        h <- fileHandler "debug.log" DEBUG >>= \lh -> return $+>                 setFormatter lh (simpleLogFormatter "[$time : $loggername : $prio] $msg")+>        updateGlobalLogger "MyApp.BuggyComponent" (addHandler h)+>       +>        -- This message will go to syslog and stderr, +>        -- and to the file "debug.log" with a format like :+>        -- [2010-05-23 16:47:28 : MyApp.BuggyComponent : DEBUG] Some useful diagnostics...+>        debugM "MyApp.BuggyComponent" "Some useful diagnostics..."+>+> -}  module System.Log.Logger(@@ -184,6 +206,7 @@                                ) where import System.Log import System.Log.Handler(LogHandler)+import System.Log.Formatter(LogFormatter) import qualified System.Log.Handler(handle) import System.Log.Handler.Simple import System.IO