fix yesod devel
This commit is contained in:
parent
2adc337fa1
commit
7e6999ba37
@ -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 ()"
|
||||
|
||||
@ -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 ()
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user