diff --git a/hslogger-template.cabal b/hslogger-template.cabal --- a/hslogger-template.cabal +++ b/hslogger-template.cabal @@ -1,5 +1,5 @@ name: hslogger-template -version: 1.1.2 +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.* || == 2.0.*, + mtl >= 1.1 && < 2.3, template-haskell == 2.* ghc-options: -Wall diff --git a/src/System/Log/Logger/TH.hs b/src/System/Log/Logger/TH.hs --- a/src/System/Log/Logger/TH.hs +++ b/src/System/Log/Logger/TH.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, ExplicitForAll #-} -- | This module provides functions that generate hslogger functions using -- Template Haskell. @@ -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,25 +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. 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 - 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] @@ -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" diff --git a/src/test.hs b/src/test.hs --- a/src/test.hs +++ b/src/test.hs @@ -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] diff --git a/src/testNamed.hs b/src/testNamed.hs --- a/src/testNamed.hs +++ b/src/testNamed.hs @@ -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]