diff options
| -rw-r--r-- | Assistant/Threads/WebApp.hs | 44 | ||||
| -rw-r--r-- | templates/longpolling.julius | 6 | ||||
| -rw-r--r-- | templates/metarefresh.hamlet | 2 | ||||
| -rw-r--r-- | templates/transfers.hamlet | 13 |
4 files changed, 38 insertions, 27 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index d9d98e1bf..e47ee9fda 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -51,6 +51,7 @@ staticFiles "static" mkYesod "WebApp" [parseRoutes| / HomeR GET /noscript NoScriptR GET +/noscriptauto NoScriptAutoR GET /transfers/#NotificationId TransfersR GET /config ConfigR GET /static StaticR Static getStatic @@ -86,7 +87,7 @@ instance Yesod WebApp where makeSessionBackend = webAppSessionBackend jsLoader _ = BottomOfHeadBlocking -{- Add to any widget to make it auto-update. +{- Add to any widget to make it auto-update using long polling. - - The widget should have a html element with an id=ident, which will be - replaced when it's updated. @@ -97,25 +98,16 @@ instance Yesod WebApp where - - ms_delay is how long to delay between AJAX updates - ms_startdelay is how long to delay before updating with AJAX at the start - - ms_refreshdelay is how long to delay between refreshes, when not using AJAX -} -autoUpdate :: Text -> Route WebApp -> Route WebApp -> Int -> Int -> Int -> Widget -autoUpdate ident gethtml home ms_delay ms_startdelay ms_refreshdelay = do - {- Fallback refreshing is provided for non-javascript browsers. -} - let delayseconds = ms_to_seconds ms_refreshdelay - toWidgetHead $(hamletFile $ hamletTemplate "metarefresh") - - {- Use long polling to update the transfers display. -} +autoUpdate :: Text -> Route WebApp -> Route WebApp -> Int -> Int -> Widget +autoUpdate ident gethtml home ms_delay ms_startdelay = do let delay = show ms_delay let startdelay = show ms_startdelay $(widgetFile "longpolling") - where - ms_to_seconds :: Int -> Int - ms_to_seconds ms = ceiling ((fromIntegral ms :: Double) / 1000) {- A display of currently running and queued transfers. -} -transfersDisplay :: Widget -transfersDisplay = do +transfersDisplay :: Bool -> Widget +transfersDisplay warnNoScript = do webapp <- lift getYesod current <- liftIO $ runThreadState (threadState webapp) $ M.toList . currentTransfers @@ -132,8 +124,8 @@ getNotificationBroadcaster :: WebApp -> IO NotificationBroadcaster getNotificationBroadcaster webapp = notificationBroadcaster <$> getDaemonStatus (daemonStatus webapp) -dashboard :: Widget -dashboard = transfersDisplay +dashboard :: Bool -> Widget +dashboard warnNoScript = transfersDisplay warnNoScript getHomeR :: Handler RepHtml getHomeR = defaultLayout $ do @@ -142,18 +134,24 @@ getHomeR = defaultLayout $ do nid <- liftIO $ notificationHandleToId <$> (newNotificationHandle =<< getNotificationBroadcaster webapp) autoUpdate transfersDisplayIdent (TransfersR nid) HomeR - (10 :: Int) (10 :: Int) (3000 :: Int) + (10 :: Int) (10 :: Int) - dashboard + dashboard True {- Same as HomeR, except with no javascript, so it doesn't allocate - - new resources each time the page is refreshed. -} -getNoScriptR :: Handler RepHtml -getNoScriptR = defaultLayout $ do + - new resources each time the page is refreshed, and with autorefreshing + - via meta refresh. -} +getNoScriptAutoR :: Handler RepHtml +getNoScriptAutoR = defaultLayout $ do let ident = NoScriptR let delayseconds = 3 :: Int + let this = NoScriptAutoR toWidgetHead $(hamletFile $ hamletTemplate "metarefresh") - dashboard + dashboard False + +getNoScriptR :: Handler RepHtml +getNoScriptR = defaultLayout $ + dashboard True {- Called by client to get a display of currently in process transfers. - @@ -170,7 +168,7 @@ getTransfersR nid = do b <- liftIO $ getNotificationBroadcaster webapp liftIO $ waitNotification $ notificationHandleFromId b nid - page <- widgetToPageContent transfersDisplay + page <- widgetToPageContent $ transfersDisplay False hamletToRepHtml $ [hamlet|^{pageBody page}|] getConfigR :: Handler RepHtml diff --git a/templates/longpolling.julius b/templates/longpolling.julius index 945ef1251..926249a35 100644 --- a/templates/longpolling.julius +++ b/templates/longpolling.julius @@ -17,7 +17,7 @@ $.LongPoll = (function() { 'dataType': 'html', 'success': function(data, status, jqxhr) { $('##{ident}').replaceWith(data); - setTimeout($.LongPoll.send, #{delay}); + setTimeout($.LongPoll.send, #{show delay}); numerrs=0; }, 'error': function(jqxhr, msg, e) { @@ -26,7 +26,7 @@ $.LongPoll = (function() { window.close(); } else { - setTimeout($.LongPoll.send, #{delay}); + setTimeout($.LongPoll.send, #{show delay}); } }, }); @@ -35,7 +35,7 @@ $.LongPoll = (function() { }()); $(document).bind('ready.app', function() { - setTimeout($.LongPoll.send, #{startdelay}); + setTimeout($.LongPoll.send, #{show startdelay}); }); })( jQuery ); diff --git a/templates/metarefresh.hamlet b/templates/metarefresh.hamlet index ddbd225fe..89a2e0b2c 100644 --- a/templates/metarefresh.hamlet +++ b/templates/metarefresh.hamlet @@ -1,2 +1,2 @@ <noscript> - <meta http-equiv="refresh" content="#{show delayseconds}; URL=@{NoScriptR}"> + <meta http-equiv="refresh" content="#{show delayseconds}; URL=@{this}"> diff --git a/templates/transfers.hamlet b/templates/transfers.hamlet index 154e8d58b..5df453315 100644 --- a/templates/transfers.hamlet +++ b/templates/transfers.hamlet @@ -1,4 +1,17 @@ <span ##{ident}> + $if warnNoScript + <noscript> + <div .alert .alert-block> + <h4 .alert-heading>Javascript is disabled + <p> + This display cannot update in real-time without Javascript. # + Can you turn it on? + <p> + Otherwise, there are two options: + <p> + <div .btn-group> + <a .btn href="@{NoScriptAutoR}">Auto-refresh every 3 seconds # + <a .btn href="@{NoScriptR}">Manually refresh <div .span9> $if null transfers <h2>No current transfers |