diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-07-27 15:33:24 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-07-27 15:33:24 -0400 |
| commit | 02ec8ea01254637facb30f77b7cb74be3b735c0d (patch) | |
| tree | 3ba054919ab49a457c287163d5b41f8f4e3e5678 /Assistant/Threads/WebApp.hs | |
| parent | bc5b1516175f143f42bda2d12f512768d2df7c9e (diff) | |
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.
Diffstat (limited to 'Assistant/Threads/WebApp.hs')
| -rw-r--r-- | Assistant/Threads/WebApp.hs | 8 |
1 files changed, 5 insertions, 3 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 171c7fd9c..f0acaeb22 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -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) |