hslogger 1.2.12 → 1.3.0.0
raw patch · 12 files changed
+255/−183 lines, 12 filesdep +bytestringdep +hsloggerdep +network-bsddep −directorydep −mtldep −processdep ~HUnitdep ~basedep ~containersnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: bytestring, hslogger, network-bsd
Dependencies removed: directory, mtl, process
Dependency ranges changed: HUnit, base, containers, network, old-locale, time, unix
API changes (from Hackage documentation)
- System.Log.Formatter: 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
+ System.Log.Formatter: 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"
- System.Log.Handler.Simple: GenericHandler :: Priority -> LogFormatter (GenericHandler a) -> a -> a -> String -> IO () -> a -> IO () -> GenericHandler a
+ System.Log.Handler.Simple: GenericHandler :: Priority -> LogFormatter (GenericHandler a) -> a -> (a -> String -> IO ()) -> (a -> IO ()) -> GenericHandler a
Files
- CHANGELOG.md +6/−0
- hslogger.cabal +82/−58
- src/System/Log.hs +0/−2
- src/System/Log/Formatter.hs +8/−8
- src/System/Log/Handler.hs +2/−9
- src/System/Log/Handler/Growl.hs +20/−16
- src/System/Log/Handler/Log4jXML.hs +5/−9
- src/System/Log/Handler/Simple.hs +2/−4
- src/System/Log/Handler/Syslog.hs +43/−36
- src/System/Log/Logger.hs +43/−37
- src/UTF8.hs +44/−0
- winbuild.bat +0/−4
+ CHANGELOG.md view
@@ -0,0 +1,6 @@+See also https://pvp.haskell.org/faq++## 1.3.0.0 *(major)*++- **[semantic change]** Messages are encoded as UTF-8 (previously the encoding was locale dependent) for the Syslog and Growl backends+- Add support for `network-3.0`; remove redundant dependency on `directory` and `process`
hslogger.cabal view
@@ -1,70 +1,94 @@-Name: hslogger-Version: 1.2.12-License: BSD3-Maintainer: John Goerzen <jgoerzen@complete.org>-Author: John Goerzen-Stability: Stable-Copyright: Copyright (c) 2004-2018 John Goerzen-license-file: LICENSE+cabal-version: 1.12 build-type: Simple-Homepage: http://software.complete.org/hslogger-Synopsis: Versatile logging framework-Description: hslogger is a logging framework for Haskell, roughly similar to- Python's logging module.+name: hslogger+version: 1.3.0.0++maintainer: hvr@gnu.org+author: John Goerzen+copyright: Copyright (c) 2004-2018 John Goerzen+ , (c) 2019 Herbert Valerio Riedel+license: BSD3+license-file: LICENSE+homepage: https://github.com/hvr/hslogger/wiki+bug-reports: https://github.com/hvr/hslogger/issues+category: Interfaces+synopsis: Versatile logging framework+description:+ @hslogger@ is a logging framework for Haskell, roughly similar+ to [Python's logging module](https://docs.python.org/2/library/logging.html). .- hslogger lets each log message have a priority and source be associated+ @hslogger@ lets each log message have a priority and source be associated with it. The programmer can then define global handlers that route- or filter messages based on the priority and source. hslogger also- has a syslog handler built in.-Category: Interfaces-extra-source-files: LICENSE,- contrib/java/build.xml,- contrib/java/hslogger4j.jar,- contrib/java/hslogger4j-plugins.xml,- contrib/java/org/haskell/hslogger/HsloggerLevel.java,- contrib/java/org/haskell/hslogger/LogFileXMLReceiver.java,- contrib/java/org/haskell/hslogger/XMLDecoder.java,- testsrc/Tests.hs,- testsrc/runtests.hs,- winbuild.bat-Cabal-Version: >= 1.8+ or filter messages based on the priority and source. @hslogger@ also+ has a [Syslog](https://tools.ietf.org/html/rfc5424) handler built in.++extra-source-files:+ LICENSE+ CHANGELOG.md+ contrib/java/build.xml+ contrib/java/hslogger4j.jar+ contrib/java/hslogger4j-plugins.xml+ contrib/java/org/haskell/hslogger/HsloggerLevel.java+ contrib/java/org/haskell/hslogger/LogFileXMLReceiver.java+ contrib/java/org/haskell/hslogger/XMLDecoder.java+ testsrc/Tests.hs+ testsrc/runtests.hs++tested-with:+ GHC ==7.0.4 || ==7.2.2 || ==7.4.2 || ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.4+ source-repository head type: git- location: git@github.com:jgoerzen/hslogger.git+ location: http://github.com/hvr/hslogger.git -flag small_base- description: choose the new smaller, split-up base package.-flag buildtests- description: Build the executable to run unit tests- default: False+flag network--GT-3_0_0+ description: [network](http://hackage.haskell.org/package/network) ≥ 3.0.0+ default: True+ manual: False -Library- Exposed-Modules:- System.Log, System.Log.Handler, System.Log.Formatter,- System.Log.Handler.Simple, System.Log.Handler.Syslog,- System.Log.Handler.Growl, System.Log.Handler.Log4jXML,+library+ hs-source-dirs: src+ exposed-modules:+ 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- Extensions: CPP, ExistentialQuantification- Build-Depends: network, mtl- if !os(windows)- Build-Depends: unix- if flag(small_base)- build-depends: base >= 4 && < 5, containers, directory, process,- time, old-locale+ other-modules:+ UTF8++ default-language: Haskell2010+ other-extensions: CPP ExistentialQuantification++ build-depends:+ base >= 4.3 && < 4.13+ , bytestring >= 0.9 && < 0.11+ , containers >= 0.4 && < 0.7+ , time >= 1.2 && < 1.10+ , old-locale >= 1.0 && < 1.1++ if flag(network--GT-3_0_0)+ build-depends: network-bsd >= 2.8.1 && <2.9,+ network >= 3.0 && <3.1 else- build-depends: base < 3, time- -- GHC-Options: -O2- Hs-Source-Dirs: src+ build-depends: network >= 2.6 && <2.9 + if !os(windows)+ Build-Depends: unix >= 2.4.2 && < 2.8++ test-suite runtests type: exitcode-stdio-1.0- if flag(buildtests)- Buildable: True- else- Buildable: False- Main-Is: runtests.hs- HS-Source-Dirs: testsrc, ., src- Extensions: ExistentialQuantification, OverlappingInstances,- UndecidableInstances, CPP- build-depends: base- , HUnit++ hs-source-dirs: testsrc+ main-is: runtests.hs+ other-modules: Tests++ default-language: Haskell2010+ build-depends:+ base+ , HUnit == 1.3.* || == 1.6.*+ , hslogger
src/System/Log.hs view
@@ -3,8 +3,6 @@ Copyright : Copyright (C) 2004-2011 John Goerzen License : BSD3 - Maintainer : John Goerzen <jgoerzen@complete.org> - Stability : experimental Portability: portable Haskell Logging Framework
src/System/Log/Formatter.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {- Copyright (c) 2005-2011 John Goerzen License: BSD3@@ -40,7 +42,7 @@ -- | 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 +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@@ -51,7 +53,7 @@ -- | 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 +-- a $-sign which will be replaced at runtime with corresponding values. The -- currently supported variables are: -- -- * @$msg@ - The actual log message@@ -64,11 +66,11 @@ -- -- * @$pid@ - Process ID (Not available on windows) ----- * @$time@ - The current time +-- * @$time@ - The current time -- -- * @$utcTime@ - The current time in UTC Time simpleLogFormatter :: String -> LogFormatter a-simpleLogFormatter format h (prio, msg) loggername = +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@@ -85,7 +87,7 @@ -- 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+varFormatter vars format _h (prio,msg) loggername = do outmsg <- replaceVarM (vars++[("msg", return msg) ,("prio", return $ show prio) ,("loggername", return loggername)@@ -94,7 +96,7 @@ ,("pid", show <$> getProcessID) #endif ]- ) + ) format return outmsg @@ -113,5 +115,3 @@ 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
@@ -3,8 +3,6 @@ Copyright : Copyright (C) 2004-2011 John Goerzen License : BSD3 - Maintainer : John Goerzen <jgoerzen@complete.org> - Stability : provisional Portability: portable Definition of log handler support@@ -23,7 +21,6 @@ ) where import System.Log import System.Log.Formatter-import System.IO {- | All log handlers should adhere to this. -} @@ -39,12 +36,12 @@ -- | Set a log formatter to customize the log format for this Handler setFormatter :: a -> LogFormatter a -> a getFormatter :: a -> LogFormatter a- getFormatter h = nullFormatter+ getFormatter _ = 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 = + handle h (pri, msg) logname = if pri >= (getLevel h) then do formattedMsg <- (getFormatter h) h (pri,msg) logname emit h (pri, formattedMsg) logname@@ -55,7 +52,3 @@ -- | Closes the logging system, causing it to close -- any open files, etc. close :: a -> IO ()----
src/System/Log/Handler/Growl.hs view
@@ -3,8 +3,6 @@ Copyright : Copyright (C) 2007-2011 John Goerzen <jgoerzen@complete.org> License : BSD3 - Maintainer : Richard M. Neswold, Jr. <rich.neswold@gmail.com>- Stability : provisional Portability: portable Simple log handlers@@ -17,24 +15,30 @@ import Data.Char import Data.Word-import Network.Socket-import Network.BSD+import qualified Network.Socket as S+import qualified Network.Socket.ByteString as SBS+import qualified Network.BSD as S import System.Log import System.Log.Handler import System.Log.Formatter +import UTF8++sendTo :: S.Socket -> String -> S.SockAddr -> IO Int+sendTo s str = SBS.sendTo s (toUTF8BS str)+ data GrowlHandler = GrowlHandler { priority :: Priority, formatter :: LogFormatter GrowlHandler, appName :: String,- skt :: Socket,- targets :: [HostAddress] }+ skt :: S.Socket,+ targets :: [S.HostAddress] } instance LogHandler GrowlHandler where setLevel gh p = gh { priority = p } getLevel = priority- + setFormatter gh f = gh { formatter = f } getFormatter = formatter @@ -44,10 +48,10 @@ close gh = let pkt = buildNotification gh nmClosingMsg (WARNING, "Connection closing.") s = skt gh- in mapM_ (sendNote s pkt) (targets gh) >> sClose s+ in mapM_ (sendNote s pkt) (targets gh) >> S.close s -sendNote :: Socket -> String -> HostAddress -> IO Int-sendNote s pkt ha = sendTo s pkt (SockAddrInet 9887 ha)+sendNote :: S.Socket -> String -> S.HostAddress -> IO Int+sendNote s pkt ha = sendTo s pkt (S.SockAddrInet 9887 ha) -- Right now there are two "notification names": "message" and -- "disconnecting". All log messages are sent using the "message"@@ -67,7 +71,7 @@ -> Priority -- ^ Priority of handler -> IO GrowlHandler growlHandler nm pri =- do { s <- socket AF_INET Datagram 0+ do { s <- S.socket S.AF_INET S.Datagram 0 ; return GrowlHandler { priority = pri, appName = nm, formatter=nullFormatter, skt = s, targets = [] } }@@ -102,11 +106,11 @@ packet to the machine. This function will throw an exception if the host name cannot be found. -} -addTarget :: HostName -> GrowlHandler -> IO GrowlHandler-addTarget hn gh = do { he <- getHostByName hn- ; let ha = hostAddress he- sa = SockAddrInet 9887 ha- in do { sendTo (skt gh) (buildRegistration gh) sa+addTarget :: S.HostName -> GrowlHandler -> IO GrowlHandler+addTarget hn gh = do { he <- S.getHostByName hn+ ; let ha = S.hostAddress he+ sa = S.SockAddrInet 9887 ha+ in do { _ <- sendTo (skt gh) (buildRegistration gh) sa ; return gh { targets = ha:(targets gh) } } } -- Converts a Priority type into the subset of integers needed in the
src/System/Log/Handler/Log4jXML.hs view
@@ -4,8 +4,6 @@ Copyright : Copyright (C) 2007-2011 John Goerzen License : BSD3 - Maintainer : bjorn.buckwalter@gmail.com- Stability : experimental Portability: GHC only? log4j[1] XMLLayout log handlers.@@ -14,8 +12,8 @@ -} -module System.Log.Handler.Log4jXML ( - +module System.Log.Handler.Log4jXML (+ -- * Introduction {- | This module provides handlers for hslogger that are@@ -35,10 +33,10 @@ 'System.Log.Handler.Simple.FileHandler' in "System.Log.Handler.Simple". The following handlers are provided: -} - -- ** Handlers with hslogger levels + -- ** Handlers with hslogger levels log4jStreamHandler, log4jFileHandler,- + -- ** Handlers with log4j levels log4jStreamHandler', log4jFileHandler'@@ -106,8 +104,7 @@ ) where -import Control.Concurrent (ThreadId, myThreadId) -- myThreadId is GHC only!-import Control.Concurrent.MVar+import Control.Concurrent (myThreadId) -- myThreadId is GHC only! import Data.List (isPrefixOf) import System.IO #if MIN_VERSION_time(1,5,0)@@ -222,4 +219,3 @@ replace _ _ [ ] = [] replace from to xs@(a:as) = if isPrefixOf from xs then to ++ drop (length from) xs else a : replace from to as-
src/System/Log/Handler/Simple.hs view
@@ -3,8 +3,6 @@ Copyright : Copyright (C) 2004-2011 John Goerzen License : BSD3 - Maintainer : John Goerzen <jgoerzen@complete.org>- Stability : provisional Portability: portable Simple log handlers@@ -17,7 +15,7 @@ verboseStreamHandler) where -import Control.Exception (SomeException, tryJust)+import Control.Exception (tryJust) import Data.Char (ord) import System.Log@@ -60,7 +58,7 @@ formatter = nullFormatter, privData = h, writeFunc = mywritefunc,- closeFunc = \x -> return ()})+ closeFunc = \_ -> return ()}) where writeToHandle hdl msg = do rv <- tryJust myException (hPutStrLn hdl msg)
src/System/Log/Handler/Syslog.hs view
@@ -5,8 +5,6 @@ Copyright : Copyright (C) 2004-2011 John Goerzen License : BSD3 - Maintainer : John Goerzen <jgoerzen@complete.org> - Stability : provisional Portability: portable Syslog handler for the Haskell Logging Framework@@ -48,15 +46,24 @@ import System.Log.Formatter import System.Log.Handler import Data.Bits-import Network.Socket as S-import Network.BSD-import Data.List+import qualified Network.Socket as S+import qualified Network.Socket.ByteString as SBS+import qualified Network.BSD as S+import Data.List (genericDrop) #ifndef mingw32_HOST_OS import System.Posix.Process(getProcessID) #endif import System.IO import Control.Monad (void, when) +import UTF8++send :: S.Socket -> String -> IO Int+send s = SBS.send s . toUTF8BS++sendTo :: S.Socket -> String -> S.SockAddr -> IO Int+sendTo s str = SBS.sendTo s (toUTF8BS str)+ code_of_pri :: Priority -> Int code_of_pri p = case p of EMERGENCY -> 0@@ -71,7 +78,7 @@ {- | Facilities are used by the system to determine where messages are sent. -} -data Facility = +data Facility = KERN -- ^ Kernel messages; you should likely never use this in your programs | USER -- ^ General userland messages. Use this if nothing else is appropriate | MAIL -- ^ E-Mail system@@ -132,9 +139,9 @@ data SyslogHandler = SyslogHandler {options :: [Option], facility :: Facility, identity :: String,- logsocket :: Socket,- address :: SockAddr,- sock_type :: SocketType,+ logsocket :: S.Socket,+ address :: S.SockAddr,+ sock_type :: S.SocketType, priority :: Priority, formatter :: LogFormatter SyslogHandler }@@ -155,7 +162,7 @@ -> IO SyslogHandler -- ^ Returns the new handler #ifdef mingw32_HOST_OS-openlog = openlog_remote AF_INET "localhost" 514+openlog = openlog_remote S.AF_INET "localhost" 514 #elif darwin_HOST_OS openlog = openlog_local "/var/run/syslog" #else@@ -174,53 +181,53 @@ -> Facility -- ^ Facility value -> Priority -- ^ Priority limit -> IO SyslogHandler-openlog_local fifopath ident options fac pri =+openlog_local fifopath ident options' fac pri = do (s, t) <- do -- "/dev/log" is usually Datagram, -- but most of syslog loggers allow it to be -- of Stream type. glibc's" openlog()" -- does roughly the similar thing: -- http://www.gnu.org/software/libc/manual/html_node/openlog.html - s <- socket AF_UNIX Stream 0+ s <- S.socket S.AF_UNIX S.Stream 0 tryStream s `E.catch` (onIOException (fallbackToDgram s))- openlog_generic s (SockAddrUnix fifopath) t ident options fac pri+ openlog_generic s (S.SockAddrUnix fifopath) t ident options' fac pri where onIOException :: IO a -> E.IOException -> IO a onIOException a _ = a - tryStream :: Socket -> IO (Socket, SocketType)+ tryStream :: S.Socket -> IO (S.Socket, S.SocketType) tryStream s =- do connect s (SockAddrUnix fifopath)- return (s, Stream)+ do S.connect s (S.SockAddrUnix fifopath)+ return (s, S.Stream) - fallbackToDgram :: Socket -> IO (Socket, SocketType)+ fallbackToDgram :: S.Socket -> IO (S.Socket, S.SocketType) fallbackToDgram s =- do S.sClose s -- close Stream variant- d <- socket AF_UNIX Datagram 0- return (d, Datagram)+ do S.close s -- close Stream variant+ d <- S.socket S.AF_UNIX S.Datagram 0+ return (d, S.Datagram) #endif {- | Log to a remote server via UDP. -}-openlog_remote :: Family -- ^ Usually AF_INET or AF_INET6; see Network.Socket- -> HostName -- ^ Remote hostname. Some use @localhost@- -> PortNumber -- ^ 514 is the default for syslog+openlog_remote :: S.Family -- ^ Usually AF_INET or AF_INET6; see Network.Socket+ -> S.HostName -- ^ Remote hostname. Some use @localhost@+ -> S.PortNumber -- ^ 514 is the default for syslog -> String -- ^ Program name -> [Option] -- ^ 'Option's -> Facility -- ^ Facility value -> Priority -- ^ Priority limit -> IO SyslogHandler-openlog_remote fam hostname port ident options fac pri =+openlog_remote fam hostname port ident options' fac pri = do- he <- getHostByName hostname- s <- socket fam Datagram 0- let addr = SockAddrInet port (head (hostAddresses he))- openlog_generic s addr Datagram ident options fac pri+ he <- S.getHostByName hostname+ s <- S.socket fam S.Datagram 0+ let addr = S.SockAddrInet port (head (S.hostAddresses he))+ openlog_generic s addr S.Datagram ident options' fac pri {- | The most powerful initialization mechanism. Takes an open datagram socket. -}-openlog_generic :: Socket -- ^ A datagram socket- -> SockAddr -- ^ Address for transmissions- -> SocketType -- ^ socket connection mode (stream / datagram)+openlog_generic :: S.Socket -- ^ A datagram socket+ -> S.SockAddr -- ^ Address for transmissions+ -> S.SocketType -- ^ socket connection mode (stream / datagram) -> String -- ^ Program name -> [Option] -- ^ 'Option's -> Facility -- ^ Facility value@@ -257,11 +264,11 @@ sendstr [] = return [] sendstr omsg = do sent <- case sock_type sh of- Datagram -> sendTo (logsocket sh) omsg (address sh)- Stream -> send (logsocket sh) omsg+ S.Datagram -> sendTo (logsocket sh) omsg (address sh)+ S.Stream -> send (logsocket sh) omsg sendstr (genericDrop sent omsg)- toSyslogFormat msg pidPart =- "<" ++ code ++ ">" ++ identity' ++ pidPart ++ ": " ++ msg ++ "\0"+ toSyslogFormat msg' pidPart =+ "<" ++ code ++ ">" ++ identity' ++ pidPart ++ ": " ++ msg' ++ "\0" code = show $ makeCode (facility sh) prio identity' = identity sh getPidPart = if elem PID (options sh)@@ -275,4 +282,4 @@ return "windows" #endif - close sh = sClose (logsocket sh)+ close sh = S.close (logsocket sh)
src/System/Log/Logger.hs view
@@ -1,10 +1,10 @@+{-# LANGUAGE CPP, ExistentialQuantification #-}+ {- | Module : System.Log.Logger Copyright : Copyright (C) 2004-2011 John Goerzen License : BSD3 - Maintainer : John Goerzen <jgoerzen@complete.org> - Stability : provisional Portability: portable Haskell Logging Framework, Primary Interface@@ -22,7 +22,7 @@ Therefore, a 'Logger' named \"foo\" is the parent of loggers \"foo.printing\", \"foo.html\", and \"foo.io\". These names can be anything you want. They're used to indicate the area of an application or library in which a logged-message originates. Later you will see how you can use this concept to +message originates. Later you will see how you can use this concept to fine-tune logging behaviors based on specific application areas. You can also tune logging behaviors based upon how important a message is.@@ -31,7 +31,7 @@ some convenient functions that correspond to these importance levels: 'debugM' through 'emergencyM' log messages with the specified importance. -Now, an importance level (or 'Priority') +Now, an importance level (or 'Priority') is associated not just with a particular message but also with a 'Logger'. If the 'Priority' of a given log message is lower than the 'Priority' configured in the 'Logger', that message is ignored. This@@ -78,7 +78,7 @@ 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 +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. @@ -89,27 +89,27 @@ > 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.-> +> > -- "MyApp.Component" is an arbitrary string; you can tune > -- logging behavior based on it later. > main = do > debugM "MyApp.Component" "This is a debug message -- never to be seen" > warningM "MyApp.Component2" "Something Bad is about to happen."-> +> > -- Copy everything to syslog from here on out. > s <- openlog "SyslogStuff" [PID] USER DEBUG > updateGlobalLogger rootLoggerName (addHandler s)-> +> > errorM "MyApp.Component" "This is going to stderr and syslog." > > -- Now we'd like to see everything from BuggyComponent > -- at DEBUG or higher go to syslog and stderr. > -- Also, we'd like to still ignore things less than > -- WARNING in other areas.-> -- +> -- > -- So, we adjust the Logger for MyApp.BuggyComponent. > > updateGlobalLogger "MyApp.BuggyComponent"@@ -117,10 +117,10 @@ > > -- This message will go to syslog and stderr > debugM "MyApp.BuggyComponent" "This buggy component is buggy"-> +> > -- This message will go to syslog and stderr too. > warningM "MyApp.BuggyComponent" "Still Buggy"-> +> > -- This message goes nowhere. > debugM "MyApp.WorkingComponent" "Hello" >@@ -131,8 +131,8 @@ > 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, +>+> -- 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..."@@ -188,7 +188,7 @@ ) where import System.Log import System.Log.Handler(LogHandler, close)-import System.Log.Formatter(LogFormatter)+import System.Log.Formatter(LogFormatter) -- for Haddock import qualified System.Log.Handler(handle) import System.Log.Handler.Simple import System.IO@@ -198,7 +198,7 @@ import Data.Maybe import qualified Data.Map as Map import qualified Control.Exception-import Control.Monad.Error+ --------------------------------------------------------------------------- -- Basic logger types ---------------------------------------------------------------------------@@ -227,36 +227,36 @@ -- Logger Tree Storage --------------------------------------------------------------------------- --- | The log tree. Initialize it with a default root logger +-- | The log tree. Initialize it with a default root logger -- and (FIXME) a logger for MissingH itself. {-# NOINLINE logTree #-} logTree :: MVar LogTree -- note: only kick up tree if handled locally-logTree = +logTree = unsafePerformIO $ do h <- streamHandler stderr DEBUG- newMVar (Map.singleton rootLoggerName (Logger + newMVar (Map.singleton rootLoggerName (Logger {level = Just WARNING, name = "", handlers = [HandlerT h]})) {- | Given a name, return all components of it, starting from the root.-Example return value: +Example return value: >["", "MissingH", "System.Cmd.Utils", "System.Cmd.Utils.pOpen"] -} componentsOfName :: String -> [String]-componentsOfName name =+componentsOfName name' = let joinComp [] _ = [] joinComp (x:xs) [] = x : joinComp xs x joinComp (x:xs) accum = let newlevel = accum ++ "." ++ x in newlevel : joinComp xs newlevel in- rootLoggerName : joinComp (split "." name) []+ rootLoggerName : joinComp (split "." name') [] --------------------------------------------------------------------------- -- Logging With Location@@ -347,7 +347,7 @@ createLoggers (x:xs) lt = -- Add logger to tree if Map.member x lt then createLoggers xs lt- else createLoggers xs + else createLoggers xs (Map.insert x (defaultLogger {name=x}) lt) defaultLogger = Logger Nothing [] undefined @@ -362,31 +362,31 @@ -- | Handle a log request. handle :: Logger -> LogRecord -> IO ()-handle l (pri, msg) = +handle l (pri, msg) = let parentLoggers :: String -> IO [Logger] parentLoggers [] = return []- parentLoggers name = - let pname = (head . drop 1 . reverse . componentsOfName) name- in + parentLoggers name' =+ let pname = (head . drop 1 . reverse . componentsOfName) name'+ in do parent <- getLogger pname next <- parentLoggers pname return (parent : next) parentHandlers :: String -> IO [HandlerT]- parentHandlers name = parentLoggers name >>= (return . concatMap handlers)+ parentHandlers name' = parentLoggers name' >>= (return . concatMap handlers) -- Get the priority we should use. Find the first logger in the tree, -- starting here, with a set priority. If even root doesn't have one, -- assume DEBUG. getLoggerPriority :: String -> IO Priority- getLoggerPriority name =- do pl <- parentLoggers name+ getLoggerPriority name' =+ do pl <- parentLoggers name' case catMaybes . map level $ (l : pl) of [] -> return DEBUG (x:_) -> return x in do lp <- getLoggerPriority (name l) if pri >= lp- then do + then do ph <- parentHandlers (name l) sequence_ (handlerActions (ph ++ (handlers l)) (pri, msg) (name l))@@ -429,7 +429,7 @@ -- | Set the 'Logger'\'s list of handlers to the list supplied. -- All existing handlers are removed first. setHandlers :: LogHandler a => [a] -> Logger -> Logger-setHandlers hl l = +setHandlers hl l = l{handlers = map (\h -> HandlerT h) hl} -- | Returns the "level" of the logger. Items beneath this@@ -454,7 +454,7 @@ -- account any changes you may have made. saveGlobalLogger :: Logger -> IO ()-saveGlobalLogger l = modifyMVar_ logTree +saveGlobalLogger l = modifyMVar_ logTree (\lt -> return $ Map.insert (name l) l lt) {- | Helps you make changes on the given logger. Takes a function@@ -476,10 +476,17 @@ removeAllHandlers :: IO () removeAllHandlers = modifyMVar_ logTree $ \lt -> do- let allHandlers = Map.foldr (\l r -> concat [r, handlers l]) [] lt+ let allHandlers = mapFoldr (\l r -> concat [r, handlers l]) [] lt mapM_ (\(HandlerT h) -> close h) allHandlers return $ Map.map (\l -> l {handlers = []}) lt +mapFoldr :: (a -> b -> b) -> b -> Map.Map k a -> b+#if MIN_VERSION_containers(0,4,2)+mapFoldr = Map.foldr+#else+mapFoldr f z = foldr f z . Map.elems+#endif+ {- | Traps exceptions that may occur, logging them, then passing them on. Takes a logger name, priority, leading description text (you can set it to@@ -491,13 +498,13 @@ -> String -- Descriptive text to prepend to logged messages -> IO a -- Action to run -> IO a -- Return value-traplogging logger priority desc action =+traplogging logger priority' desc action = let realdesc = case desc of "" -> "" x -> x ++ ": " handler :: Control.Exception.SomeException -> IO a handler e = do- logM logger priority (realdesc ++ (show e))+ logM logger priority' (realdesc ++ (show e)) Control.Exception.throw e -- Re-raise it in Control.Exception.catch action handler@@ -528,4 +535,3 @@ then (x:ys,zs) else ([],list) where (ys,zs) = spanList func xs-
+ src/UTF8.hs view
@@ -0,0 +1,44 @@+-- Internal module to support UTF8+module UTF8 (toUTF8BS) where++import Data.Char (ord)+import Data.Bits+import Data.Word (Word8)+import qualified Data.ByteString as BS++toUTF8BS :: String -> BS.ByteString+toUTF8BS = BS.pack . encodeStringUtf8++-- | Encode 'String' to a list of UTF8-encoded octets+--+-- Code-points in the @U+D800@-@U+DFFF@ range will be encoded+-- as the replacement character (i.e. @U+FFFD@).+--+-- The code is extracted from Cabal library, written originally HVR+encodeStringUtf8 :: String -> [Word8]+encodeStringUtf8 [] = []+encodeStringUtf8 (c:cs)+ | c <= '\x07F' = w8+ : encodeStringUtf8 cs+ | c <= '\x7FF' = (0xC0 .|. w8ShiftR 6 )+ : (0x80 .|. (w8 .&. 0x3F))+ : encodeStringUtf8 cs+ | c <= '\xD7FF'= (0xE0 .|. w8ShiftR 12 )+ : (0x80 .|. (w8ShiftR 6 .&. 0x3F))+ : (0x80 .|. (w8 .&. 0x3F))+ : encodeStringUtf8 cs+ | c <= '\xDFFF'= 0xEF : 0xBF : 0xBD -- U+FFFD+ : encodeStringUtf8 cs+ | c <= '\xFFFF'= (0xE0 .|. w8ShiftR 12 )+ : (0x80 .|. (w8ShiftR 6 .&. 0x3F))+ : (0x80 .|. (w8 .&. 0x3F))+ : encodeStringUtf8 cs+ | otherwise = (0xf0 .|. w8ShiftR 18 )+ : (0x80 .|. (w8ShiftR 12 .&. 0x3F))+ : (0x80 .|. (w8ShiftR 6 .&. 0x3F))+ : (0x80 .|. (w8 .&. 0x3F))+ : encodeStringUtf8 cs+ where+ w8 = fromIntegral (ord c) :: Word8+ w8ShiftR :: Int -> Word8+ w8ShiftR = fromIntegral . shiftR (ord c)
− winbuild.bat
@@ -1,4 +0,0 @@-ghc -package Cabal Setup.hs -o setup.exe -setup configure -setup build -