packages feed

monad-logger 0.2.0.1 → 0.2.1

raw patch · 2 files changed

+54/−20 lines, 2 files

Files

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