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.

1 files changed, 25 insertions, 24 deletions

diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 28d1a4882..4da48ae04 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/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. -}
-statusDisplay :: Widget
-statusDisplay = do
+{- A display of currently running and queued transfers. -}
+transfersDisplay :: Widget
+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
-	$(widgetFile "status")
-	
-	nid <- liftIO $ notificationHandleToId <$>
-		(newNotificationHandle =<< getNotificationBroadcaster webapp)
-	autoUpdate updating (StatusR nid) HomeR (10 :: Int) (10 :: Int) (3000 :: Int)
+transfersDisplayIdent :: Text
+transfersDisplayIdent = "transfers"
 
 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
- - containing the new status, which will be inserted into the calling page.
+ - 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 the getHomeR page.
  -}
-getStatusR :: NotificationId -> Handler RepHtml
-getStatusR nid = do
-	{- Block until there is an updated status to display. -}
+getTransfersR :: NotificationId -> Handler RepHtml
+getTransfersR nid = do
+	{- 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