diff --git a/yesod/Scaffold/Devel.hs b/yesod/Scaffold/Devel.hs index 1353d0cb..57231074 100644 --- a/yesod/Scaffold/Devel.hs +++ b/yesod/Scaffold/Devel.hs @@ -83,11 +83,11 @@ devel cabalCmd = do , concat [ "import \"" , pi' - , "\" Application (withDevelAppPort)" + , "\" Application (withDevelApp)" ] , "import Data.Dynamic (fromDynamic)" , "import Network.Wai.Handler.Warp (run)" - , "import Network.Wai.Middleware.Debug (debug)" + , "import Network.Wai.Middleware.Debug (debugHandle)" , "import Data.Maybe (fromJust)" , "import Control.Concurrent (forkIO)" , "import System.Directory (doesFileExist, removeFile)" @@ -97,7 +97,7 @@ devel cabalCmd = do , "main = do" , " putStrLn \"Starting app\"" , " wdap <- return $ fromJust $ fromDynamic withDevelAppPort" - , " forkIO $ wdap $ \\(port, app) -> run port app" + , " forkIO $ wdap $ \\(port, debugLogHandle app) -> (run port . debugHandle debugLogHandle) app" , " loop" , "" , "loop :: IO ()" diff --git a/yesod/scaffold/Application.hs.cg b/yesod/scaffold/Application.hs.cg index 7a3ce2df..24e9f42c 100644 --- a/yesod/scaffold/Application.hs.cg +++ b/yesod/scaffold/Application.hs.cg @@ -68,8 +68,8 @@ with~sitearg~ conf logger f = do #endif -- for yesod devel -withDevelAppPort :: Dynamic -withDevelAppPort = +withDevelApp :: Dynamic +withDevelApp = toDyn go where go :: ((Int, Application) -> IO ()) -> IO () diff --git a/yesod/scaffold/tiny/Application.hs.cg b/yesod/scaffold/tiny/Application.hs.cg index e9b6b23e..0db09107 100644 --- a/yesod/scaffold/tiny/Application.hs.cg +++ b/yesod/scaffold/tiny/Application.hs.cg @@ -46,16 +46,18 @@ with~sitearg~ conf logger f = do s = staticDevel Settings.staticDir #endif -with~sitearg~LoadConfig :: Settings.AppEnvironment -> (Application -> IO a) -> IO a -with~sitearg~LoadConfig env f = do - conf <- Settings.loadConfig env - logger <- makeLogger - r <- with~sitearg~ conf logger f - flushLogger logger - return r - - +-- for yesod devel withDevelApp :: Dynamic -withDevelApp = do - toDyn ((with~sitearg~LoadConfig Settings.Development):: (Application -> IO ()) -> IO ()) - +withDevelApp = + toDyn go + where + go :: ((Int, Application) -> IO ()) -> IO () + go f = do + conf <- Settings.loadConfig Settings.Development + let port = appPort conf + logger <- makeLogger + logString logger $ "Devel application launched, listening on port " ++ show port + with~sitearg~ conf logger $ \app -> f (port, debugHandle (logHandle logger) app) + flushLogger logger + where + logHandle logger msg = logLazyText logger msg >> flushLogger logger