much better webapp startup of the assistant

This avoids forking another process, avoids polling, fixes a race,
and avoids a rare forkProcess thread hang that I saw once time
when starting the webapp.
This commit is contained in:
Joey Hess 2012-07-27 15:33:24 -04:00
parent bc5b151617
commit 02ec8ea012
5 changed files with 27 additions and 40 deletions

View file

@ -145,15 +145,17 @@ getConfigR = defaultLayout $ do
setTitle "configuration"
[whamlet|<a href="@{HomeR}">main|]
webAppThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> IO ()
webAppThread st dstatus transferqueue = do
webAppThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Maybe (IO ()) -> IO ()
webAppThread st dstatus transferqueue onstartup = do
webapp <- mkWebApp
app <- toWaiAppPlain webapp
app' <- ifM debugEnabled
( return $ httpDebugLogger app
, return app
)
runWebApp app' $ \port -> runThreadState st $ writeHtmlShim webapp port
runWebApp app' $ \port -> do
runThreadState st $ writeHtmlShim webapp port
maybe noop id onstartup
where
mkWebApp = do
dir <- absPath =<< runThreadState st (fromRepo repoPath)