renamed /status to /transfers

Also fixed a bug; the ident for the div was regnerated each time
/status was called. This only was the same as the original ident due to
luck.

Assistant/Threads/WebApp.hs

@@ -32,7 +32,6 @@ import Text.Hamlet
 import Network.Socket (PortNumber)
 import Text.Blaze.Renderer.String
 import Data.Text (Text, pack, unpack)
-import Data.Time.Clock
 import qualified Data.Map as M
 
 thisThread :: String
@@ -51,7 +50,7 @@ staticFiles "static"
 
 mkYesod "WebApp" [parseRoutes|
 / HomeR GET
-/status/#NotificationId StatusR GET
+/transfers/#NotificationId TransfersR GET
 /config ConfigR GET
 /static StaticR Static getStatic
 |]
@@ -88,7 +87,7 @@ instance Yesod WebApp where
 
 {- Add to any widget to make it auto-update.
  -
- - The widget should have a html element with id=updating, which will be
+ - The widget should have a html element with an id=ident, which will be
  - replaced when it's updated.
  - 
  - Updating is done by getting html from the gethtml route.
@@ -100,12 +99,12 @@ instance Yesod WebApp where
  - ms_refreshdelay is how long to delay between refreshes, when not using AJAX
  -}
 autoUpdate :: Text -> Route WebApp -> Route WebApp -> Int -> Int -> Int -> Widget
-autoUpdate updating gethtml home ms_delay ms_startdelay ms_refreshdelay = do
+autoUpdate ident gethtml home ms_delay ms_startdelay ms_refreshdelay = do
 	{- Fallback refreshing is provided for non-javascript browsers. -}
 	let delayseconds = show $ ms_to_seconds ms_refreshdelay
 	toWidgetHead $(hamletFile $ hamletTemplate "metarefresh")
 
-	{- Use long polling to update the status display. -}
+	{- Use long polling to update the transfers display. -}
 	let delay = show ms_delay
 	let startdelay = show ms_startdelay
 	$(widgetFile "longpolling")
@@ -113,49 +112,51 @@ autoUpdate updating gethtml home ms_delay ms_startdelay ms_refreshdelay = do
 		ms_to_seconds :: Int -> Int
 		ms_to_seconds ms = ceiling ((fromIntegral ms :: Double) / 1000)
 
-{- A dynamically updating status display. -}
+{- A display of currently running and queued transfers. -}
-statusDisplay :: Widget
+transfersDisplay :: Widget
-statusDisplay = do
+transfersDisplay = do
 	webapp <- lift getYesod
-	time <- show <$> liftIO getCurrentTime
-	
 	current <- liftIO $ runThreadState (threadState webapp) $
 		M.toList . currentTransfers
 			<$> liftIO (getDaemonStatus $ daemonStatus webapp)
 	queued <- liftIO $ getTransferQueue $ transferQueue webapp
 	let transfers = current ++ queued
+	let ident = transfersDisplayIdent
+	$(widgetFile "transfers")
 
-	updating <- lift newIdent
+transfersDisplayIdent :: Text
-	$(widgetFile "status")
+transfersDisplayIdent = "transfers"
-	
-	nid <- liftIO $ notificationHandleToId <$>
-		(newNotificationHandle =<< getNotificationBroadcaster webapp)
-	autoUpdate updating (StatusR nid) HomeR (10 :: Int) (10 :: Int) (3000 :: Int)
 
 getNotificationBroadcaster :: WebApp -> IO NotificationBroadcaster
 getNotificationBroadcaster webapp = notificationBroadcaster
 		<$> getDaemonStatus (daemonStatus webapp)
 
 getHomeR :: Handler RepHtml
-getHomeR = defaultLayout statusDisplay
+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) (3000 :: Int)
+	transfersDisplay
 
-{- Called by client to poll for a new webapp status display.
+{- Called by client to get a display of currently in process transfers.
  -
- - Should block until the status has changed, and then return a div
+ - Returns a div, which will be inserted into the calling page.
- - containing the new status, 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 the getHomeR page.
  -}
-getStatusR :: NotificationId -> Handler RepHtml
+getTransfersR :: NotificationId -> Handler RepHtml
-getStatusR nid = do
+getTransfersR nid = do
-	{- Block until there is an updated status to display. -}
+	{- Block until there is a change from last time. -}
 	webapp <- getYesod
 	b <- liftIO $ getNotificationBroadcaster webapp
 	liftIO $ waitNotification $ notificationHandleFromId b nid
 
-	page <- widgetToPageContent statusDisplay
+	page <- widgetToPageContent transfersDisplay
 	hamletToRepHtml $ [hamlet|^{pageBody page}|]
 
 getConfigR :: Handler RepHtml

git-annex.cabal

@@ -1,5 +1,5 @@
 Name: git-annex
-Version: 3.20120721
+Version: 3.20120722
 Cabal-Version: >= 1.8
 License: GPL
 Maintainer: Joey Hess <joey@kitenet.net>

templates/longpolling.julius

@@ -1,5 +1,5 @@
 
-// Uses long-polling to update a div with id=#{updating}
+// Uses long-polling to update a div with id=#{ident}
 // The gethtml route should return a new div, with the same id.
 //
 // Maximum update frequency is controlled by #{startdelay}
@@ -16,7 +16,7 @@ $.LongPoll = (function() {
 				'url': '@{gethtml}',
 				'dataType': 'html',
 				'success': function(data, status, jqxhr) {
-					$('##{updating}').replaceWith(data);
+					$('##{ident}').replaceWith(data);
 					setTimeout($.LongPoll.send, #{delay});
 					numerrs=0;
 				},

templates/transfers.hamlet

@@ -1,4 +1,4 @@
-<span ##{updating}>
+<span ##{ident}>
   <div .span9>
     $if null transfers
       <h2>No current transfers
@@ -25,6 +25,3 @@
                       <small .pull-right>queued (#{size})</small>
           <div .progress .progress-striped>
             <div .bar style="width: #{percent};">
-  <footer>
-    <span>
-      polled at #{time}