diff --git a/yesod-core/Yesod/Handler.hs b/yesod-core/Yesod/Handler.hs index 103dd905..bc0f15c7 100644 --- a/yesod-core/Yesod/Handler.hs +++ b/yesod-core/Yesod/Handler.hs @@ -194,7 +194,7 @@ data HandlerData sub master = HandlerData , handlerToMaster :: Route sub -> Route master , handlerState :: I.IORef GHState , handlerUpload :: Word64 -> FileUpload - , handlerLog :: Loc -> LogLevel -> LogStr -> IO () + , handlerLog :: Loc -> LogSource -> LogLevel -> LogStr -> IO () } handlerSubData :: (Route sub -> Route master) @@ -471,7 +471,7 @@ runHandler :: HasReps c -> master -> sub -> (Word64 -> FileUpload) - -> (Loc -> LogLevel -> LogStr -> IO ()) + -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> YesodApp runHandler handler mrender sroute tomr master sub upload log' = YesodApp $ \eh rr cts initSession -> do @@ -881,7 +881,7 @@ handlerToYAR :: (HasReps a, HasReps b) => master -- ^ master site foundation -> sub -- ^ sub site foundation -> (Word64 -> FileUpload) - -> (Loc -> LogLevel -> LogStr -> IO ()) + -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> (Route sub -> Route master) -> (Route master -> [(Text, Text)] -> Text) -- route renderer -> (ErrorResponse -> GHandler sub master a) @@ -1056,6 +1056,7 @@ instance MonadResource (GHandler sub master) where #endif instance MonadLogger (GHandler sub master) where - monadLoggerLog a b c = do + monadLoggerLog a c d = monadLoggerLogSource a "" c d + monadLoggerLogSource a b c d = do hd <- ask - liftIO $ handlerLog hd a b (toLogStr c) + liftIO $ handlerLog hd a b c (toLogStr d) diff --git a/yesod-core/Yesod/Internal/Core.hs b/yesod-core/Yesod/Internal/Core.hs index 23c48fa1..b6b35a47 100644 --- a/yesod-core/Yesod/Internal/Core.hs +++ b/yesod-core/Yesod/Internal/Core.hs @@ -90,7 +90,7 @@ import Network.Wai.Parse (tempFileBackEnd, lbsBackEnd) import qualified Paths_yesod_core import Data.Version (showVersion) import System.Log.FastLogger (Logger, mkLogger, loggerDate, LogStr (..), loggerPutStr) -import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther)) +import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther), LogSource) import System.Log.FastLogger.Date (ZonedDate) import System.IO (stdout) @@ -305,16 +305,29 @@ $doctype 5 getLogger _ = mkLogger True stdout -- | Send a message to the @Logger@ provided by @getLogger@. + -- + -- Note: This method is no longer used. Instead, you should override + -- 'messageLoggerSource'. messageLogger :: a -> Logger -> Loc -- ^ position in source code -> LogLevel -> LogStr -- ^ message -> IO () - messageLogger a logger loc level msg = - if level < logLevel a - then return () - else formatLogMessage (loggerDate logger) loc level msg >>= loggerPutStr logger + messageLogger a logger loc = messageLoggerSource a logger loc "" + + -- | Send a message to the @Logger@ provided by @getLogger@. + messageLoggerSource :: a + -> Logger + -> Loc -- ^ position in source code + -> LogSource + -> LogLevel + -> LogStr -- ^ message + -> IO () + messageLoggerSource a logger loc source level msg = + if shouldLog a source level + then formatLogMessage (loggerDate logger) loc level msg >>= loggerPutStr logger + else return () -- | The logging level in place for this application. Any messages below -- this level will simply be ignored. @@ -353,6 +366,12 @@ $doctype 5 | size > 50000 = FileUploadDisk tempFileBackEnd | otherwise = FileUploadMemory lbsBackEnd + -- | Should we log the given log source/level combination. + -- + -- Default: Logs everything at or above 'logLevel' + shouldLog :: a -> LogSource -> LogLevel -> Bool + shouldLog a _ level = level >= logLevel a + formatLogMessage :: IO ZonedDate -> Loc -> LogLevel @@ -424,7 +443,7 @@ defaultYesodRunner logger handler master sub murl toMasterRoute msb req handler let sessionMap = Map.fromList . filter ((/=) tokenKey . fst) $ session let ra = resolveApproot master req - let log' = messageLogger master logger + let log' = messageLoggerSource master logger yar <- handlerToYAR master sub (fileUpload master) log' toMasterRoute (yesodRender master ra) errorHandler rr murl sessionMap h extraHeaders <- case yar of @@ -802,7 +821,7 @@ runFakeHandler fakeSessionMap logger master handler = liftIO $ do master master (fileUpload master) - (messageLogger master $ logger master) + (messageLoggerSource master $ logger master) errHandler err = YesodApp $ \_ _ _ session -> do liftIO $ I.writeIORef ret (Left err) diff --git a/yesod-core/Yesod/Widget.hs b/yesod-core/Yesod/Widget.hs index 9e35cac3..4e169f4d 100644 --- a/yesod-core/Yesod/Widget.hs +++ b/yesod-core/Yesod/Widget.hs @@ -352,3 +352,4 @@ instance MonadResource (GWidget sub master) where instance MonadLogger (GWidget sub master) where monadLoggerLog a b = lift . monadLoggerLog a b + monadLoggerLogSource a b c = lift . monadLoggerLogSource a b c diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 2a741bf5..d07abb65 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -78,7 +78,7 @@ library , vector >= 0.9 && < 0.10 , aeson >= 0.5 , fast-logger >= 0.2 - , monad-logger >= 0.2 && < 0.3 + , monad-logger >= 0.2.1 && < 0.3 , conduit >= 0.5 && < 0.6 , resourcet >= 0.3 && < 0.5 , lifted-base >= 0.1 && < 0.2