From bd161ef5f7c024beef8d50f74d63583b572ab28d Mon Sep 17 00:00:00 2001 From: Yitzchak Gale Date: Wed, 3 Jun 2015 11:16:43 +0300 Subject: [PATCH 1/4] Export defaults for logging methods of Yesod. --- yesod-core/Yesod/Core.hs | 5 +++ yesod-core/Yesod/Core/Class/Yesod.hs | 58 +++++++++++++++++++++------- 2 files changed, 50 insertions(+), 13 deletions(-) diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index f7436e66..c1a55280 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -30,6 +30,11 @@ module Yesod.Core , AuthResult (..) , unauthorizedI -- * Logging + , defaultMakeLogger + , defaultMessageLoggerSource + , defaultShouldLog + , defaultShouldLogIO + , formatLogMessage , LogLevel (..) , logDebug , logInfo diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index c2e707a1..43096c7a 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -207,17 +207,14 @@ class RenderRoute site => Yesod site where -- method return that already created value. That way, you can use that -- same @Logger@ for printing messages during app initialization. -- - -- Default: Sends to stdout and automatically flushes on each write. + -- Default: the 'defaultMakeLogger' function. makeLogger :: site -> IO Logger - makeLogger _ = do - loggerSet' <- newStdoutLoggerSet defaultBufSize - (getter, _) <- clockDateCacher - return $! Logger loggerSet' getter + makeLogger _ = defaultMakeLogger -- | Send a message to the @Logger@ provided by @getLogger@. -- - -- Default implementation: checks if the message should be logged using - -- 'shouldLog' and, if so, formats using 'formatLogMessage'. + -- Default: the 'defaultMessageLoggerSource' function, using + -- 'shouldLogIO' to check whether we should log. messageLoggerSource :: site -> Logger -> Loc -- ^ position in source code @@ -225,10 +222,7 @@ class RenderRoute site => Yesod site where -> LogLevel -> LogStr -- ^ message -> IO () - messageLoggerSource a logger loc source level msg = do - sl <- shouldLogIO a source level - when sl $ - formatLogMessage (loggerDate logger) loc source level msg >>= loggerPutStr logger + messageLoggerSource site = defaultMessageLoggerSource $ shouldLogIO site -- | Where to Load sripts from. We recommend the default value, -- 'BottomOfBody'. Alternatively use the built in async yepnope loader: @@ -260,9 +254,9 @@ class RenderRoute site => Yesod site where -- | Should we log the given log source/level combination. -- - -- Default: Logs everything at or above 'logLevel' + -- Default: the 'shouldLog' function. shouldLog :: site -> LogSource -> LogLevel -> Bool - shouldLog _ _ level = level >= LevelInfo + shouldLog _ = defaultShouldLog -- | Should we log the given log source/level combination. -- @@ -300,6 +294,43 @@ class RenderRoute site => Yesod site where yesodWithInternalState _ _ = bracket createInternalState closeInternalState {-# INLINE yesodWithInternalState #-} +-- | Default implementation of 'makeLogger'. Sends to stdout and +-- automatically flushes on each write. +defaultMakeLogger :: IO Logger +defaultMakeLogger = do + loggerSet' <- newStdoutLoggerSet defaultBufSize + (getter, _) <- clockDateCacher + return $! Logger loggerSet' getter + +-- | Default implementation of 'messageLoggerSource'. Checks if the +-- message should be logged using the provided function, and if so, +-- formats using 'formatLogMessage'. You can use 'defaultShouldLogIO' +-- as the provided function. +defaultMessageLoggerSource :: + (LogSource -> LogLevel -> IO Bool) -- ^ Check whether we should + -- log this + -> Logger + -> Loc -- ^ position in source code + -> LogSource + -> LogLevel + -> LogStr -- ^ message + -> IO () +defaultMessageLoggerSource ckLoggable logger loc source level msg = do + loggable <- ckLoggable source level + when loggable $ + formatLogMessage (loggerDate logger) loc source level msg >>= + loggerPutStr logger + +-- | Default implementation of 'shouldLog'. Logs everything at or +-- above 'logLevel'. +defaultShouldLog :: LogSource -> LogLevel -> Bool +defaultShouldLog _ level = level >= LevelInfo + +-- | A default implementation of 'shouldLogIO' that can be used with +-- 'defaultMessageLoggerSource'. Just uses 'defaultShouldLog'. +defaultShouldLogIO :: LogSource -> LogLevel -> IO Bool +defaultShouldLogIO a b = return $ defaultShouldLog a b + -- | Default implementation of 'yesodMiddleware'. Adds the response header -- \"Vary: Accept, Accept-Language\" and performs authorization checks. -- @@ -577,6 +608,7 @@ asyncHelper render scripts jscript jsLoc = Nothing -> Nothing Just j -> Just $ jelper j +-- | Default formatting for log messages. formatLogMessage :: IO ZonedDate -> Loc -> LogSource From bef07c5e123c1b8d0e2265c5285242fe8ab4211c Mon Sep 17 00:00:00 2001 From: Yitzchak Gale Date: Wed, 3 Jun 2015 11:18:33 +0300 Subject: [PATCH 2/4] Fix reference to default in haddock for shouldLog. --- yesod-core/Yesod/Core/Class/Yesod.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index 43096c7a..5e097387 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -254,7 +254,7 @@ class RenderRoute site => Yesod site where -- | Should we log the given log source/level combination. -- - -- Default: the 'shouldLog' function. + -- Default: the 'defaultShouldLog' function. shouldLog :: site -> LogSource -> LogLevel -> Bool shouldLog _ = defaultShouldLog From 95c8d40010214cdf4e56ef9b1af5d58b93cb54ed Mon Sep 17 00:00:00 2001 From: Yitzchak Gale Date: Wed, 3 Jun 2015 11:45:29 +0300 Subject: [PATCH 3/4] Fix haddock about default log level. --- yesod-core/Yesod/Core/Class/Yesod.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index 5e097387..0f76fb82 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -322,7 +322,7 @@ defaultMessageLoggerSource ckLoggable logger loc source level msg = do loggerPutStr logger -- | Default implementation of 'shouldLog'. Logs everything at or --- above 'logLevel'. +-- above 'LevelInfo'. defaultShouldLog :: LogSource -> LogLevel -> Bool defaultShouldLog _ level = level >= LevelInfo From f3d9bb25551245ff66608826bffc423fe590d757 Mon Sep 17 00:00:00 2001 From: Yitzchak Gale Date: Wed, 3 Jun 2015 11:48:02 +0300 Subject: [PATCH 4/4] Unneeded import of Data.Maybe in Yesod.Core.Class.Yesod. --- yesod-core/Yesod/Core/Class/Yesod.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index 0f76fb82..205bc4f4 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -26,7 +26,6 @@ import Data.Aeson (object, (.=)) import Data.List (foldl') import Data.List (nub) import qualified Data.Map as Map -import Data.Maybe (fromMaybe) import Data.Monoid import Data.Text (Text) import qualified Data.Text as T