summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-26 17:56:24 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-07-26 17:56:24 -0400
commit9fd03c65f9ebee437317a21e27afb600d9815209 (patch)
tree9799150f582e59d8a343e9ceaebce3dc65897605 /Assistant
parente79198aacbb7891b0b7a4d156160a1524038e18c (diff)
webapp now does long polling
The webapp is now a constantly updating clock! I accomplished this amazing feat using "long polling", with some jquery and a little custom java script. There are more modern techniques, but this one works everywhere.
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Threads/WebApp.hs20
1 files changed, 19 insertions, 1 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index d663b0cd5..2d78609e8 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -21,9 +21,11 @@ import Git
import Yesod
import Yesod.Static
import Text.Hamlet
+import Text.Julius
import Network.Socket (PortNumber)
import Text.Blaze.Renderer.String
import Data.Text
+import Data.Time.Clock
thisThread :: String
thisThread = "WebApp"
@@ -39,6 +41,7 @@ staticFiles "static"
mkYesod "WebApp" [parseRoutes|
/ HomeR GET
+/poll PollR GET
/config ConfigR GET
/static StaticR Static getStatic
|]
@@ -61,10 +64,25 @@ instance Yesod WebApp where
excludeStatic (p:_) = p /= "static"
makeSessionBackend = webAppSessionBackend
+ jsLoader _ = BottomOfHeadBlocking
getHomeR :: Handler RepHtml
getHomeR = defaultLayout $ do
- [whamlet|Hello, World<p><a href="@{ConfigR}">config|]
+ [whamlet|<div id="poll">Starting ...|]
+ addScriptRemote "http://ajax.googleapis.com/ajax/libs/jquery/1.6.2/jquery.min.js"
+ toWidgetBody $(juliusFile $ juliusTemplate "longpolling")
+ [whamlet|<p><a href="@{ConfigR}">config|]
+
+{- Called by client to poll for a new webapp status display.
+ -
+ - Should block until the status has changed, and then return a div
+ - containing the new status, which will be inserted into the calling page.
+ -}
+getPollR :: Handler RepHtml
+getPollR = do
+ webapp <- getYesod
+ time <- show <$> liftIO getCurrentTime
+ hamletToRepHtml $(hamletFile $ hamletTemplate "poll")
getConfigR :: Handler RepHtml
getConfigR = defaultLayout $ do