hslogger-template 1.1.2 → 2.0.0
raw patch · 4 files changed
+67/−36 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- hslogger-template.cabal +1/−1
- src/System/Log/Logger/TH.hs +41/−26
- src/test.hs +12/−4
- src/testNamed.hs +13/−5
hslogger-template.cabal view
@@ -1,5 +1,5 @@ name: hslogger-template-version: 1.1.2+version: 2.0.0 category: Interfaces synopsis: Automatic generation of hslogger functions description: Library for generating hslogger functions using Template Haskell.
src/System/Log/Logger/TH.hs view
@@ -13,8 +13,7 @@ -- @extensions: TemplateHaskell@ in your cabal file. module System.Log.Logger.TH- (- deriveLoggers+ ( deriveLoggers , deriveNamedLoggers ) where@@ -38,20 +37,33 @@ -- Used this way, @deriveLoggers@ would generate the following functions: -- -- > infoM :: MonadIO m => String -> m ()--- > infoM s = liftIO (HSL.infoM "Foo.Bar" ((++) "Foo.Bar: " s))+-- > infoM s = liftIO (HSL.infoM "Foo.Bar" s) -- > -- > debugM :: MonadIO m => String -> m ()--- > debugM s = liftIO (HSL.debugM "Foo.Bar" ((++) "Foo.Bar: " s))+-- > debugM s = liftIO (HSL.debugM "Foo.Bar" s) -- -- The other hslogger priorities follow the same pattern. ----- So------ > infoM "hi there"------ would generate the INFO-level log event+-- /In versions prior to 2.0.0, hslogger-template generated functions that/+-- /prepended the module name to the log message. I no longer feel that this/+-- /is correct behavior. Instead, please make use of hslogger's formatting/+-- /functionality. Example:/ ----- > Foo.Bar: hi there+-- > import System.IO (stderr)+-- >+-- > import System.Log.Formatter (simpleLogFormatter)+-- > import System.Log.Logger (rootLoggerName)+-- > import System.Log.Handler (setFormatter)+-- > import System.Log.Handler.Simple (streamHandler)+-- > import System.Log.Logger.TH (deriveLoggers)+-- >+-- > import qualified System.Log.Logger as HSL+-- >+-- > $(deriveLoggers "HSL" [HSL.DEBUG, HSL.INFO])+-- >+-- > handler <- streamHandler stderr HSL.DEBUG >>= \h -> return $+-- > setFormatter h $ simpleLogFormatter "$time $loggername $prio $msg"+-- > HSL.updateGlobalLogger rootLoggerName (HSL.setLevel HSL.DEBUG . HSL.setHandlers [handler]) deriveLoggers :: String -- ^ Must match qualifier on import of "System.Log.Logger".@@ -59,24 +71,24 @@ -> TH.Q [TH.Dec] deriveLoggers qualifier priorities = fmap TH.loc_module TH.location >>= \moduleName ->- fmap concat (mapM (deriveLogger qualifier moduleName) priorities)+ fmap concat (mapM (deriveLogger qualifier moduleName Nothing) priorities) --- | Like @deriveLoggers@, but allows you to specify a message prefix. This--- could be useful if the automatically determined module name (e.g., \"Main\")--- would not be informative enough.+-- | Like @deriveLoggers@, but allows you to specify a message prefix to be+-- automatically prepended to every log message. deriveNamedLoggers- :: String -- ^ Message prefix, e.g., "SomeProgram".+ :: String -- ^ Message prefix, e.g., "SomeProgram: ". -> String -- ^ Must match qualifier on import of "System.Log.Logger". -> [HSL.Priority] -- ^ List of priorities for which to generate logging functions. -> TH.Q [TH.Dec] deriveNamedLoggers prefix qualifier priorities =- fmap concat (mapM (deriveLogger qualifier prefix) priorities)+ fmap TH.loc_module TH.location >>= \moduleName ->+ fmap concat (mapM (deriveLogger qualifier moduleName (Just prefix)) priorities) -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -deriveLogger :: String -> String -> HSL.Priority -> TH.Q [TH.Dec]-deriveLogger qualifier moduleName priority = do+deriveLogger :: String -> String -> Maybe String -> HSL.Priority -> TH.Q [TH.Dec]+deriveLogger qualifier moduleName mprefix priority = do sig <- TH.sigD thF [t| MonadIO m => String -> m () |] body <- TH.funD thF [ TH.clause@@ -90,13 +102,17 @@ (TH.varE thH) (TH.stringE moduleName) )- -- ((++) "Foo.Bar: ") s- (TH.appE- (TH.appE- (TH.varE '(++))- (TH.stringE prefix)- )- (TH.varE thS)+ (case mprefix of+ Just prefix ->+ -- (++) prefix s+ TH.appE+ (TH.appE+ (TH.varE '(++))+ (TH.stringE prefix)+ )+ (TH.varE thS)+ Nothing ->+ TH.varE thS ) ) )@@ -108,7 +124,6 @@ thF = TH.mkName functionName thS = TH.mkName "s" thH = TH.mkName (qualifier ++ "." ++ functionName)- prefix = moduleName ++ ": " functionName = case priority of HSL.DEBUG -> "debugM"
src/test.hs view
@@ -2,16 +2,24 @@ module Main (main) where -import System.Log.Logger.TH (deriveLoggers)+import System.IO (stderr)++import System.Log.Formatter (simpleLogFormatter)+import System.Log.Handler (setFormatter)+import System.Log.Handler.Simple (streamHandler)+import System.Log.Logger (rootLoggerName)+import System.Log.Logger.TH (deriveLoggers)+ import qualified System.Log.Logger as HSL $(deriveLoggers "HSL" [HSL.DEBUG, HSL.INFO, HSL.NOTICE, HSL.WARNING, HSL.ERROR, HSL.CRITICAL, HSL.ALERT, HSL.EMERGENCY]) main :: IO () main = do- HSL.updateGlobalLogger "Main" (HSL.setLevel HSL.DEBUG)- mapM_ (\(f, fn, i) -> f (show i ++ " " ++ fn)) (zip3 functions functionNames numbers)+ handler <- streamHandler stderr HSL.DEBUG >>= \h -> return $+ setFormatter h $ simpleLogFormatter "$loggername $prio $msg"+ HSL.updateGlobalLogger rootLoggerName (HSL.setLevel HSL.DEBUG . HSL.setHandlers [handler])+ mapM_ (\(f, fn) -> f fn) (zip functions functionNames) where functions = [debugM, infoM, noticeM, warningM, errorM, criticalM, alertM, emergencyM] functionNames = ["debugM", "infoM", "noticeM", "warningM", "errorM", "criticalM", "alertM", "emergencyM"]- numbers = [1..] :: [Integer]
src/testNamed.hs view
@@ -2,16 +2,24 @@ module Main (main) where -import System.Log.Logger.TH (deriveNamedLoggers)+import System.IO (stderr)++import System.Log.Formatter (simpleLogFormatter)+import System.Log.Handler (setFormatter)+import System.Log.Handler.Simple (streamHandler)+import System.Log.Logger (rootLoggerName)+import System.Log.Logger.TH (deriveNamedLoggers)+ import qualified System.Log.Logger as HSL -$(deriveNamedLoggers "testNamed" "HSL" [HSL.DEBUG, HSL.INFO, HSL.NOTICE, HSL.WARNING, HSL.ERROR, HSL.CRITICAL, HSL.ALERT, HSL.EMERGENCY])+$(deriveNamedLoggers "SomeProgram: " "HSL" [HSL.DEBUG, HSL.INFO, HSL.NOTICE, HSL.WARNING, HSL.ERROR, HSL.CRITICAL, HSL.ALERT, HSL.EMERGENCY]) main :: IO () main = do- HSL.updateGlobalLogger "testNamed" (HSL.setLevel HSL.DEBUG)- mapM_ (\(f, fn, i) -> f (show i ++ " " ++ fn)) (zip3 functions functionNames numbers)+ handler <- streamHandler stderr HSL.DEBUG >>= \h -> return $+ setFormatter h $ simpleLogFormatter "$loggername $prio $msg"+ HSL.updateGlobalLogger rootLoggerName (HSL.setLevel HSL.DEBUG . HSL.setHandlers [handler])+ mapM_ (\(f, fn) -> f fn) (zip functions functionNames) where functions = [debugM, infoM, noticeM, warningM, errorM, criticalM, alertM, emergencyM] functionNames = ["debugM", "infoM", "noticeM", "warningM", "errorM", "criticalM", "alertM", "emergencyM"]- numbers = [1..] :: [Integer]