diff --git a/sources.txt b/sources.txt index 1baeb39d..46a8d82b 100644 --- a/sources.txt +++ b/sources.txt @@ -10,3 +10,4 @@ ./yesod-bin ./yesod ./authenticate +./yesod-eventsource diff --git a/yesod-bin/GhcBuild.hs b/yesod-bin/GhcBuild.hs index 9a1e81f6..d50c77ed 100644 --- a/yesod-bin/GhcBuild.hs +++ b/yesod-bin/GhcBuild.hs @@ -42,7 +42,11 @@ import MonadUtils (liftIO) import Panic (throwGhcException, panic) import SrcLoc (Located, mkGeneralLocated) import qualified StaticFlags +#if __GLASGOW_HASKELL__ >= 707 +import DynFlags (ldInputs) +#else import StaticFlags (v_Ld_inputs) +#endif import System.FilePath (normalise, ()) import Util (consIORef, looksLikeModuleName) @@ -162,7 +166,15 @@ buildPackage' argv2 ld ar = do o_files <- mapM (\x -> compileFile hsc_env StopLn x) #endif non_hs_srcs +#if __GLASGOW_HASKELL__ >= 707 + let dflags4 = dflags3 + { ldInputs = map (DF.FileOption "") (reverse o_files) + ++ ldInputs dflags3 + } + GHC.setSessionDynFlags dflags4 +#else liftIO $ mapM_ (consIORef v_Ld_inputs) (reverse o_files) +#endif targets <- mapM (uncurry GHC.guessTarget) hs_srcs GHC.setTargets targets ok_flag <- GHC.load GHC.LoadAllTargets diff --git a/yesod-bin/hsfiles/mongo.hsfiles b/yesod-bin/hsfiles/mongo.hsfiles index fb71aa5a..62a5b71e 100644 --- a/yesod-bin/hsfiles/mongo.hsfiles +++ b/yesod-bin/hsfiles/mongo.hsfiles @@ -35,7 +35,8 @@ import Network.Wai.Middleware.RequestLogger import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import qualified Database.Persist import Network.HTTP.Conduit (newManager, conduitManagerSettings) -import System.Log.FastLogger (newLoggerSet, defaultBufSize) +import Control.Concurrent (forkIO, threadDelay) +import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize) import Network.Wai.Logger (clockDateCacher) import Data.Default (def) import Yesod.Core.Types (loggerSet, Logger (Logger)) @@ -53,7 +54,7 @@ mkYesodDispatch "App" resourcesApp -- performs initialization and creates a WAI application. This is also the -- place to put your migrate statements to have automatic database -- migrations handled by Yesod. -makeApplication :: AppConfig DefaultEnv Extra -> IO Application +makeApplication :: AppConfig DefaultEnv Extra -> IO (Application, LogFunc) makeApplication conf = do foundation <- makeFoundation conf @@ -68,7 +69,8 @@ makeApplication conf = do -- Create the WAI application and apply middlewares app <- toWaiAppPlain foundation - return $ logWare app + let logFunc = messageLoggerSource foundation (appLogger foundation) + return (logWare app, logFunc) -- | Loads up any necessary settings, creates your foundation datatype, and -- performs some initialization. @@ -81,8 +83,18 @@ makeFoundation conf = do Database.Persist.applyEnv p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) - loggerSet' <- newLoggerSet defaultBufSize Nothing - (getter, _) <- clockDateCacher + loggerSet' <- newStdoutLoggerSet defaultBufSize + (getter, updater) <- clockDateCacher + + -- If the Yesod logger (as opposed to the request logger middleware) is + -- used less than once a second on average, you may prefer to omit this + -- thread and use "(updater >> getter)" in place of "getter" below. That + -- would update the cache every time it is used, instead of every second. + let updateLoop = do + threadDelay 1000000 + updater + updateLoop + _ <- forkIO updateLoop let logger = Yesod.Core.Types.Logger loggerSet' getter foundation = App conf s p manager dbconf logger @@ -92,7 +104,7 @@ makeFoundation conf = do -- for yesod devel getApplicationDev :: IO (Int, Application) getApplicationDev = - defaultDevelApp loader makeApplication + defaultDevelApp loader (fmap fst . makeApplication) where loader = Yesod.Default.Config.loadConfig (configSettings Development) { csParseExtra = parseExtra @@ -226,7 +238,10 @@ instance YesodAuth App where case x of Just (Entity uid _) -> return $ Just uid Nothing -> do - fmap Just $ insert $ User (credsIdent creds) Nothing + fmap Just $ insert User + { userIdent = credsIdent creds + , userPassword = Nothing + } -- You can add other plugins like BrowserID, email or OAuth here authPlugins _ = [authBrowserId def, authGoogleEmail] @@ -387,7 +402,7 @@ library DeriveDataTypeable build-depends: base >= 4 && < 5 - , yesod >= 1.2 && < 1.3 + , yesod >= 1.2.5 && < 1.3 , yesod-core >= 1.2 && < 1.3 , yesod-auth >= 1.2 && < 1.3 , yesod-static >= 1.2 && < 1.3 @@ -413,7 +428,7 @@ library , aeson >= 0.6 && < 0.8 , conduit >= 1.0 && < 2.0 , monad-logger >= 0.3 && < 0.4 - , fast-logger >= 2.1 && < 2.2 + , fast-logger >= 2.1.4 && < 2.2 , wai-logger >= 2.1 && < 2.2 executable PROJECTNAME @@ -580,12 +595,12 @@ combineScripts = combineScripts' development combineSettings {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) -import Yesod.Default.Main (defaultMain) +import Yesod.Default.Main (defaultMainLog) import Settings (parseExtra) import Application (makeApplication) main :: IO () -main = defaultMain (fromArgs parseExtra) makeApplication +main = defaultMainLog (fromArgs parseExtra) makeApplication {-# START_FILE BASE64 config/favicon.ico #-} AAABAAIAEBAAAAEAIABoBAAAJgAAABAQAgABAAEAsAAAAI4EAAAoAAAAEAAAACAAAAABACAAAAAA diff --git a/yesod-bin/hsfiles/mysql.hsfiles b/yesod-bin/hsfiles/mysql.hsfiles index f0d01881..e956c156 100644 --- a/yesod-bin/hsfiles/mysql.hsfiles +++ b/yesod-bin/hsfiles/mysql.hsfiles @@ -37,7 +37,8 @@ import qualified Database.Persist import Database.Persist.Sql (runMigration) import Network.HTTP.Conduit (newManager, conduitManagerSettings) import Control.Monad.Logger (runLoggingT) -import System.Log.FastLogger (newLoggerSet, defaultBufSize) +import Control.Concurrent (forkIO, threadDelay) +import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize) import Network.Wai.Logger (clockDateCacher) import Data.Default (def) import Yesod.Core.Types (loggerSet, Logger (Logger)) @@ -55,7 +56,7 @@ mkYesodDispatch "App" resourcesApp -- performs initialization and creates a WAI application. This is also the -- place to put your migrate statements to have automatic database -- migrations handled by Yesod. -makeApplication :: AppConfig DefaultEnv Extra -> IO Application +makeApplication :: AppConfig DefaultEnv Extra -> IO (Application, LogFunc) makeApplication conf = do foundation <- makeFoundation conf @@ -70,7 +71,8 @@ makeApplication conf = do -- Create the WAI application and apply middlewares app <- toWaiAppPlain foundation - return $ logWare app + let logFunc = messageLoggerSource foundation (appLogger foundation) + return (logWare app, logFunc) -- | Loads up any necessary settings, creates your foundation datatype, and -- performs some initialization. @@ -83,8 +85,18 @@ makeFoundation conf = do Database.Persist.applyEnv p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) - loggerSet' <- newLoggerSet defaultBufSize Nothing - (getter, _) <- clockDateCacher + loggerSet' <- newStdoutLoggerSet defaultBufSize + (getter, updater) <- clockDateCacher + + -- If the Yesod logger (as opposed to the request logger middleware) is + -- used less than once a second on average, you may prefer to omit this + -- thread and use "(updater >> getter)" in place of "getter" below. That + -- would update the cache every time it is used, instead of every second. + let updateLoop = do + threadDelay 1000000 + updater + updateLoop + _ <- forkIO updateLoop let logger = Yesod.Core.Types.Logger loggerSet' getter foundation = App conf s p manager dbconf logger @@ -99,7 +111,7 @@ makeFoundation conf = do -- for yesod devel getApplicationDev :: IO (Int, Application) getApplicationDev = - defaultDevelApp loader makeApplication + defaultDevelApp loader (fmap fst . makeApplication) where loader = Yesod.Default.Config.loadConfig (configSettings Development) { csParseExtra = parseExtra @@ -235,7 +247,10 @@ instance YesodAuth App where case x of Just (Entity uid _) -> return $ Just uid Nothing -> do - fmap Just $ insert $ User (credsIdent creds) Nothing + fmap Just $ insert User + { userIdent = credsIdent creds + , userPassword = Nothing + } -- You can add other plugins like BrowserID, email or OAuth here authPlugins _ = [authBrowserId def, authGoogleEmail] @@ -391,7 +406,7 @@ library DeriveDataTypeable build-depends: base >= 4 && < 5 - , yesod >= 1.2 && < 1.3 + , yesod >= 1.2.5 && < 1.3 , yesod-core >= 1.2 && < 1.3 , yesod-auth >= 1.2 && < 1.3 , yesod-static >= 1.2 && < 1.3 @@ -417,7 +432,7 @@ library , aeson >= 0.6 && < 0.8 , conduit >= 1.0 && < 2.0 , monad-logger >= 0.3 && < 0.4 - , fast-logger >= 2.1 && < 2.2 + , fast-logger >= 2.1.4 && < 2.2 , wai-logger >= 2.1 && < 2.2 executable PROJECTNAME @@ -584,12 +599,12 @@ combineScripts = combineScripts' development combineSettings {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) -import Yesod.Default.Main (defaultMain) +import Yesod.Default.Main (defaultMainLog) import Settings (parseExtra) import Application (makeApplication) main :: IO () -main = defaultMain (fromArgs parseExtra) makeApplication +main = defaultMainLog (fromArgs parseExtra) makeApplication {-# START_FILE BASE64 config/favicon.ico #-} AAABAAIAEBAAAAEAIABoBAAAJgAAABAQAgABAAEAsAAAAI4EAAAoAAAAEAAAACAAAAABACAAAAAA diff --git a/yesod-bin/hsfiles/postgres-fay.hsfiles b/yesod-bin/hsfiles/postgres-fay.hsfiles index fa3439bc..4ab79c62 100644 --- a/yesod-bin/hsfiles/postgres-fay.hsfiles +++ b/yesod-bin/hsfiles/postgres-fay.hsfiles @@ -39,7 +39,8 @@ import Database.Persist.Sql (runMigration) import Network.HTTP.Conduit (newManager, conduitManagerSettings) import Yesod.Fay (getFaySite) import Control.Monad.Logger (runLoggingT) -import System.Log.FastLogger (newLoggerSet, defaultBufSize) +import Control.Concurrent (forkIO, threadDelay) +import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize) import Network.Wai.Logger (clockDateCacher) import Data.Default (def) import Yesod.Core.Types (loggerSet, Logger (Logger)) @@ -58,7 +59,7 @@ mkYesodDispatch "App" resourcesApp -- performs initialization and creates a WAI application. This is also the -- place to put your migrate statements to have automatic database -- migrations handled by Yesod. -makeApplication :: AppConfig DefaultEnv Extra -> IO Application +makeApplication :: AppConfig DefaultEnv Extra -> IO (Application, LogFunc) makeApplication conf = do foundation <- makeFoundation conf @@ -73,7 +74,8 @@ makeApplication conf = do -- Create the WAI application and apply middlewares app <- toWaiAppPlain foundation - return $ logWare app + let logFunc = messageLoggerSource foundation (appLogger foundation) + return (logWare app, logFunc) -- | Loads up any necessary settings, creates your foundation datatype, and -- performs some initialization. @@ -86,8 +88,18 @@ makeFoundation conf = do Database.Persist.applyEnv p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) - loggerSet' <- newLoggerSet defaultBufSize Nothing - (getter, _) <- clockDateCacher + loggerSet' <- newStdoutLoggerSet defaultBufSize + (getter, updater) <- clockDateCacher + + -- If the Yesod logger (as opposed to the request logger middleware) is + -- used less than once a second on average, you may prefer to omit this + -- thread and use "(updater >> getter)" in place of "getter" below. That + -- would update the cache every time it is used, instead of every second. + let updateLoop = do + threadDelay 1000000 + updater + updateLoop + _ <- forkIO updateLoop let logger = Yesod.Core.Types.Logger loggerSet' getter foundation = App conf s p manager dbconf onCommand logger @@ -102,7 +114,7 @@ makeFoundation conf = do -- for yesod devel getApplicationDev :: IO (Int, Application) getApplicationDev = - defaultDevelApp loader makeApplication + defaultDevelApp loader (fmap fst . makeApplication) where loader = Yesod.Default.Config.loadConfig (configSettings Development) { csParseExtra = parseExtra @@ -248,7 +260,10 @@ instance YesodAuth App where case x of Just (Entity uid _) -> return $ Just uid Nothing -> do - fmap Just $ insert $ User (credsIdent creds) Nothing + fmap Just $ insert User + { userIdent = credsIdent creds + , userPassword = Nothing + } -- You can add other plugins like BrowserID, email or OAuth here authPlugins _ = [authBrowserId def, authGoogleEmail] @@ -427,7 +442,7 @@ library DeriveDataTypeable build-depends: base >= 4 && < 5 - , yesod >= 1.2 && < 1.3 + , yesod >= 1.2.5 && < 1.3 , yesod-core >= 1.2 && < 1.3 , yesod-auth >= 1.2 && < 1.3 , yesod-static >= 1.2 && < 1.3 @@ -454,7 +469,7 @@ library , aeson >= 0.6 && < 0.8 , conduit >= 1.0 && < 2.0 , monad-logger >= 0.3 && < 0.4 - , fast-logger >= 2.1 && < 2.2 + , fast-logger >= 2.1.4 && < 2.2 , wai-logger >= 2.1 && < 2.2 executable PROJECTNAME @@ -633,12 +648,12 @@ combineScripts = combineScripts' development combineSettings {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) -import Yesod.Default.Main (defaultMain) +import Yesod.Default.Main (defaultMainLog) import Settings (parseExtra) import Application (makeApplication) main :: IO () -main = defaultMain (fromArgs parseExtra) makeApplication +main = defaultMainLog (fromArgs parseExtra) makeApplication {-# START_FILE BASE64 config/favicon.ico #-} AAABAAIAEBAAAAEAIABoBAAAJgAAABAQAgABAAEAsAAAAI4EAAAoAAAAEAAAACAAAAABACAAAAAA diff --git a/yesod-bin/hsfiles/postgres.hsfiles b/yesod-bin/hsfiles/postgres.hsfiles index f3469ebc..34d80db3 100644 --- a/yesod-bin/hsfiles/postgres.hsfiles +++ b/yesod-bin/hsfiles/postgres.hsfiles @@ -37,7 +37,8 @@ import qualified Database.Persist import Database.Persist.Sql (runMigration) import Network.HTTP.Conduit (newManager, conduitManagerSettings) import Control.Monad.Logger (runLoggingT) -import System.Log.FastLogger (newLoggerSet, defaultBufSize) +import Control.Concurrent (forkIO, threadDelay) +import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize) import Network.Wai.Logger (clockDateCacher) import Data.Default (def) import Yesod.Core.Types (loggerSet, Logger (Logger)) @@ -55,7 +56,7 @@ mkYesodDispatch "App" resourcesApp -- performs initialization and creates a WAI application. This is also the -- place to put your migrate statements to have automatic database -- migrations handled by Yesod. -makeApplication :: AppConfig DefaultEnv Extra -> IO Application +makeApplication :: AppConfig DefaultEnv Extra -> IO (Application, LogFunc) makeApplication conf = do foundation <- makeFoundation conf @@ -70,7 +71,8 @@ makeApplication conf = do -- Create the WAI application and apply middlewares app <- toWaiAppPlain foundation - return $ logWare app + let logFunc = messageLoggerSource foundation (appLogger foundation) + return (logWare app, logFunc) -- | Loads up any necessary settings, creates your foundation datatype, and -- performs some initialization. @@ -83,8 +85,18 @@ makeFoundation conf = do Database.Persist.applyEnv p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) - loggerSet' <- newLoggerSet defaultBufSize Nothing - (getter, _) <- clockDateCacher + loggerSet' <- newStdoutLoggerSet defaultBufSize + (getter, updater) <- clockDateCacher + + -- If the Yesod logger (as opposed to the request logger middleware) is + -- used less than once a second on average, you may prefer to omit this + -- thread and use "(updater >> getter)" in place of "getter" below. That + -- would update the cache every time it is used, instead of every second. + let updateLoop = do + threadDelay 1000000 + updater + updateLoop + _ <- forkIO updateLoop let logger = Yesod.Core.Types.Logger loggerSet' getter foundation = App conf s p manager dbconf logger @@ -99,7 +111,7 @@ makeFoundation conf = do -- for yesod devel getApplicationDev :: IO (Int, Application) getApplicationDev = - defaultDevelApp loader makeApplication + defaultDevelApp loader (fmap fst . makeApplication) where loader = Yesod.Default.Config.loadConfig (configSettings Development) { csParseExtra = parseExtra @@ -235,7 +247,10 @@ instance YesodAuth App where case x of Just (Entity uid _) -> return $ Just uid Nothing -> do - fmap Just $ insert $ User (credsIdent creds) Nothing + fmap Just $ insert User + { userIdent = credsIdent creds + , userPassword = Nothing + } -- You can add other plugins like BrowserID, email or OAuth here authPlugins _ = [authBrowserId def, authGoogleEmail] @@ -391,7 +406,7 @@ library DeriveDataTypeable build-depends: base >= 4 && < 5 - , yesod >= 1.2 && < 1.3 + , yesod >= 1.2.5 && < 1.3 , yesod-core >= 1.2 && < 1.3 , yesod-auth >= 1.2 && < 1.3 , yesod-static >= 1.2 && < 1.3 @@ -417,7 +432,7 @@ library , aeson >= 0.6 && < 0.8 , conduit >= 1.0 && < 2.0 , monad-logger >= 0.3 && < 0.4 - , fast-logger >= 2.1 && < 2.2 + , fast-logger >= 2.1.4 && < 2.2 , wai-logger >= 2.1 && < 2.2 executable PROJECTNAME @@ -584,12 +599,12 @@ combineScripts = combineScripts' development combineSettings {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) -import Yesod.Default.Main (defaultMain) +import Yesod.Default.Main (defaultMainLog) import Settings (parseExtra) import Application (makeApplication) main :: IO () -main = defaultMain (fromArgs parseExtra) makeApplication +main = defaultMainLog (fromArgs parseExtra) makeApplication {-# START_FILE BASE64 config/favicon.ico #-} AAABAAIAEBAAAAEAIABoBAAAJgAAABAQAgABAAEAsAAAAI4EAAAoAAAAEAAAACAAAAABACAAAAAA diff --git a/yesod-bin/hsfiles/simple.hsfiles b/yesod-bin/hsfiles/simple.hsfiles index 70a88b89..dd537b8c 100644 --- a/yesod-bin/hsfiles/simple.hsfiles +++ b/yesod-bin/hsfiles/simple.hsfiles @@ -32,7 +32,8 @@ import Network.Wai.Middleware.RequestLogger ) import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import Network.HTTP.Conduit (newManager, conduitManagerSettings) -import System.Log.FastLogger (newLoggerSet, defaultBufSize) +import Control.Concurrent (forkIO, threadDelay) +import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize) import Network.Wai.Logger (clockDateCacher) import Data.Default (def) import Yesod.Core.Types (loggerSet, Logger (Logger)) @@ -50,7 +51,7 @@ mkYesodDispatch "App" resourcesApp -- performs initialization and creates a WAI application. This is also the -- place to put your migrate statements to have automatic database -- migrations handled by Yesod. -makeApplication :: AppConfig DefaultEnv Extra -> IO Application +makeApplication :: AppConfig DefaultEnv Extra -> IO (Application, LogFunc) makeApplication conf = do foundation <- makeFoundation conf @@ -65,7 +66,8 @@ makeApplication conf = do -- Create the WAI application and apply middlewares app <- toWaiAppPlain foundation - return $ logWare app + let logFunc = messageLoggerSource foundation (appLogger foundation) + return (logWare app, logFunc) -- | Loads up any necessary settings, creates your foundation datatype, and -- performs some initialization. @@ -74,8 +76,18 @@ makeFoundation conf = do manager <- newManager conduitManagerSettings s <- staticSite - loggerSet' <- newLoggerSet defaultBufSize Nothing - (getter, _) <- clockDateCacher + loggerSet' <- newStdoutLoggerSet defaultBufSize + (getter, updater) <- clockDateCacher + + -- If the Yesod logger (as opposed to the request logger middleware) is + -- used less than once a second on average, you may prefer to omit this + -- thread and use "(updater >> getter)" in place of "getter" below. That + -- would update the cache every time it is used, instead of every second. + let updateLoop = do + threadDelay 1000000 + updater + updateLoop + _ <- forkIO updateLoop let logger = Yesod.Core.Types.Logger loggerSet' getter foundation = App conf s manager logger @@ -85,7 +97,7 @@ makeFoundation conf = do -- for yesod devel getApplicationDev :: IO (Int, Application) getApplicationDev = - defaultDevelApp loader makeApplication + defaultDevelApp loader (fmap fst . makeApplication) where loader = Yesod.Default.Config.loadConfig (configSettings Development) { csParseExtra = parseExtra @@ -321,7 +333,7 @@ library DeriveDataTypeable build-depends: base >= 4 && < 5 - , yesod >= 1.2 && < 1.3 + , yesod >= 1.2.5 && < 1.3 , yesod-core >= 1.2 && < 1.3 , yesod-auth >= 1.2 && < 1.3 , yesod-static >= 1.2 && < 1.3 @@ -344,7 +356,7 @@ library , aeson >= 0.6 && < 0.8 , conduit >= 1.0 && < 2.0 , monad-logger >= 0.3 && < 0.4 - , fast-logger >= 2.1 && < 2.2 + , fast-logger >= 2.1.4 && < 2.2 , wai-logger >= 2.1 && < 2.2 executable PROJECTNAME @@ -502,12 +514,12 @@ combineScripts = combineScripts' development combineSettings {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) -import Yesod.Default.Main (defaultMain) +import Yesod.Default.Main (defaultMainLog) import Settings (parseExtra) import Application (makeApplication) main :: IO () -main = defaultMain (fromArgs parseExtra) makeApplication +main = defaultMainLog (fromArgs parseExtra) makeApplication {-# START_FILE BASE64 config/favicon.ico #-} AAABAAIAEBAAAAEAIABoBAAAJgAAABAQAgABAAEAsAAAAI4EAAAoAAAAEAAAACAAAAABACAAAAAA diff --git a/yesod-bin/hsfiles/sqlite.hsfiles b/yesod-bin/hsfiles/sqlite.hsfiles index 1ddd6ac1..715e7403 100644 --- a/yesod-bin/hsfiles/sqlite.hsfiles +++ b/yesod-bin/hsfiles/sqlite.hsfiles @@ -37,7 +37,8 @@ import qualified Database.Persist import Database.Persist.Sql (runMigration) import Network.HTTP.Conduit (newManager, conduitManagerSettings) import Control.Monad.Logger (runLoggingT) -import System.Log.FastLogger (newLoggerSet, defaultBufSize) +import Control.Concurrent (forkIO, threadDelay) +import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize) import Network.Wai.Logger (clockDateCacher) import Data.Default (def) import Yesod.Core.Types (loggerSet, Logger (Logger)) @@ -55,7 +56,7 @@ mkYesodDispatch "App" resourcesApp -- performs initialization and creates a WAI application. This is also the -- place to put your migrate statements to have automatic database -- migrations handled by Yesod. -makeApplication :: AppConfig DefaultEnv Extra -> IO Application +makeApplication :: AppConfig DefaultEnv Extra -> IO (Application, LogFunc) makeApplication conf = do foundation <- makeFoundation conf @@ -70,7 +71,8 @@ makeApplication conf = do -- Create the WAI application and apply middlewares app <- toWaiAppPlain foundation - return $ logWare app + let logFunc = messageLoggerSource foundation (appLogger foundation) + return (logWare app, logFunc) -- | Loads up any necessary settings, creates your foundation datatype, and -- performs some initialization. @@ -83,8 +85,18 @@ makeFoundation conf = do Database.Persist.applyEnv p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConf) - loggerSet' <- newLoggerSet defaultBufSize Nothing - (getter, _) <- clockDateCacher + loggerSet' <- newStdoutLoggerSet defaultBufSize + (getter, updater) <- clockDateCacher + + -- If the Yesod logger (as opposed to the request logger middleware) is + -- used less than once a second on average, you may prefer to omit this + -- thread and use "(updater >> getter)" in place of "getter" below. That + -- would update the cache every time it is used, instead of every second. + let updateLoop = do + threadDelay 1000000 + updater + updateLoop + _ <- forkIO updateLoop let logger = Yesod.Core.Types.Logger loggerSet' getter foundation = App conf s p manager dbconf logger @@ -99,7 +111,7 @@ makeFoundation conf = do -- for yesod devel getApplicationDev :: IO (Int, Application) getApplicationDev = - defaultDevelApp loader makeApplication + defaultDevelApp loader (fmap fst . makeApplication) where loader = Yesod.Default.Config.loadConfig (configSettings Development) { csParseExtra = parseExtra @@ -235,7 +247,10 @@ instance YesodAuth App where case x of Just (Entity uid _) -> return $ Just uid Nothing -> do - fmap Just $ insert $ User (credsIdent creds) Nothing + fmap Just $ insert User + { userIdent = credsIdent creds + , userPassword = Nothing + } -- You can add other plugins like BrowserID, email or OAuth here authPlugins _ = [authBrowserId def, authGoogleEmail] @@ -391,7 +406,7 @@ library DeriveDataTypeable build-depends: base >= 4 && < 5 - , yesod >= 1.2 && < 1.3 + , yesod >= 1.2.5 && < 1.3 , yesod-core >= 1.2 && < 1.3 , yesod-auth >= 1.2 && < 1.3 , yesod-static >= 1.2 && < 1.3 @@ -417,7 +432,7 @@ library , aeson >= 0.6 && < 0.8 , conduit >= 1.0 && < 2.0 , monad-logger >= 0.3 && < 0.4 - , fast-logger >= 2.1 && < 2.2 + , fast-logger >= 2.1.4 && < 2.2 , wai-logger >= 2.1 && < 2.2 executable PROJECTNAME @@ -584,12 +599,12 @@ combineScripts = combineScripts' development combineSettings {-# START_FILE app/main.hs #-} import Prelude (IO) import Yesod.Default.Config (fromArgs) -import Yesod.Default.Main (defaultMain) +import Yesod.Default.Main (defaultMainLog) import Settings (parseExtra) import Application (makeApplication) main :: IO () -main = defaultMain (fromArgs parseExtra) makeApplication +main = defaultMainLog (fromArgs parseExtra) makeApplication {-# START_FILE BASE64 config/favicon.ico #-} AAABAAIAEBAAAAEAIABoBAAAJgAAABAQAgABAAEAsAAAAI4EAAAoAAAAEAAAACAAAAABACAAAAAA diff --git a/yesod-bin/input/done.cg b/yesod-bin/input/done.cg index 280f3af4..23261c5b 100644 --- a/yesod-bin/input/done.cg +++ b/yesod-bin/input/done.cg @@ -24,4 +24,4 @@ Take part in the community: http://yesodweb.com/page/community Start your project: - cd PROJECTNAME && cabal sandbox init && cabal install && yesod devel + cd PROJECTNAME && cabal sandbox init && cabal install --enable-tests . yesod-platform yesod-bin --max-backjumps=-1 --reorder-goals && yesod devel diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index 4e8dd9fd..95fcfa2f 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.2.5.6 +version: 1.2.6 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-core/Yesod/Core/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs index df822e2d..e6f489da 100644 --- a/yesod-core/Yesod/Core/Dispatch.hs +++ b/yesod-core/Yesod/Core/Dispatch.hs @@ -41,7 +41,7 @@ import qualified Network.Wai as W import Data.ByteString.Lazy.Char8 () -import Data.Text (Text) +import Data.Text (Text, pack) import Data.Monoid (mappend) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 @@ -118,6 +118,10 @@ toWaiAppYre yre req = toWaiApp :: YesodDispatch site => site -> IO W.Application toWaiApp site = do logger <- makeLogger site + toWaiAppLogger logger site + +toWaiAppLogger :: YesodDispatch site => Logger -> site -> IO W.Application +toWaiAppLogger logger site = do sb <- makeSessionBackend site let yre = YesodRunnerEnv { yreLogger = logger @@ -144,19 +148,29 @@ toWaiApp site = do -- -- Since 1.2.0 warp :: YesodDispatch site => Int -> site -> IO () -warp port site = toWaiApp site >>= Network.Wai.Handler.Warp.runSettings - Network.Wai.Handler.Warp.defaultSettings - { Network.Wai.Handler.Warp.settingsPort = port - {- FIXME - , Network.Wai.Handler.Warp.settingsServerName = S8.pack $ concat - [ "Warp/" - , Network.Wai.Handler.Warp.warpVersion - , " + Yesod/" - , showVersion Paths_yesod_core.version - , " (core)" - ] - -} - } +warp port site = do + logger <- makeLogger site + toWaiAppLogger logger site >>= Network.Wai.Handler.Warp.runSettings + Network.Wai.Handler.Warp.defaultSettings + { Network.Wai.Handler.Warp.settingsPort = port + {- FIXME + , Network.Wai.Handler.Warp.settingsServerName = S8.pack $ concat + [ "Warp/" + , Network.Wai.Handler.Warp.warpVersion + , " + Yesod/" + , showVersion Paths_yesod_core.version + , " (core)" + ] + -} + , Network.Wai.Handler.Warp.settingsOnException = const $ \e -> + messageLoggerSource + site + logger + $(qLocation >>= liftLoc) + "yesod-core" + LevelError + (toLogStr $ "Exception from Warp: " ++ show e) + } -- | A default set of middlewares. -- diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index 3581dbc8..7c561c52 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -640,7 +640,12 @@ cacheSeconds i = setHeader "Cache-Control" $ T.concat -- | Set the Expires header to some date in 2037. In other words, this content -- is never (realistically) expired. neverExpires :: MonadHandler m => m () -neverExpires = setHeader "Expires" "Thu, 31 Dec 2037 23:55:55 GMT" +neverExpires = do + setHeader "Expires" "Thu, 31 Dec 2037 23:55:55 GMT" + cacheSeconds oneYear + where + oneYear :: Int + oneYear = 60 * 60 * 24 * 365 -- | Set an Expires header in the past, meaning this content should not be -- cached. diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs index 25f51f12..10871a27 100644 --- a/yesod-core/Yesod/Core/Internal/Run.hs +++ b/yesod-core/Yesod/Core/Internal/Run.hs @@ -10,7 +10,8 @@ module Yesod.Core.Internal.Run where import Yesod.Core.Internal.Response import Blaze.ByteString.Builder (toByteString) import Control.Applicative ((<$>)) -import Control.Exception (fromException, bracketOnError) +import Control.Exception (fromException, bracketOnError, evaluate) +import qualified Control.Exception as E import Control.Exception.Lifted (catch) import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (liftIO) @@ -94,7 +95,9 @@ runHandler rhe@RunHandlerEnv {..} handler yreq = withInternalState $ \resState - YRWai _ -> return yar let sendFile' ct fp p = return $ YRPlain H.status200 (appEndo headers []) ct (ContentFile fp p) finalSession - case contents of + contents1 <- evaluate contents `E.catch` \e -> return + (HCError $! InternalError $! T.pack $! show (e :: E.SomeException)) + case contents1 of HCContent status (TypedContent ct c) -> do ec' <- liftIO $ evaluateContent c case ec' of diff --git a/yesod-core/test/YesodCoreTest/ErrorHandling.hs b/yesod-core/test/YesodCoreTest/ErrorHandling.hs index 883f2900..333d2b89 100644 --- a/yesod-core/test/YesodCoreTest/ErrorHandling.hs +++ b/yesod-core/test/YesodCoreTest/ErrorHandling.hs @@ -24,6 +24,11 @@ mkYesod "App" [parseRoutes| /error-in-body ErrorInBodyR GET /error-in-body-noeval ErrorInBodyNoEvalR GET /override-status OverrideStatusR GET + +-- https://github.com/yesodweb/yesod/issues/658 +/builder BuilderR GET +/file-bad-len FileBadLenR GET +/file-bad-name FileBadNameR GET |] overrideStatus = mkStatus 15 "OVERRIDE" @@ -74,6 +79,15 @@ getErrorInBodyNoEvalR = fmap DontFullyEvaluate getErrorInBodyR getOverrideStatusR :: Handler () getOverrideStatusR = invalidArgs ["OVERRIDE"] +getBuilderR :: Handler TypedContent +getBuilderR = return $ TypedContent "ignored" $ ContentBuilder (error "builder-3.14159") Nothing + +getFileBadLenR :: Handler TypedContent +getFileBadLenR = return $ TypedContent "ignored" $ ContentFile "yesod-core.cabal" (error "filebadlen") + +getFileBadNameR :: Handler TypedContent +getFileBadNameR = return $ TypedContent "ignored" $ ContentFile (error "filebadname") Nothing + errorHandlingTest :: Spec errorHandlingTest = describe "Test.ErrorHandling" $ do it "says not found" caseNotFound @@ -82,6 +96,9 @@ errorHandlingTest = describe "Test.ErrorHandling" $ do it "error in body == 500" caseErrorInBody it "error in body, no eval == 200" caseErrorInBodyNoEval it "can override status code" caseOverrideStatus + it "builder" caseBuilder + it "file with bad len" caseFileBadLen + it "file with bad name" caseFileBadName runner :: Session () -> IO () runner f = toWaiApp App >>= runSession f @@ -140,3 +157,21 @@ caseOverrideStatus :: IO () caseOverrideStatus = runner $ do res <- request defaultRequest { pathInfo = ["override-status"] } assertStatus 15 res + +caseBuilder :: IO () +caseBuilder = runner $ do + res <- request defaultRequest { pathInfo = ["builder"] } + assertStatus 500 res + assertBodyContains "builder-3.14159" res + +caseFileBadLen :: IO () +caseFileBadLen = runner $ do + res <- request defaultRequest { pathInfo = ["file-bad-len"] } + assertStatus 500 res + assertBodyContains "filebadlen" res + +caseFileBadName :: IO () +caseFileBadName = runner $ do + res <- request defaultRequest { pathInfo = ["file-bad-name"] } + assertStatus 500 res + assertBodyContains "filebadname" res diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index c2c5c915..80467d19 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.2.6.5 +version: 1.2.6.7 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index ea0c85c5..97d00346 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -104,7 +104,7 @@ intField = Field , fieldView = \theId name attrs val isReq -> toWidget [hamlet| $newline never - + |] , fieldEnctype = UrlEncoded } @@ -121,7 +121,7 @@ doubleField = Field , fieldView = \theId name attrs val isReq -> toWidget [hamlet| $newline never - + |] , fieldEnctype = UrlEncoded } diff --git a/yesod-form/Yesod/Form/Input.hs b/yesod-form/Yesod/Form/Input.hs index 6cbe8dd0..dbc88ade 100644 --- a/yesod-form/Yesod/Form/Input.hs +++ b/yesod-form/Yesod/Form/Input.hs @@ -4,6 +4,7 @@ module Yesod.Form.Input ( FormInput (..) , runInputGet , runInputPost + , runInputPostResult , ireq , iopt ) where @@ -66,11 +67,22 @@ toMap :: [(Text, a)] -> Map.Map Text [a] toMap = Map.unionsWith (++) . map (\(x, y) -> Map.singleton x [y]) runInputPost :: MonadHandler m => FormInput m a -> m a -runInputPost (FormInput f) = do +runInputPost fi = do + emx <- runInputPostHelper fi + case emx of + Left errs -> invalidArgs errs + Right x -> return x + +runInputPostResult :: MonadHandler m => FormInput m a -> m (FormResult a) +runInputPostResult fi = do + emx <- runInputPostHelper fi + case emx of + Left errs -> return $ FormFailure errs + Right x -> return $ FormSuccess x + +runInputPostHelper :: MonadHandler m => FormInput m a -> m (Either [Text] a) +runInputPostHelper (FormInput f) = do (env, fenv) <- liftM (toMap *** toMap) runRequestBody m <- getYesod l <- languages - emx <- f m l env fenv - case emx of - Left errs -> invalidArgs $ errs [] - Right x -> return x + fmap (either (Left . ($ [])) Right) $ f m l env fenv diff --git a/yesod-form/Yesod/Form/MassInput.hs b/yesod-form/Yesod/Form/MassInput.hs index 332eb660..a2b434d4 100644 --- a/yesod-form/Yesod/Form/MassInput.hs +++ b/yesod-form/Yesod/Form/MassInput.hs @@ -11,7 +11,7 @@ module Yesod.Form.MassInput import Yesod.Form.Types import Yesod.Form.Functions -import Yesod.Form.Fields (boolField) +import Yesod.Form.Fields (checkBoxField) import Yesod.Core import Control.Monad.Trans.RWS (get, put, ask) import Data.Maybe (fromMaybe) @@ -97,7 +97,7 @@ $newline never |] _ -> do - (_, xml2) <- aFormToForm $ areq boolField FieldSettings + (_, xml2) <- aFormToForm $ areq checkBoxField FieldSettings { fsLabel = SomeMessage MsgDelete , fsTooltip = Nothing , fsName = Just deleteName diff --git a/yesod-form/Yesod/Form/Types.hs b/yesod-form/Yesod/Form/Types.hs index 5dc79657..f5a75008 100644 --- a/yesod-form/Yesod/Form/Types.hs +++ b/yesod-form/Yesod/Form/Types.hs @@ -102,7 +102,7 @@ instance Monad m => Applicative (AForm m) where (AForm f) <*> (AForm g) = AForm $ \mr env ints -> do (a, b, ints', c) <- f mr env ints (x, y, ints'', z) <- g mr env ints' - return (a <*> x, b `mappend` y, ints'', c `mappend` z) + return (a <*> x, b . y, ints'', c `mappend` z) instance (Monad m, Monoid a) => Monoid (AForm m a) where mempty = pure mempty mappend a b = mappend <$> a <*> b diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index 80264bfd..8665c89f 100644 --- a/yesod-form/yesod-form.cabal +++ b/yesod-form/yesod-form.cabal @@ -1,5 +1,5 @@ name: yesod-form -version: 1.3.4.3 +version: 1.3.5.1 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-newsfeed/Yesod/AtomFeed.hs b/yesod-newsfeed/Yesod/AtomFeed.hs index a9c0d257..95c03c92 100644 --- a/yesod-newsfeed/Yesod/AtomFeed.hs +++ b/yesod-newsfeed/Yesod/AtomFeed.hs @@ -62,7 +62,7 @@ template Feed {..} render = : Element "link" (Map.singleton "href" $ render feedLinkHome) [] : Element "updated" Map.empty [NodeContent $ formatW3 feedUpdated] : Element "id" Map.empty [NodeContent $ render feedLinkHome] - : Element "author" Map.empty [NodeContent feedAuthor] + : Element "author" Map.empty [NodeElement $ Element "name" Map.empty [NodeContent feedAuthor]] : map (flip entryTemplate render) feedEntries entryTemplate :: FeedEntry url -> (url -> Text) -> Element diff --git a/yesod-newsfeed/yesod-newsfeed.cabal b/yesod-newsfeed/yesod-newsfeed.cabal index cdca81ab..6b4c6f49 100644 --- a/yesod-newsfeed/yesod-newsfeed.cabal +++ b/yesod-newsfeed/yesod-newsfeed.cabal @@ -1,5 +1,5 @@ name: yesod-newsfeed -version: 1.2.0 +version: 1.2.0.1 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin diff --git a/yesod-platform/yesod-platform.cabal b/yesod-platform/yesod-platform.cabal index 5c916b2c..a580a35c 100644 --- a/yesod-platform/yesod-platform.cabal +++ b/yesod-platform/yesod-platform.cabal @@ -1,5 +1,5 @@ name: yesod-platform -version: 1.2.6 +version: 1.2.7.1 license: MIT license-file: LICENSE author: Michael Snoyman @@ -15,9 +15,10 @@ homepage: http://www.yesodweb.com/ library build-depends: base >= 4 && < 5 , SHA == 1.6.4 - , aeson == 0.7.0.0 - , ansi-terminal == 0.6.1 - , asn1-data == 0.7.1 + , aeson == 0.7.0.1 + , ansi-terminal == 0.6.1.1 + , asn1-encoding == 0.8.1.2 + , asn1-parse == 0.8.1 , asn1-types == 0.2.3 , attoparsec == 0.11.1.0 , attoparsec-conduit == 1.0.1.2 @@ -26,21 +27,17 @@ library , base64-bytestring == 1.0.0.1 , blaze-builder == 0.3.3.2 , blaze-builder-conduit == 1.0.0 - , blaze-html == 0.6.1.3 - , blaze-markup == 0.5.2.1 + , blaze-html == 0.7.0.1 + , blaze-markup == 0.6.0.0 , byteable == 0.1.1 , byteorder == 1.0.4 , case-insensitive == 1.1.0.3 , cereal == 0.4.0.1 - , certificate == 1.3.9 , cipher-aes == 0.2.6 - , cipher-blowfish == 0.0.3 - , cipher-camellia == 0.0.2 - , cipher-des == 0.0.6 , cipher-rc4 == 0.1.4 , clientsession == 0.9.0.3 - , conduit == 1.0.10 - , connection == 0.1.3.1 + , conduit == 1.0.14 + , connection == 0.2.0 , control-monad-loop == 0.1 , cookie == 0.4.0.1 , cprng-aes == 0.5.2 @@ -51,9 +48,7 @@ library , crypto-pubkey == 0.2.4 , crypto-pubkey-types == 0.4.1 , crypto-random == 0.0.7 - , crypto-random-api == 0.2.0 - , cryptocipher == 0.6.2 - , cryptohash == 0.11.1 + , cryptohash == 0.11.2 , cryptohash-cryptoapi == 0.1.0 , css-text == 0.1.1 , data-default == 0.5.3 @@ -63,38 +58,38 @@ library , data-default-instances-dlist == 0.0.1 , data-default-instances-old-locale == 0.0.1 , dlist == 0.6.0.1 - , email-validate == 1.0.0 + , email-validate == 2.0.1 , entropy == 0.2.2.4 - , esqueleto == 1.3.4.3 + , esqueleto == 1.3.4.5 , failure == 0.2.0.1 - , fast-logger == 2.1.4 + , fast-logger == 2.1.5 , file-embed == 0.0.6 , filesystem-conduit == 1.0.0.1 - , hamlet == 1.1.7.6 - , hjsmin == 0.1.4.4 - , hspec == 1.8.1.1 + , hamlet == 1.1.7.7 + , hjsmin == 0.1.4.5 + , hspec == 1.8.3 , hspec-expectations == 0.5.0.1 , html-conduit == 1.1.0.1 - , http-attoparsec == 0.1.1 - , http-client == 0.2.1 + , http-client == 0.2.2.2 , http-client-conduit == 0.2.0.1 - , http-client-tls == 0.2.0.2 - , http-conduit == 2.0.0.3 + , http-client-tls == 0.2.1.1 + , http-conduit == 2.0.0.5 , http-date == 0.0.4 , http-types == 0.8.3 , language-javascript == 0.5.8 - , lifted-base == 0.2.1.1 - , mime-mail == 0.4.3 + , lifted-base == 0.2.2.0 + , mime-mail == 0.4.4 , mime-types == 0.1.0.3 - , mmorph == 1.0.1 - , monad-control == 0.3.2.2 + , mmorph == 1.0.2 + , monad-control == 0.3.2.3 , monad-logger == 0.3.4.0 , monad-loops == 0.4.2 - , network-conduit == 1.0.1 + , network-conduit == 1.0.2.2 + , optparse-applicative == 0.7.0.2 , path-pieces == 0.1.3.1 , pem == 0.2.1 , persistent == 1.3.0.2 - , persistent-template == 1.3.1 + , persistent-template == 1.3.1.1 , pool-conduit == 0.1.2 , primitive == 0.5.1.0 , process-conduit == 1.0.0.1 @@ -104,16 +99,16 @@ library , quickcheck-io == 0.1.0 , resource-pool == 0.2.1.1 , resourcet == 0.4.10 - , safe == 0.3.3 + , safe == 0.3.4 , scientific == 0.2.0.1 , securemem == 0.1.3 , semigroups == 0.12.2 - , setenv == 0.1.1 + , setenv == 0.1.1.1 , shakespeare == 1.2.0.4 , shakespeare-css == 1.0.6.6 , shakespeare-i18n == 1.0.0.5 - , shakespeare-js == 1.2.0.2 - , shakespeare-text == 1.0.0.10 + , shakespeare-js == 1.2.0.3 + , shakespeare-text == 1.0.1 , silently == 1.2.4.1 , simple-sendfile == 0.2.13 , skein == 1.0.8.1 @@ -123,10 +118,10 @@ library , system-fileio == 0.3.12 , system-filepath == 0.4.9 , tagged == 0.7 - , tagsoup == 0.13 - , tagstream-conduit == 0.5.4.1 - , tls == 1.1.5 - , tls-extra == 0.6.6 + , tagsoup == 0.13.1 + , tagstream-conduit == 0.5.5 + , text-stream-decode == 0.1.0.3 + , tls == 1.2.2 , transformers-base == 0.4.1 , unix-compat == 0.4.1.1 , unordered-containers == 0.2.3.3 @@ -136,20 +131,24 @@ library , void == 0.6.1 , wai == 2.0.0 , wai-app-static == 2.0.0.2 - , wai-extra == 2.0.2 + , wai-extra == 2.0.3.3 , wai-logger == 2.1.1 , wai-test == 2.0.0.1 - , warp == 2.0.2 - , warp-tls == 2.0.1 + , warp == 2.0.3.2 + , warp-tls == 2.0.2 , word8 == 0.0.4 + , x509 == 1.4.7 + , x509-store == 1.4.4 + , x509-system == 1.4.2 + , x509-validation == 1.5.0 , xml-conduit == 1.1.0.9 , xml-types == 0.3.4 , xss-sanitize == 0.3.4.2 - , yaml == 0.8.5.3 - , yesod == 1.2.4 - , yesod-auth == 1.2.5.2 - , yesod-core == 1.2.6.5 - , yesod-form == 1.3.4.2 + , yaml == 0.8.7.2 + , yesod == 1.2.5 + , yesod-auth == 1.2.5.3 + , yesod-core == 1.2.6.7 + , yesod-form == 1.3.5.1 , yesod-persistent == 1.2.2.1 , yesod-routes == 1.2.0.6 , yesod-static == 1.2.2.1 diff --git a/yesod/Yesod/Default/Main.hs b/yesod/Yesod/Default/Main.hs index 955aa7a6..0780539a 100644 --- a/yesod/Yesod/Default/Main.hs +++ b/yesod/Yesod/Default/Main.hs @@ -1,15 +1,19 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Yesod.Default.Main ( defaultMain + , defaultMainLog , defaultRunner , defaultDevelApp + , LogFunc ) where import Yesod.Default.Config import Network.Wai (Application) import Network.Wai.Handler.Warp - (runSettings, defaultSettings, settingsPort, settingsHost) + (runSettings, defaultSettings, settingsPort, settingsHost, settingsOnException) import System.Directory (doesDirectoryExist, removeDirectoryRecursive) import Network.Wai.Middleware.Gzip (gzip, GzipFiles (GzipCacheFolder), gzipFiles, def) import Network.Wai.Middleware.Autohead (autohead) @@ -18,6 +22,9 @@ import Control.Monad (when) import System.Environment (getEnvironment) import Data.Maybe (fromMaybe) import Safe (readMay) +import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError), liftLoc) +import System.Log.FastLogger (LogStr, toLogStr) +import Language.Haskell.TH.Syntax (qLocation) #ifndef WINDOWS import qualified System.Posix.Signals as Signal @@ -45,6 +52,29 @@ defaultMain load getApp = do , settingsHost = appHost config } app +type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () + +-- | Same as @defaultMain@, but gets a logging function back as well as an +-- @Application@ to install Warp exception handlers. +-- +-- Since 1.2.5 +defaultMainLog :: (Show env, Read env) + => IO (AppConfig env extra) + -> (AppConfig env extra -> IO (Application, LogFunc)) + -> IO () +defaultMainLog load getApp = do + config <- load + (app, logFunc) <- getApp config + runSettings defaultSettings + { settingsPort = appPort config + , settingsHost = appHost config + , settingsOnException = const $ \e -> logFunc + $(qLocation >>= liftLoc) + "yesod" + LevelError + (toLogStr $ "Exception from Warp: " ++ show e) + } app + -- | Run your application continously, listening for SIGINT and exiting -- when received -- diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index 88aff16b..1d3f5ee8 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -1,5 +1,5 @@ name: yesod -version: 1.2.4 +version: 1.2.5 license: MIT license-file: LICENSE author: Michael Snoyman @@ -46,6 +46,8 @@ library , directory , template-haskell , bytestring + , monad-logger + , fast-logger exposed-modules: Yesod , Yesod.Default.Config