fix yesod devel

This commit is contained in:
Greg Weber 2011-08-22 20:38:19 -07:00
parent 2adc337fa1
commit 7e6999ba37
3 changed files with 19 additions and 17 deletions

View File

@ -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 ()"

View File

@ -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 ()

View File

@ -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