From 080de0a4e1820d3baa7ff7fe17d47ba22da8cb5e Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Fri, 13 Jan 2012 00:22:27 -0300 Subject: [PATCH] development/production logger. dev flushes --- yesod-core/Yesod/Logger.hs | 67 +++++++++++++++++++-------- yesod-default/Yesod/Default/Main.hs | 6 +-- yesod/scaffold/Application.hs.cg | 14 +++--- yesod/scaffold/deploy/Procfile.cg | 2 +- yesod/scaffold/tiny/Application.hs.cg | 14 +++--- yesod/test/scaffold_test.sh | 2 +- 6 files changed, 68 insertions(+), 37 deletions(-) diff --git a/yesod-core/Yesod/Logger.hs b/yesod-core/Yesod/Logger.hs index 9d2f2ea9..23c6a445 100644 --- a/yesod-core/Yesod/Logger.hs +++ b/yesod-core/Yesod/Logger.hs @@ -1,17 +1,21 @@ {-# LANGUAGE BangPatterns #-} module Yesod.Logger ( Logger - , makeLogger - , makeLoggerWithHandle - , makeDefaultLogger + , handle + , developmentLogger, productionLogger + , defaultDevelopmentLogger, defaultProductionLogger + , toProduction , flushLogger - , timed , logText , logLazyText , logString , logBS , logMsg , formatLogText + , timed + -- * Deprecated + , makeLoggerWithHandle + , makeDefaultLogger ) where import System.IO (Handle, stdout, hFlush) @@ -36,39 +40,62 @@ import Language.Haskell.TH.Syntax (Loc) import Yesod.Core (LogLevel, fileLocationToString) data Logger = Logger { - loggerHandle :: Handle - , loggerDateRef :: DateRef + loggerLogFun :: [LogStr] -> IO () + , loggerHandle :: Handle + , loggerDateRef :: DateRef } -makeLogger :: IO Logger -makeLogger = makeDefaultLogger -{-# DEPRECATED makeLogger "Use makeDefaultLogger instead" #-} - -makeLoggerWithHandle :: Handle -> IO Logger -makeLoggerWithHandle handle = dateInit >>= return . Logger handle - --- | uses stdout handle -makeDefaultLogger :: IO Logger -makeDefaultLogger = makeLoggerWithHandle stdout +handle :: Logger -> Handle +handle = loggerHandle flushLogger :: Logger -> IO () flushLogger = hFlush . loggerHandle +makeDefaultLogger :: IO Logger +makeDefaultLogger = defaultDevelopmentLogger +{-# DEPRECATED makeDefaultLogger "Use defaultProductionLogger or defaultDevelopmentLogger instead" #-} + +makeLoggerWithHandle, developmentLogger, productionLogger :: Handle -> IO Logger +makeLoggerWithHandle = productionLogger +{-# DEPRECATED makeLoggerWithHandle "Use productionLogger or developmentLogger instead" #-} + +-- | uses stdout handle +defaultProductionLogger, defaultDevelopmentLogger :: IO Logger +defaultProductionLogger = productionLogger stdout +defaultDevelopmentLogger = developmentLogger stdout + + +productionLogger h = mkLogger h (handleToLogFun h) +-- | a development logger gets automatically flushed +developmentLogger h = mkLogger h (\bs -> (handleToLogFun h) bs >> hFlush h) + +mkLogger :: Handle -> ([LogStr] -> IO ()) -> IO Logger +mkLogger h logFun = do + initHandle h + dateInit >>= return . Logger logFun h + +-- convert (a development) logger to production settings +toProduction :: Logger -> Logger +toProduction (Logger _ h d) = Logger (handleToLogFun h) h d + +handleToLogFun :: Handle -> ([LogStr] -> IO ()) +handleToLogFun = hPutLogStr + logMsg :: Logger -> [LogStr] -> IO () -logMsg = hPutLogStr . loggerHandle +logMsg = hPutLogStr . handle logLazyText :: Logger -> TL.Text -> IO () -logLazyText logger msg = logMsg logger $ +logLazyText logger msg = loggerLogFun logger $ map LB (toChunks $ TLE.encodeUtf8 msg) ++ [newLine] logText :: Logger -> Text -> IO () logText logger = logBS logger . encodeUtf8 logBS :: Logger -> ByteString -> IO () -logBS logger msg = logMsg logger [LB msg, newLine] +logBS logger msg = loggerLogFun logger $ [LB msg, newLine] logString :: Logger -> String -> IO () -logString logger msg = logMsg logger [LS msg, newLine] +logString logger msg = loggerLogFun logger $ [LS msg, newLine] formatLogText :: Logger -> Loc -> LogLevel -> Text -> IO [LogStr] formatLogText logger loc level msg = formatLogMsg logger loc level (toLB msg) diff --git a/yesod-default/Yesod/Default/Main.hs b/yesod-default/Yesod/Default/Main.hs index ff88b866..b2e158a0 100644 --- a/yesod-default/Yesod/Default/Main.hs +++ b/yesod-default/Yesod/Default/Main.hs @@ -7,7 +7,7 @@ module Yesod.Default.Main ) where import Yesod.Default.Config -import Yesod.Logger (Logger, makeDefaultLogger, logString, flushLogger) +import Yesod.Logger (Logger, defaultDevelopmentLogger, logString, flushLogger) import Network.Wai (Application) import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort, settingsHost) @@ -43,7 +43,7 @@ defaultMain :: (Show env, Read env) -> IO () defaultMain load getApp = do config <- load - logger <- makeDefaultLogger + logger <- defaultDevelopmentLogger app <- getApp config logger runSettings defaultSettings { settingsHost = "0.0.0.0" @@ -93,7 +93,7 @@ defaultDevelApp -> ((Int, Application) -> IO ()) -> IO () defaultDevelApp load getApp f = do conf <- load - logger <- makeDefaultLogger + logger <- defaultDevelopmentLogger let p = appPort conf logString logger $ "Devel application launched, listening on port " ++ show p app <- getApp conf logger diff --git a/yesod/scaffold/Application.hs.cg b/yesod/scaffold/Application.hs.cg index dd8fdbf8..6f6f5a25 100644 --- a/yesod/scaffold/Application.hs.cg +++ b/yesod/scaffold/Application.hs.cg @@ -13,11 +13,11 @@ import Yesod.Default.Main import Yesod.Default.Handlers import Data.Dynamic (Dynamic, toDyn) #if DEVELOPMENT -import Yesod.Logger (Logger, logBS, flushLogger) +import Yesod.Logger (Logger, logBS) import Network.Wai.Middleware.RequestLogger (logHandleDev) #else -import Yesod.Logger (Logger) -import Network.Wai.Middleware.RequestLogger (logStdout) +import Yesod.Logger (Logger, logBS, toProduction) +import Network.Wai.Middleware.RequestLogger (logHandle) #endif import qualified Database.Persist.Store~importMigration~ import Network.HTTP.Conduit (newManagerIO) @@ -41,14 +41,16 @@ getApplication conf logger = do dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf) Database.Persist.Store.loadConfig p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~ - let foundation = ~sitearg~ conf logger s p manager + let foundation = ~sitearg~ conf setLogger s p manager app <- toWaiAppPlain foundation return $ logWare app where #ifdef DEVELOPMENT - logWare = logHandleDev (\msg -> logBS logger msg >> flushLogger logger) + logWare = logHandleDev (logBS setLogger) + setLogger = logger #else - logWare = logStdout + setLogger = toProduction logger -- by default the logger is set for development + logWare = logHandle (logBS setLogger) #endif -- for yesod devel diff --git a/yesod/scaffold/deploy/Procfile.cg b/yesod/scaffold/deploy/Procfile.cg index 83e69b56..28d63220 100644 --- a/yesod/scaffold/deploy/Procfile.cg +++ b/yesod/scaffold/deploy/Procfile.cg @@ -64,7 +64,7 @@ # defaultRunner (f . logWare) h # where # #ifdef DEVELOPMENT -# logWare = logHandleDev (\msg -> logBS logger msg >> flushLogger logger) +# logWare = logStdoutDev # #else # logWare = logStdout # #endif diff --git a/yesod/scaffold/tiny/Application.hs.cg b/yesod/scaffold/tiny/Application.hs.cg index 275c738b..6bc3ef07 100644 --- a/yesod/scaffold/tiny/Application.hs.cg +++ b/yesod/scaffold/tiny/Application.hs.cg @@ -11,11 +11,11 @@ import Yesod.Default.Config import Yesod.Default.Main (defaultDevelApp) import Yesod.Default.Handlers (getFaviconR, getRobotsR) #if DEVELOPMENT -import Yesod.Logger (Logger, logBS, flushLogger) +import Yesod.Logger (Logger, logBS) import Network.Wai.Middleware.RequestLogger (logHandleDev) #else -import Yesod.Logger (Logger) -import Network.Wai.Middleware.RequestLogger (logStdout) +import Yesod.Logger (Logger, logBS, toProduction) +import Network.Wai.Middleware.RequestLogger (logHandle) #endif import Network.Wai (Application) import Data.Dynamic (Dynamic, toDyn) @@ -35,14 +35,16 @@ mkYesodDispatch "~sitearg~" resources~sitearg~ getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application getApplication conf logger = do s <- staticSite - let foundation = ~sitearg~ conf logger s + let foundation = ~sitearg~ conf setLogger s app <- toWaiAppPlain foundation return $ logWare app where #ifdef DEVELOPMENT - logWare = logHandleDev (\msg -> logBS logger msg >> flushLogger logger) + logWare = logHandleDev (logBS setLogger) + setLogger = logger #else - logWare = logStdout + setLogger = toProduction logger -- by default the logger is set for development + logWare = logHandle (logBS setLogger) #endif -- for yesod devel diff --git a/yesod/test/scaffold_test.sh b/yesod/test/scaffold_test.sh index d12ea1ea..0e0a121a 100644 --- a/yesod/test/scaffold_test.sh +++ b/yesod/test/scaffold_test.sh @@ -3,5 +3,5 @@ teardown() { rm -rf foobar; ghc-pkg unregister foobar &>/dev/null; } test_sqlite() { ../test/scaffold.sh < ../test/sqlite-input.txt ; } test_postgresql() { ../test/scaffold.sh < ../test/postgresql-input.txt; } -test_mongodb() { ../test/scaffold.sh < ../test/mongodb-input.txt ; } +#test_mongodb() { ../test/scaffold.sh < ../test/mongodb-input.txt ; } test_tiny() { ../test/scaffold.sh < ../test/tiny-input.txt ; }