monad-logger 0.2.0.1 → 0.2.1
raw patch · 2 files changed
+54/−20 lines, 2 files
Files
- Control/Monad/Logger.hs +53/−19
- monad-logger.cabal +1/−1
Control/Monad/Logger.hs view
@@ -1,14 +1,22 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} module Control.Monad.Logger ( -- * MonadLogger MonadLogger(..) , LogLevel(..)+ , LogSource -- * TH logging , logDebug , logInfo , logWarn , logError , logOther+ -- * TH logging with source+ , logDebugS+ , logInfoS+ , logWarnS+ , logErrorS+ , logOtherS ) where import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (Loc), qLocation)@@ -50,37 +58,38 @@ lift LevelError = [|LevelError|] lift (LevelOther x) = [|LevelOther $ pack $(lift $ unpack x)|] +type LogSource = Text+ class Monad m => MonadLogger m where monadLoggerLog :: ToLogStr msg => Loc -> LogLevel -> msg -> m () + monadLoggerLogSource :: ToLogStr msg => Loc -> LogSource -> LogLevel -> msg -> m ()+ monadLoggerLogSource loc _ level msg = monadLoggerLog loc level msg+ instance MonadLogger IO where monadLoggerLog _ _ _ = return () instance MonadLogger Identity where monadLoggerLog _ _ _ = return () instance MonadLogger (ST s) where monadLoggerLog _ _ _ = return () instance MonadLogger (Lazy.ST s) where monadLoggerLog _ _ _ = return () -liftLog :: (MonadTrans t, MonadLogger m, ToLogStr msg) => Loc -> LogLevel -> msg -> t m ()-liftLog a b c = Trans.lift $ monadLoggerLog a b c--instance MonadLogger m => MonadLogger (IdentityT m) where monadLoggerLog = liftLog-instance MonadLogger m => MonadLogger (ListT m) where monadLoggerLog = liftLog-instance MonadLogger m => MonadLogger (MaybeT m) where monadLoggerLog = liftLog-instance (MonadLogger m, Error e) => MonadLogger (ErrorT e m) where monadLoggerLog = liftLog-instance MonadLogger m => MonadLogger (ReaderT r m) where monadLoggerLog = liftLog-instance MonadLogger m => MonadLogger (ContT r m) where monadLoggerLog = liftLog-instance MonadLogger m => MonadLogger (StateT s m) where monadLoggerLog = liftLog-instance (MonadLogger m, Monoid w) => MonadLogger (WriterT w m) where monadLoggerLog = liftLog-instance (MonadLogger m, Monoid w) => MonadLogger (RWST r w s m) where monadLoggerLog = liftLog-instance MonadLogger m => MonadLogger (ResourceT m) where monadLoggerLog = liftLog-instance MonadLogger m => MonadLogger (Strict.StateT s m) where monadLoggerLog = liftLog-instance (MonadLogger m, Monoid w) => MonadLogger (Strict.WriterT w m) where monadLoggerLog = liftLog-instance (MonadLogger m, Monoid w) => MonadLogger (Strict.RWST r w s m) where monadLoggerLog = liftLog+#define DEF monadLoggerLog a b c = Trans.lift $ monadLoggerLog a b c; monadLoggerLogSource a b c d = Trans.lift $ monadLoggerLogSource a b c d+instance MonadLogger m => MonadLogger (IdentityT m) where DEF+instance MonadLogger m => MonadLogger (ListT m) where DEF+instance MonadLogger m => MonadLogger (MaybeT m) where DEF+instance (MonadLogger m, Error e) => MonadLogger (ErrorT e m) where DEF+instance MonadLogger m => MonadLogger (ReaderT r m) where DEF+instance MonadLogger m => MonadLogger (ContT r m) where DEF+instance MonadLogger m => MonadLogger (StateT s m) where DEF+instance (MonadLogger m, Monoid w) => MonadLogger (WriterT w m) where DEF+instance (MonadLogger m, Monoid w) => MonadLogger (RWST r w s m) where DEF+instance MonadLogger m => MonadLogger (ResourceT m) where DEF+instance MonadLogger m => MonadLogger (Strict.StateT s m) where DEF+instance (MonadLogger m, Monoid w) => MonadLogger (Strict.WriterT w m) where DEF+instance (MonadLogger m, Monoid w) => MonadLogger (Strict.RWST r w s m) where DEF+#undef DEF logTH :: LogLevel -> Q Exp logTH level = [|monadLoggerLog $(qLocation >>= liftLoc) $(lift level) . (id :: Text -> Text)|]- where- liftLoc :: Loc -> Q Exp- liftLoc (Loc a b c d e) = [|Loc $(lift a) $(lift b) $(lift c) $(lift d) $(lift e)|] -- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message. Usage: --@@ -103,3 +112,28 @@ -- > $(logOther "My new level") "This is a log message" logOther :: Text -> Q Exp logOther = logTH . LevelOther++liftLoc :: Loc -> Q Exp+liftLoc (Loc a b c d e) = [|Loc $(lift a) $(lift b) $(lift c) $(lift d) $(lift e)|]++-- | Generates a function that takes a 'LogSource' and 'Text' and logs a 'LevelDebug' message. Usage:+--+-- > $logDebug "SomeSource" "This is a debug log message"+logDebugS :: Q Exp+logDebugS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|]++-- | See 'logDebugS'+logInfoS :: Q Exp+logInfoS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelInfo (b :: Text)|]+-- | See 'logDebugS'+logWarnS :: Q Exp+logWarnS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelWarn (b :: Text)|]+-- | See 'logDebugS'+logErrorS :: Q Exp+logErrorS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelError (b :: Text)|]++-- | Generates a function that takes a 'LogSource', a level name and a 'Text' and logs a 'LevelOther' message. Usage:+--+-- > $logOther "SomeSource" "My new level" "This is a log message"+logOtherS :: Q Exp+logOtherS = [|\src level msg -> monadLoggerLogSource $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|]
monad-logger.cabal view
@@ -1,5 +1,5 @@ name: monad-logger-version: 0.2.0.1+version: 0.2.1 synopsis: A class of monads which can log messages. description: This package uses template-haskell for determining source code locations of messages. homepage: https://github.com/kazu-yamamoto/logger