development/production logger. dev flushes

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)

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

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

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

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

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      ; }