mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

update the sidebar by long polling

Browse source 
Needs to use a different NotificationBroadcaster, and not replace the
whole sidebar div, but instead add in new content. However, it's 3:30 am.
This commit is contained in:
Joey Hess 2012-07-29 03:23:17 -04:00
parent e96107caf3
commit 62dac85880
5 changed files with 120 additions and 90 deletions
Download patch file Download diff file Expand all files Collapse all files

110
Assistant/Threads/WebApp.hs
View file

@ -33,6 +33,7 @@ import Network.Socket (PortNumber)
import Text.Blaze.Renderer.String import Text.Blaze.Renderer.String
import Data.Text (Text, pack, unpack) import Data.Text (Text, pack, unpack)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Time.Clock
thisThread :: String thisThread :: String
thisThread = "WebApp" thisThread = "WebApp"
@ -46,6 +47,10 @@ data WebApp = WebApp
, getStatic :: Static , getStatic :: Static
} }
getNotificationBroadcaster :: WebApp -> IO NotificationBroadcaster
getNotificationBroadcaster webapp = notificationBroadcaster
<$> getDaemonStatus (daemonStatus webapp)
staticFiles "static" staticFiles "static"
mkYesod "WebApp" [parseRoutes| mkYesod "WebApp" [parseRoutes|
@ -53,6 +58,7 @@ mkYesod "WebApp" [parseRoutes|
/noscript NoScriptR GET /noscript NoScriptR GET
/noscriptauto NoScriptAutoR GET /noscriptauto NoScriptAutoR GET
/transfers/#NotificationId TransfersR GET /transfers/#NotificationId TransfersR GET
/sidebar/#NotificationId SideBarR GET
/config ConfigR GET /config ConfigR GET
/static StaticR Static getStatic /static StaticR Static getStatic
|] |]
@ -62,8 +68,7 @@ instance PathPiece NotificationId where
fromPathPiece = readish . unpack fromPathPiece = readish . unpack
instance Yesod WebApp where instance Yesod WebApp where
defaultLayout widget = do defaultLayout content = do
mmsg <- getMessage
webapp <- getYesod webapp <- getYesod
page <- widgetToPageContent $ do page <- widgetToPageContent $ do
addStylesheet $ StaticR css_bootstrap_css addStylesheet $ StaticR css_bootstrap_css
@ -93,14 +98,12 @@ instance Yesod WebApp where
- replaced when it's updated. - replaced when it's updated.
- -
- Updating is done by getting html from the gethtml route. - Updating is done by getting html from the gethtml route.
- Or, the home route is used if the whole page has to be refreshed to
- update.
- -
- ms_delay is how long to delay between AJAX updates - 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_startdelay is how long to delay before updating with AJAX at the start
-} -}
autoUpdate :: Text -> Route WebApp -> Route WebApp -> Int -> Int -> Widget autoUpdate :: Text -> Route WebApp -> Int -> Int -> Widget
autoUpdate ident gethtml home ms_delay ms_startdelay = do autoUpdate ident gethtml ms_delay ms_startdelay = do
let delay = show ms_delay let delay = show ms_delay
let startdelay = show ms_startdelay let startdelay = show ms_startdelay
$(widgetFile "longpolling") $(widgetFile "longpolling")
@ -120,39 +123,6 @@ transfersDisplay warnNoScript = do
transfersDisplayIdent :: Text transfersDisplayIdent :: Text
transfersDisplayIdent = "transfers" transfersDisplayIdent = "transfers"
getNotificationBroadcaster :: WebApp -> IO NotificationBroadcaster
getNotificationBroadcaster webapp = notificationBroadcaster
<$> getDaemonStatus (daemonStatus webapp)
dashboard :: Bool -> Widget
dashboard warnNoScript = transfersDisplay warnNoScript
getHomeR :: Handler RepHtml
getHomeR = defaultLayout $ do
{- Set up automatic updates for the transfers display. -}
webapp <- lift getYesod
nid <- liftIO $ notificationHandleToId <$>
(newNotificationHandle =<< getNotificationBroadcaster webapp)
autoUpdate transfersDisplayIdent (TransfersR nid) HomeR
(10 :: Int) (10 :: Int)
dashboard True
{- Same as HomeR, except with no javascript, so it doesn't allocate
- 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 False
getNoScriptR :: Handler RepHtml
getNoScriptR = defaultLayout $
dashboard True
{- Called by client to get a display of currently in process transfers. {- Called by client to get a display of currently in process transfers.
- -
- Returns a div, which will be inserted into the calling page. - Returns a div, which will be inserted into the calling page.
@ -171,8 +141,70 @@ getTransfersR nid = do
page <- widgetToPageContent $ transfersDisplay False page <- widgetToPageContent $ transfersDisplay False
hamletToRepHtml $ [hamlet|^{pageBody page}|] hamletToRepHtml $ [hamlet|^{pageBody page}|]
sideBarDisplay :: Bool -> Widget
sideBarDisplay noScript = do
date <- liftIO $ show <$> getCurrentTime
ident <- lift newIdent
mmsg <- lift getMessage
$(widgetFile "sidebar")
unless noScript $ do
{- Set up automatic updates of the sidebar. -}
webapp <- lift getYesod
nid <- liftIO $ notificationHandleToId <$>
(newNotificationHandle =<< getNotificationBroadcaster webapp)
autoUpdate ident (SideBarR nid) (10 :: Int) (10 :: Int)
{- Called by client to get a sidebar display.
-
- Returns a div, which will be inserted into the calling page.
-
- Note that the head of the widget is not included, only its
- body is. To get the widget head content, the widget is also
- inserted onto all pages.
-}
getSideBarR :: NotificationId -> Handler RepHtml
getSideBarR nid = do
{- Block until there is a change from last time. -}
webapp <- getYesod
b <- liftIO $ getNotificationBroadcaster webapp
liftIO $ waitNotification $ notificationHandleFromId b nid
page <- widgetToPageContent $ sideBarDisplay True
hamletToRepHtml $ [hamlet|^{pageBody page}|]
dashboard :: Bool -> Bool -> Widget
dashboard noScript warnNoScript = do
sideBarDisplay noScript
transfersDisplay warnNoScript
getHomeR :: Handler RepHtml
getHomeR = defaultLayout $ do
{- Set up automatic updates for the transfers display. -}
webapp <- lift getYesod
nid <- liftIO $ notificationHandleToId <$>
(newNotificationHandle =<< getNotificationBroadcaster webapp)
autoUpdate transfersDisplayIdent (TransfersR nid) (10 :: Int) (10 :: Int)
dashboard False True
{- Same as HomeR, except with no javascript, so it doesn't allocate
- 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 True False
getNoScriptR :: Handler RepHtml
getNoScriptR = defaultLayout $
dashboard True True
getConfigR :: Handler RepHtml getConfigR :: Handler RepHtml
getConfigR = defaultLayout $ do getConfigR = defaultLayout $ do
sideBarDisplay False
setTitle "configuration" setTitle "configuration"
[whamlet|<a href="@{HomeR}">main|] [whamlet|<a href="@{HomeR}">main|]

8
templates/longpolling.julius
View file

@ -9,7 +9,7 @@
numerrs=0; numerrs=0;
$.LongPoll = (function() { $.LongPoll#{ident} = (function() {
return { return {
send : function() { send : function() {
$.ajax({ $.ajax({
@ -17,7 +17,7 @@ $.LongPoll = (function() {
'dataType': 'html', 'dataType': 'html',
'success': function(data, status, jqxhr) { 'success': function(data, status, jqxhr) {
$('##{ident}').replaceWith(data); $('##{ident}').replaceWith(data);
setTimeout($.LongPoll.send, #{show delay}); setTimeout($.LongPoll#{ident}.send, #{show delay});
numerrs=0; numerrs=0;
}, },
'error': function(jqxhr, msg, e) { 'error': function(jqxhr, msg, e) {
@ -26,7 +26,7 @@ $.LongPoll = (function() {
window.close(); window.close();
} }
else { else {
setTimeout($.LongPoll.send, #{show delay}); setTimeout($.LongPoll#{ident}.send, #{show delay});
} }
}, },
}); });
@ -35,7 +35,7 @@ $.LongPoll = (function() {
}()); }());
$(document).bind('ready.app', function() { $(document).bind('ready.app', function() {
setTimeout($.LongPoll.send, #{show startdelay}); setTimeout($.LongPoll#{ident}.send, #{show startdelay});
}); });
})( jQuery ); })( jQuery );

21
templates/page.hamlet
View file

@ -20,23 +20,4 @@
<div .container-fluid> <div .container-fluid>
<div .row-fluid> <div .row-fluid>
<div .span3> ^{content}
<div .sidebar-nav>
<div .alert .alert-info>
<a .close data-dismiss="alert" href="#">&times;</a>
<b>This is just a demo.</b> If this were not just a demo,
I'd not be filling this sidebar with silly alerts.
<div .alert .alert-success>
<a .close data-dismiss="alert" href="#">&times;</a>
<b>Well done!</b>
You successfully read this important alert message.
<div .alert .alert-error>
<a .close data-dismiss="alert" href="#">&times;</a>
<b>Whoops!</b>
Unable to connect to blah blah..
<div .span9>
$maybe msg <- mmsg
<div .alert .alert-info>
<a .close data-dismiss="alert" href="#">&times;</a>
#{msg}
^{widget}

18
templates/sidebar.hamlet Normal file
View file

@ -0,0 +1,18 @@
<div .span3 ##{ident}>
<div .sidebar-nav>
$maybe msg <- mmsg
<div .alert .alert-info>
<a .close data-dismiss="alert" href="#">&times;</a>
#{msg}
<div .alert .alert-info>
<a .close data-dismiss="alert" href="#">&times;</a>
<b>This is just a demo.</b> If this were not just a demo,
I'd not be filling this sidebar with silly alerts.
<div .alert .alert-success>
<a .close data-dismiss="alert" href="#">&times;</a>
<b>Well done!</b>
You successfully read this important alert message.
<div .alert .alert-error>
<a .close data-dismiss="alert" href="#">&times;</a>
<b>Whoops!</b>
Unable to connect to blah blah.. #{date}

53
templates/transfers.hamlet
View file

@ -1,30 +1,29 @@
<span ##{ident}> <div .span9 ##{ident}>
<div .span9> $if null transfers
$if null transfers <h2>No current transfers
<h2>No current transfers $else
$else <h2>Transfers
<h2>Transfers $forall (transfer, info) <- transfers
$forall (transfer, info) <- transfers $with percent <- maybe "unknown" (showPercentage 0) $ percentComplete transfer info
$with percent <- maybe "unknown" (showPercentage 0) $ percentComplete transfer info <div .row-fluid>
<div .row-fluid> <h3>
<h3> $maybe file <- associatedFile info
$maybe file <- associatedFile info #{file}
#{file} $nothing
$nothing #{show $ transferKey transfer}
#{show $ transferKey transfer} $case transferDirection transfer
$case transferDirection transfer $of Upload
$of Upload &rarr;
&rarr; $of Download
$of Download &larr;
&larr; <small>#{maybe "unknown" Remote.name $ transferRemote info}</small>
<small>#{maybe "unknown" Remote.name $ transferRemote info}</small> $with size <- maybe "unknown" (roughSize dataUnits True) $ keySize $ transferKey transfer
$with size <- maybe "unknown" (roughSize dataUnits True) $ keySize $ transferKey transfer $if isJust $ startedTime info
$if isJust $ startedTime info <small .pull-right><b>#{percent} of #{size}</b></small>
<small .pull-right><b>#{percent} of #{size}</b></small> $else
$else <small .pull-right>queued (#{size})</small>
<small .pull-right>queued (#{size})</small> <div .progress .progress-striped>
<div .progress .progress-striped> <div .bar style="width: #{percent};">
<div .bar style="width: #{percent};">
$if warnNoScript $if warnNoScript
<noscript> <noscript>
<div .navbar .navbar-fixed-bottom> <div .navbar .navbar-fixed-bottom>