diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs
--- a/Control/Monad/Logger.hs
+++ b/Control/Monad/Logger.hs
@@ -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)|]
diff --git a/monad-logger.cabal b/monad-logger.cabal
--- a/monad-logger.cabal
+++ b/monad-logger.cabal
@@ -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