diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-09-08 19:57:15 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-09-08 19:57:15 -0400 |
| commit | e59b0a1c884b4222162b444d0d306f67f2a6ca30 (patch) | |
| tree | 78c2b8c0cfe9c6c52e31b0de2b4a730a7f080635 /Assistant/Threads/WebApp.hs | |
| parent | e6e0877378af85293356b1c7d644a6df6cc40415 (diff) | |
first pass at alert buttons
They work fine. But I had to go to a lot of trouble to get Yesod to render
routes in a pure function. It may instead make more sense to have each
alert have an assocated IO action, and a single route that runs the IO
action of a given alert id. I just wish I'd realized that before the past
several hours of struggling with something Yesod really doesn't want to
allow.
Diffstat (limited to 'Assistant/Threads/WebApp.hs')
| -rw-r--r-- | Assistant/Threads/WebApp.hs | 11 |
1 files changed, 7 insertions, 4 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 54627f38e..d7d5c2602 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -49,10 +49,11 @@ webAppThread -> ScanRemoteMap -> TransferQueue -> TransferSlots + -> UrlRenderer -> Maybe (IO String) -> Maybe (Url -> FilePath -> IO ()) -> NamedThread -webAppThread mst dstatus scanremotes transferqueue transferslots postfirstrun onstartup = thread $ do +webAppThread mst dstatus scanremotes transferqueue transferslots urlrenderer postfirstrun onstartup = thread $ do webapp <- WebApp <$> pure mst <*> pure dstatus @@ -64,14 +65,16 @@ webAppThread mst dstatus scanremotes transferqueue transferslots postfirstrun on <*> pure $(embed "static") <*> newWebAppState <*> pure postfirstrun + setUrlRenderer urlrenderer $ yesodRender webapp (pack "") app <- toWaiAppPlain webapp app' <- ifM debugEnabled ( return $ httpDebugLogger app , return app ) - runWebApp app' $ \port -> case mst of - Nothing -> withTempFile "webapp.html" $ \tmpfile _ -> go port webapp tmpfile - Just st -> go port webapp =<< runThreadState st (fromRepo gitAnnexHtmlShim) + runWebApp app' $ \port -> do + case mst of + Nothing -> withTempFile "webapp.html" $ \tmpfile _ -> go port webapp tmpfile + Just st -> go port webapp =<< runThreadState st (fromRepo gitAnnexHtmlShim) where thread = NamedThread thisThread getreldir Nothing = return Nothing |