hslogger-template 1.1.0 → 2.0.4
raw patch · 4 files changed
Files
- hslogger-template.cabal +3/−4
- src/System/Log/Logger/TH.hs +55/−39
- src/test.hs +12/−4
- src/testNamed.hs +13/−5
hslogger-template.cabal view
@@ -1,5 +1,5 @@ name: hslogger-template-version: 1.1.0+version: 2.0.4 category: Interfaces synopsis: Automatic generation of hslogger functions description: Library for generating hslogger functions using Template Haskell.@@ -21,10 +21,9 @@ System.Log.Logger.TH build-depends:- base >= 3 && < 5,- haskell98 == 1.*,+ base >= 3.0 && < 5.0, hslogger == 1.*,- mtl == 1.*,+ mtl >= 1.1 && < 2.3, template-haskell == 2.* ghc-options: -Wall
src/System/Log/Logger/TH.hs view
@@ -1,10 +1,19 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskell, ExplicitForAll #-} -- | This module provides functions that generate hslogger functions using--- Template Haskell.+-- Template Haskell.+--+-- Notes:+--+-- * "System.Log.Logger" must be imported qualified, and the qualifier must+-- match the qualifier given to @deriveLoggers@ and/or @deriveNamedLoggers@.+--+-- * Don't forget to enable Template Haskell preprocessing: specify the pragma+-- @LANGUAGE TemplateHaskell@ at the top of your source file or+-- @extensions: TemplateHaskell@ in your cabal file.+ module System.Log.Logger.TH- (- deriveLoggers+ ( deriveLoggers , deriveNamedLoggers ) where@@ -28,33 +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------ > Foo.Bar: hi there------ If the automatically determined module name would not be informative enough--- (e.g., "Main"), @deriveNamedLoggers@ allows you to specify a different--- message prefix.------ Notes:------ * "System.Log.Logger" must be imported qualified, and the qualifier must--- match the qualifier given to @deriveLoggers@.+-- /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:/ ----- * Don't forget to enable Template Haskell preprocessing: specify the--- pragma @LANGUAGE TemplateHaskell@ at the top of your source file or--- @extensions: TemplateHaskell@ in your cabal file.+-- > 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".@@ -62,21 +71,25 @@ -> 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 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- sig <- TH.sigD thF [t| MonadIO m => String -> m () |]+deriveLogger :: String -> String -> Maybe String -> HSL.Priority -> TH.Q [TH.Dec]+deriveLogger qualifier moduleName mprefix priority = do+ sig <- TH.sigD thF [t| forall m. MonadIO m => String -> m () |] body <- TH.funD thF [ TH.clause [TH.varP thS]@@ -89,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 ) ) )@@ -107,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]