From e59b0a1c884b4222162b444d0d306f67f2a6ca30 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 8 Sep 2012 19:57:15 -0400 Subject: 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. --- Assistant/Threads/WebApp.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'Assistant/Threads/WebApp.hs') 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 -- cgit v1.2.3