automatic repolist updating

Assistant/DaemonStatus.hs

@@ -44,6 +44,7 @@ modifyDaemonStatus a = do
 		sendNotification $ changeNotifier s
 		return b
 
+
 {- Returns a function that updates the lists of syncable remotes. -}
 calcSyncRemotes :: Annex (DaemonStatus -> DaemonStatus)
 calcSyncRemotes = do
@@ -60,7 +61,9 @@ calcSyncRemotes = do
 
 {- Updates the sycRemotes list from the list of all remotes in Annex state. -}
 updateSyncRemotes :: Assistant ()
-updateSyncRemotes = modifyDaemonStatus_ =<< liftAnnex calcSyncRemotes
+updateSyncRemotes = do
+	modifyDaemonStatus_ =<< liftAnnex calcSyncRemotes
+	liftIO . sendNotification =<< syncRemotesNotifier <$> getDaemonStatus
 
 {- Load any previous daemon status file, and store it in a MVar for this
  - process to use as its DaemonStatus. Also gets current transfer status. -}

Assistant/Threads/ConfigMonitor.hs

@@ -72,8 +72,9 @@ reloadConfigs changedconfigs = do
 		sequence_ as
 		void preferredContentMapLoad
 	{- Changes to the remote log, or the trust log, can affect the
-	 - syncRemotes list -}
-	when (Logs.Remote.remoteLog `elem` fs || Logs.Trust.trustLog `elem` fs) $
+	 - syncRemotes list. Changes to the uuid log may affect its
+	 - display so are also included. -}
+	when (any (`elem` fs) [remoteLog, trustLog, uuidLog]) $
 		updateSyncRemotes
   where
 	(fs, as) = unzip $ filter (flip S.member changedfiles . fst)

Assistant/Types/DaemonStatus.hs

@@ -47,6 +47,8 @@ data DaemonStatus = DaemonStatus
 	, transferNotifier :: NotificationBroadcaster
 	-- Broadcasts notifications when there's a change to the alerts
 	, alertNotifier :: NotificationBroadcaster
+	-- Broadcasts notifications when the syncRemotes change
+	, syncRemotesNotifier :: NotificationBroadcaster
 	}
 
 type TransferMap = M.Map Transfer TransferInfo
@@ -70,3 +72,4 @@ newDaemonStatus = DaemonStatus
 	<*> newNotificationBroadcaster
 	<*> newNotificationBroadcaster
 	<*> newNotificationBroadcaster
+	<*> newNotificationBroadcaster

Assistant/WebApp/Configurators.hs

@@ -14,6 +14,7 @@ import Assistant.DaemonStatus
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.WebApp.SideBar
+import Assistant.WebApp.Notifications
 import Assistant.WebApp.Utility
 import Assistant.WebApp.Configurators.Local
 import Utility.Yesod
@@ -51,7 +52,11 @@ getConfigR = ifM (inFirstRun)
 introDisplay :: Text -> Widget
 introDisplay ident = do
 	webapp <- lift getYesod
-	repolist <- lift $ repoList False True False
+	repolist <- lift $ repoList $ RepoSelector
+		{ onlyCloud = False
+		, onlyConfigured = True
+		, includeHere = False
+		}
 	let n = length repolist
 	let numrepos = show n
 	$(widgetFile "configurators/intro")
@@ -68,7 +73,11 @@ getRepositoriesR :: Handler RepHtml
 getRepositoriesR = bootstrap (Just Config) $ do
 	sideBarDisplay
 	setTitle "Repositories"
-	repolist <- lift $ repoList False False True
+	let repolist = repoListDisplay $ RepoSelector
+		{ onlyCloud = False
+		, onlyConfigured = False
+		, includeHere = True
+		}
 	$(widgetFile "configurators/repositories")
 
 data Actions
@@ -103,16 +112,35 @@ notSyncing :: Actions -> Bool
 notSyncing (SyncingRepoActions _ _) = False
 notSyncing _ = True
 
-repoTable :: RepoList -> Widget
-repoTable repolist = $(widgetFile "configurators/repositories/table")
+{- Called by client to get a list of repos, that refreshes
+ - when new repos as added.
+ -
+ - Returns a div, which will be inserted into the calling page.
+ -}
+getRepoListR :: RepoListNotificationId -> Handler RepHtml
+getRepoListR (RepoListNotificationId nid reposelector) = do
+	waitNotifier getRepoListBroadcaster nid
+	page <- widgetToPageContent $ repoListDisplay reposelector
+	hamletToRepHtml $ [hamlet|^{pageBody page}|]
+
+repoListDisplay :: RepoSelector -> Widget
+repoListDisplay reposelector = do
+	autoUpdate ident (NotifierRepoListR reposelector) (10 :: Int) (10 :: Int)
+
+	repolist <- lift $ repoList reposelector
+
+	$(widgetFile "configurators/repositories/list")
+
+  where
+	ident = "repolist"
 
 type RepoList = [(String, String, Actions)]
 
 {- A numbered list of known repositories,
  - with actions that can be taken on them. -}
-repoList :: Bool -> Bool -> Bool -> Handler RepoList
-repoList onlycloud onlyconfigured includehere
-	| onlyconfigured = list =<< configured
+repoList :: RepoSelector -> Handler RepoList
+repoList reposelector
+	| onlyConfigured reposelector = list =<< configured
 	| otherwise = list =<< (++) <$> configured <*> rest
   where
 	configured = do
@@ -121,7 +149,7 @@ repoList onlycloud onlyconfigured includehere
 		runAnnex [] $ do
 			u <- getUUID
 			let l = map Remote.uuid rs
-			let l' = if includehere then u : l else l
+			let l' = if includeHere reposelector then u : l else l
 			return $ zip l' $ map mkSyncingRepoActions l'
 	rest = runAnnex [] $ do
 		m <- readRemoteLog
@@ -134,11 +162,11 @@ repoList onlycloud onlyconfigured includehere
 		return $ zip unsyncable (map mkNotSyncingRepoActions unsyncable) ++ unconfigured
 	wantedrepo r
 		| Remote.readonly r = False
-		| onlycloud = Git.repoIsUrl (Remote.repo r) && not (isXMPPRemote r)
+		| onlyCloud reposelector = Git.repoIsUrl (Remote.repo r) && not (isXMPPRemote r)
 		| otherwise = True
 	wantedremote Nothing = False
 	wantedremote (Just (iscloud, _))
-		| onlycloud = iscloud
+		| onlyCloud reposelector = iscloud
 		| otherwise = True
 	findinfo m u = case M.lookup u m of
 		Nothing -> Nothing

Assistant/WebApp/Configurators/Pairing.hs

@@ -158,7 +158,11 @@ getFinishXMPPPairR _ = noXMPPPairing
 xmppPairEnd :: Bool -> Maybe JID -> Handler RepHtml
 xmppPairEnd inprogress theirjid = pairPage $ do
 	let friend = buddyName <$> theirjid
-	cloudrepolist <- lift $ repoList True False False
+	let cloudrepolist = repoListDisplay $ RepoSelector
+		{ onlyCloud = True
+		, onlyConfigured = False
+		, includeHere = False
+		}
 	$(widgetFile "configurators/pairing/xmpp/end")
 #endif
 

Assistant/WebApp/Configurators/XMPP.hs

@@ -97,7 +97,7 @@ getBuddyListR :: NotificationId -> Handler RepHtml
 getBuddyListR nid = do
 	waitNotifier getBuddyListBroadcaster nid
 
-	page <- widgetToPageContent $ buddyListDisplay
+	page <- widgetToPageContent buddyListDisplay
 	hamletToRepHtml $ [hamlet|^{pageBody page}|]
 
 buddyListDisplay :: Widget

Assistant/WebApp/Notifications.hs

@@ -62,6 +62,11 @@ getNotifierSideBarR = notifierUrl SideBarR getAlertBroadcaster
 getNotifierBuddyListR :: Handler RepPlain
 getNotifierBuddyListR = notifierUrl BuddyListR getBuddyListBroadcaster
 
+getNotifierRepoListR :: RepoSelector -> Handler RepPlain
+getNotifierRepoListR reposelector = notifierUrl route getRepoListBroadcaster
+  where
+	route nid = RepoListR $ RepoListNotificationId nid reposelector
+
 getTransferBroadcaster :: Assistant NotificationBroadcaster
 getTransferBroadcaster = transferNotifier <$> getDaemonStatus
 
@@ -70,3 +75,6 @@ getAlertBroadcaster = alertNotifier <$> getDaemonStatus
 
 getBuddyListBroadcaster :: Assistant NotificationBroadcaster
 getBuddyListBroadcaster =  getBuddyBroadcaster <$> getAssistant buddyList
+
+getRepoListBroadcaster :: Assistant NotificationBroadcaster
+getRepoListBroadcaster =  syncRemotesNotifier <$> getDaemonStatus

Assistant/WebApp/Types.hs

@@ -62,6 +62,16 @@ data WebAppState = WebAppState
 	, otherRepos :: [(String, String)] -- name and path to other repos
 	}
 
+data RepoSelector = RepoSelector
+	{ onlyCloud :: Bool
+	, onlyConfigured :: Bool
+	, includeHere :: Bool
+	}
+	deriving (Read, Show, Eq)
+
+data RepoListNotificationId = RepoListNotificationId NotificationId RepoSelector
+	deriving (Read, Show, Eq)
+
 instance PathPiece SshData where
     toPathPiece = pack . show
     fromPathPiece = readish . unpack
@@ -97,3 +107,11 @@ instance PathPiece BuddyKey where
 instance PathPiece PairKey where
     toPathPiece = pack . show
     fromPathPiece = readish . unpack
+
+instance PathPiece RepoListNotificationId where
+    toPathPiece = pack . show
+    fromPathPiece = readish . unpack
+
+instance PathPiece RepoSelector where
+    toPathPiece = pack . show
+    fromPathPiece = readish . unpack

Assistant/WebApp/routes

@@ -47,6 +47,9 @@
 /buddylist/#NotificationId BuddyListR GET
 /notifier/buddylist NotifierBuddyListR GET
 
+/repolist/#RepoListNotificationId RepoListR GET
+/notifier/repolist/#RepoSelector NotifierRepoListR GET
+
 /alert/close/#AlertId CloseAlert GET
 /alert/click/#AlertId ClickAlert GET
 /filebrowser FileBrowserR GET POST

debian/changelog

@@ -2,6 +2,9 @@ git-annex (3.20121113) UNRELEASED; urgency=low
 
   * Show error message to user when testing XMPP creds.
   * Fix build of assistant without yesod.
+  * webapp: The list of repositiories refreshes when new repositories are
+    added, including when new repository configurations are pushed in from
+    remotes.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 13 Nov 2012 13:17:07 -0400
 

templates/configurators/pairing/xmpp/end.hamlet

@@ -17,30 +17,15 @@
     <p>
       &#9730; To share files with #{name}, you'll need a repository in #
       the cloud, that you both can access.
-    $if null cloudrepolist
-      <hr>
-      ^{makeCloudRepositories}
-    $else
-      <p>
-        Make sure that #{name} has access to one of these cloud repositories, #
-        and that the repository is enabled.
-      ^{repoTable cloudrepolist}
-      <hr>
-        Or, add a new cloud repository:
-        ^{makeCloudRepositories}
   $nothing
     <p>
       &#9730; To share files with your other devices, when they're not #
       nearby, you'll need a repository in the cloud.
-    $if null cloudrepolist
-      <hr>
-      ^{makeCloudRepositories}
-    $else
     <p>
-        Make sure that your other devices are configured to access one of #
-        these cloud repositories, and that the repository is enabled here #
+      Make sure that your other devices are configured to access a #
+      cloud repository, and that the same repository is enabled here #
       too.
-      ^{repoTable cloudrepolist}
-      <hr>
-        Or, add a new cloud repository:
+  ^{cloudrepolist}
+  <h2>
+    Add a cloud repository
   ^{makeCloudRepositories}

templates/configurators/repositories.hamlet

@@ -1,7 +1,5 @@
 <div .span9>
-  <h2>
-    Your repositories
-  ^{repoTable repolist}
+  ^{repolist}
   <div .row-fluid>
     <div .span6>
       <h2>

templates/configurators/repositories/list.hamlet

@@ -0,0 +1,36 @@
+<div ##{ident}>
+  $if onlyCloud reposelector
+    $if not (null repolist)
+      <h2>
+        Cloud repositories
+    $else
+      No cloud repositories are configured yet.
+  $else
+    $if not (null repolist)
+      <h2>
+        Repositories
+  <table .table .table-condensed>
+    <tbody>
+      $forall (num, name, actions) <- repolist
+        <tr>
+          <td>
+            #{num}
+          <td>
+            #{name}
+          <td>
+            $if needsEnabled actions
+              <a href="@{setupRepoLink actions}">
+                <i .icon-warning-sign></i> not enabled
+            $else
+              <a href="@{syncToggleLink actions}">
+                $if notSyncing actions
+                  <i .icon-pause></i> syncing paused
+                $else
+                  <i .icon-refresh></i> syncing enabled
+          <td>
+            $if needsEnabled actions
+              <a href="@{setupRepoLink actions}">
+                enable
+            $else
+              <a href="@{setupRepoLink actions}">
+                configure

templates/configurators/repositories/table.hamlet

@@ -1,25 +0,0 @@
-<table .table .table-condensed>
-  <tbody>
-    $forall (num, name, actions) <- repolist
-      <tr>
-        <td>
-          #{num}
-        <td>
-          #{name}
-        <td>
-          $if needsEnabled actions
-            <a href="@{setupRepoLink actions}">
-              <i .icon-warning-sign></i> not enabled
-          $else
-            <a href="@{syncToggleLink actions}">
-              $if notSyncing actions
-                <i .icon-pause></i> syncing paused
-              $else
-                <i .icon-refresh></i> syncing enabled
-        <td>
-          $if needsEnabled actions
-            <a href="@{setupRepoLink actions}">
-              enable
-          $else
-            <a href="@{setupRepoLink actions}">
-              configure