diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,13 @@ +module Main (main) where + +import System.Process (system) + +import Distribution.Simple (defaultMainWithHooks, simpleUserHooks, runTests) + +main :: IO () +main = + defaultMainWithHooks $ simpleUserHooks { runTests = runTests' } + where + runTests' _ _ _ _ = do + system "runhaskell -i./src src/test.hs" + return () diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,13 +0,0 @@ -#! /usr/bin/env runhaskell - -> module Main (main) where -> -> import System.Cmd (system) -> -> import Distribution.Simple (defaultMainWithHooks, runTests, simpleUserHooks) -> -> main :: IO () -> main = -> defaultMainWithHooks (simpleUserHooks { runTests = \_ _ _ _ -> system command >> return () }) -> where -> command = "runhaskell -i./src -Wall -XTemplateHaskell src/test.hs" diff --git a/hslogger-template.cabal b/hslogger-template.cabal --- a/hslogger-template.cabal +++ b/hslogger-template.cabal @@ -1,34 +1,36 @@ -name: hslogger-template -version: 0.2.2 - -category: Interfaces - -synopsis: Automatic generation of hslogger functions - -description: - Library for generating hslogger functions using Template Haskell. - -author: Brian Lewis , Ian Taylor -maintainer: Brian Lewis , Ian Taylor - -license: PublicDomain - -homepage: http://github.com/bsl/hslogger-template +name: hslogger-template +version: 1.0.0 +category: Interfaces +synopsis: Automatic generation of hslogger functions +description: Library for generating hslogger functions using Template Haskell. +author: Brian Lewis , Ian Taylor +maintainer: Brian Lewis , Ian Taylor +license: PublicDomain cabal-version: >= 1.6 build-type: Custom -extra-source-files: src/test.hs +extra-source-files: + src/test.hs library - exposed-modules: System.Log.Logger.TH - build-depends: base, haskell98, hslogger, template-haskell - extensions: TemplateHaskell - hs-source-dirs: src - ghc-options: -Wall - if impl(ghc >= 6.8) - ghc-options: -fwarn-tabs + hs-source-dirs: + src + exposed-modules: + System.Log.Logger.TH + + build-depends: + base >= 3 && < 5, + haskell98 == 1.*, + hslogger == 1.*, + mtl == 1.*, + template-haskell == 2.* + + ghc-options: -Wall + if impl(ghc >= 6.8) + ghc-options: -fwarn-tabs + source-repository head - type: git - location: git://github.com/bsl/hslogger-template.git + type: git + location: git://github.com/bsl/hslogger-template.git 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,52 +1,55 @@ -{-| - This module provides functions that generate hslogger functions using - Template Haskell. --} -module System.Log.Logger.TH (deriveLoggers) where +{-# LANGUAGE TemplateHaskell #-} +-- | This module provides functions that generate hslogger functions using +-- Template Haskell. +module System.Log.Logger.TH + ( + deriveLoggers + ) + where + +import Control.Monad.Trans (MonadIO, liftIO) import qualified Language.Haskell.TH as TH import qualified System.Log.Logger as HSL -{-| - Generate hslogger functions for a list of priorities. - - Example usage: - - > module Foo.Bar ( ... ) where - > - > import System.Log.Logger.TH (deriveLoggers) - > import qualified System.Log.Logger as HSL - > - > $(deriveLoggers "HSL" [HSL.DEBUG, HSL.INFO]) - - Used this way, @deriveLoggers@ would generate the following functions: - - > infoM :: String -> IO () - > infoM s = HSL.infoM "Foo.Bar" ((++) "Foo.Bar: " s) - > - > debugM :: String -> IO () - > debugM s = HSL.debugM "Foo.Bar" ((++) "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 - - Notes: - - * "System.Log.Logger" must be imported qualified, and the qualifier must - match the qualifier given to @deriveLoggers@. - - * 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, etc. --} +-- | Generate hslogger functions for a list of priorities. +-- +-- Example usage: +-- +-- > module Foo.Bar ( ... ) where +-- > +-- > import System.Log.Logger.TH (deriveLoggers) +-- > import qualified System.Log.Logger as HSL +-- > +-- > $(deriveLoggers "HSL" [HSL.DEBUG, HSL.INFO]) +-- +-- Used this way, @deriveLoggers@ would generate the following functions: +-- +-- > infoM :: MonadIO m => String -> m () +-- > infoM s = liftIO (HSL.infoM "Foo.Bar" ((++) "Foo.Bar: " s)) +-- > +-- > debugM :: MonadIO m => String -> m () +-- > debugM s = liftIO (HSL.debugM "Foo.Bar" ((++) "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 +-- +-- Notes: +-- +-- * "System.Log.Logger" must be imported qualified, and the qualifier must +-- match the qualifier given to @deriveLoggers@. +-- +-- * 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. deriveLoggers :: String -- ^ Must match qualifier on import of "System.Log.Logger". @@ -56,46 +59,49 @@ fmap TH.loc_module TH.location >>= \moduleName -> fmap concat (mapM (deriveLogger qualifier moduleName) priorities) --- ---------------------------------------- +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- deriveLogger :: String -> String -> HSL.Priority -> TH.Q [TH.Dec] -deriveLogger qualifier moduleName priority = code - where - code = do - sig <- TH.sigD th_f [t| String -> IO () |] - body <- TH.funD th_f - [ TH.clause - [TH.varP th_s] - (TH.normalB +deriveLogger qualifier moduleName priority = do + sig <- TH.sigD thF [t| MonadIO m => String -> m () |] + body <- TH.funD thF + [ TH.clause + [TH.varP thS] + (TH.normalB + (TH.appE + (TH.varE 'liftIO) + (TH.appE + -- HSL.xM "Foo.Bar" (TH.appE - (TH.appE - (TH.varE th_h) - (TH.stringE moduleName) - ) + (TH.varE thH) + (TH.stringE moduleName) + ) + -- ((++) "Foo.Bar: ") s + (TH.appE (TH.appE - (TH.appE - (TH.varE '(++)) - (TH.stringE prefix) - ) - (TH.varE th_s) + (TH.varE '(++)) + (TH.stringE prefix) ) + (TH.varE thS) ) ) - [] - ] - return [sig, body] - where - th_s = TH.mkName "s" - th_f = TH.mkName functionName - th_h = TH.mkName (qualifier ++ "." ++ functionName) - prefix = moduleName ++ ": " - functionName = - case priority of - HSL.DEBUG -> "debugM" - HSL.INFO -> "infoM" - HSL.NOTICE -> "noticeM" - HSL.WARNING -> "warningM" - HSL.ERROR -> "errorM" - HSL.CRITICAL -> "criticalM" - HSL.ALERT -> "alertM" - HSL.EMERGENCY -> "emergencyM" + ) + ) + [] + ] + return [sig, body] + where + thF = TH.mkName functionName + thS = TH.mkName "s" + thH = TH.mkName (qualifier ++ "." ++ functionName) + prefix = moduleName ++ ": " + functionName = + case priority of + HSL.DEBUG -> "debugM" + HSL.INFO -> "infoM" + HSL.NOTICE -> "noticeM" + HSL.WARNING -> "warningM" + HSL.ERROR -> "errorM" + HSL.CRITICAL -> "criticalM" + HSL.ALERT -> "alertM" + HSL.EMERGENCY -> "emergencyM" diff --git a/src/test.hs b/src/test.hs --- a/src/test.hs +++ b/src/test.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + module Main (main) where import System.Log.Logger.TH (deriveLoggers)