hslogger 1.0.11 → 1.0.12
raw patch · 8 files changed
+68/−214 lines, 8 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- System.Log.Formatter: nullFormatter :: LogFormatter a
- System.Log.Formatter: simpleLogFormatter :: String -> LogFormatter a
- System.Log.Formatter: tfLogFormatter :: String -> String -> LogFormatter a
- System.Log.Formatter: type LogFormatter a = a -> LogRecord -> String -> IO String
- System.Log.Formatter: varFormatter :: [(String, IO String)] -> String -> LogFormatter a
- System.Log.Handler: getFormatter :: (LogHandler a) => a -> LogFormatter a
- System.Log.Handler: setFormatter :: (LogHandler a) => a -> LogFormatter a -> a
- System.Log.Handler.Simple: formatter :: GenericHandler a -> LogFormatter (GenericHandler a)
- System.Log.Handler.Simple: GenericHandler :: Priority -> LogFormatter (GenericHandler a) -> a -> (a -> String -> IO ()) -> (a -> IO ()) -> GenericHandler a
+ System.Log.Handler.Simple: GenericHandler :: Priority -> a -> (a -> LogRecord -> String -> IO ()) -> (a -> IO ()) -> GenericHandler a
- System.Log.Handler.Simple: writeFunc :: GenericHandler a -> a -> String -> IO ()
+ System.Log.Handler.Simple: writeFunc :: GenericHandler a -> a -> LogRecord -> String -> IO ()
Files
- hslogger.cabal +2/−2
- src/System/Log/Formatter.hs +0/−109
- src/System/Log/Handler.hs +1/−8
- src/System/Log/Handler/Growl.hs +1/−6
- src/System/Log/Handler/Log4jXML.hs +22/−18
- src/System/Log/Handler/Simple.hs +16/−11
- src/System/Log/Handler/Syslog.hs +25/−36
- src/System/Log/Logger.hs +1/−24
hslogger.cabal view
@@ -1,5 +1,5 @@ Name: hslogger-Version: 1.0.11+Version: 1.0.12 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.Formatter,+ System.Log, System.Log.Handler, System.Log.Handler.Simple, System.Log.Handler.Syslog, System.Log.Handler.Growl, System.Log.Handler.Log4jXML, System.Log.Logger
− src/System/Log/Formatter.hs
@@ -1,109 +0,0 @@-{- |--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- -
src/System/Log/Handler.hs view
@@ -40,7 +40,6 @@ LogHandler(..) ) where import System.Log-import System.Log.Formatter import System.IO {- | All log handlers should adhere to this. -}@@ -54,18 +53,13 @@ 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 do formattedMsg <- (getFormatter h) h (pri,msg) logname- emit h (pri, formattedMsg) logname+ then emit h (pri, msg) logname else return () -- | Forces an event to be logged regardless of -- the configured level.@@ -73,7 +67,6 @@ -- | Closes the logging system, causing it to close -- any open files, etc. close :: a -> IO ()-
src/System/Log/Handler/Growl.hs view
@@ -39,10 +39,8 @@ 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] }@@ -52,9 +50,6 @@ 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)@@ -86,7 +81,7 @@ -> IO GrowlHandler growlHandler nm pri = do { s <- socket AF_INET Datagram 0- ; return GrowlHandler { priority = pri, appName = nm, formatter=nullFormatter,+ ; return GrowlHandler { priority = pri, appName = nm, skt = s, targets = [] } }
src/System/Log/Handler/Log4jXML.hs view
@@ -130,30 +130,34 @@ import System.Locale (defaultTimeLocale) import Data.Time import System.Log-import System.Log.Handler-import System.Log.Handler.Simple (streamHandler, GenericHandler(..))+import System.Log.Handler.Simple (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- 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))+ 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)) where -- This is an ugly hack to get a unix epoch with milliseconds. -- The use of "take 3" causes the milliseconds to always be
src/System/Log/Handler/Simple.hs view
@@ -41,24 +41,20 @@ 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 -> String -> IO (),+ writeFunc :: a -> LogRecord -> String -> IO (), closeFunc :: a -> IO () } instance LogHandler (GenericHandler a) where setLevel sh p = sh{priority = p} getLevel sh = priority sh- setFormatter sh f = sh{formatter = f}- getFormatter sh = formatter sh- emit sh (_,msg) _ = (writeFunc sh) (privData sh) msg+ emit sh lr loggername = (writeFunc sh) (privData sh) lr loggername close sh = (closeFunc sh) (privData sh) @@ -70,12 +66,11 @@ 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 ()})@@ -105,6 +100,16 @@ {- | Like 'streamHandler', but note the priority and logger name along with each message. -} verboseStreamHandler :: Handle -> Priority -> IO (GenericHandler Handle)-verboseStreamHandler h pri = let fmt = simpleLogFormatter "[$loggername/$prio] $msg"- in do hndlr <- streamHandler h pri- return $ setFormatter hndlr fmt+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 ()})
src/System/Log/Handler/Syslog.hs view
@@ -60,7 +60,6 @@ ) where import System.Log-import System.Log.Formatter import System.Log.Handler import Data.Bits import Network.Socket@@ -148,9 +147,7 @@ identity :: String, logsocket :: Socket, address :: SockAddr,- priority :: Priority,- formatter :: LogFormatter SyslogHandler- }+ priority :: Priority} {- | Initialize the Syslog system using the local system's default interface, \/dev\/log. Will return a new 'System.Log.Handler.LogHandler'.@@ -169,8 +166,6 @@ #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@@ -224,45 +219,39 @@ identity = ident, logsocket = sock, address = addr,- priority = pri,- formatter = syslogFormatter- })--syslogFormatter :: LogFormatter SyslogHandler-syslogFormatter sh (p,msg) logname =- let code = makeCode (facility sh) p- getpid :: IO String- getpid = -#ifndef mingw32_HOST_OS- getProcessID >>= return . show-#else- return "windows"-#endif- 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-+ priority = pri}) 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 + emit sh (p, msg) loggername = + let code = makeCode (facility sh) p+ getpid :: IO String+ getpid = if (elem PID (options sh))+ then do+#ifndef mingw32_HOST_OS+ pid <- getProcessID+#else+ let pid = "windows"+#endif+ return ("[" ++ show pid ++ "]")+ else return ""+ sendstr :: String -> IO String sendstr [] = return [] sendstr omsg = do sent <- sendTo (logsocket sh) omsg (address sh) sendstr (genericDrop sent omsg)- in do- if (elem PERROR (options sh))- then hPutStrLn stderr msg+ in+ do+ pidstr <- getpid+ let outstr = "<" ++ (show code) ++ ">" + ++ (identity sh) ++ pidstr ++ ": "+ ++ "[" ++ loggername ++ "/" ++ (show p) ++ "] " ++ msg+ if (elem PERROR (options sh))+ then hPutStrLn stderr outstr else return ()- sendstr (msg ++ "\0")- return ()+ sendstr (outstr ++ "\0")+ return () close sh = sClose (logsocket sh)
src/System/Log/Logger.hs view
@@ -96,18 +96,10 @@ 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.@@ -142,21 +134,7 @@ > > -- 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(@@ -206,7 +184,6 @@ ) 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