From d468e37f461f7346ae7a9e40f3ad1c7210f6e289 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 13 Nov 2012 17:50:54 -0400 Subject: [PATCH] automatic repolist updating --- Assistant/DaemonStatus.hs | 5 +- Assistant/Threads/ConfigMonitor.hs | 5 +- Assistant/Types/DaemonStatus.hs | 3 ++ Assistant/WebApp/Configurators.hs | 48 +++++++++++++++---- Assistant/WebApp/Configurators/Pairing.hs | 6 ++- Assistant/WebApp/Configurators/XMPP.hs | 2 +- Assistant/WebApp/Notifications.hs | 8 ++++ Assistant/WebApp/Types.hs | 18 +++++++ Assistant/WebApp/routes | 3 ++ debian/changelog | 3 ++ .../configurators/pairing/xmpp/end.hamlet | 39 +++++---------- templates/configurators/repositories.hamlet | 4 +- .../configurators/repositories/list.hamlet | 36 ++++++++++++++ .../configurators/repositories/table.hamlet | 25 ---------- 14 files changed, 135 insertions(+), 70 deletions(-) create mode 100644 templates/configurators/repositories/list.hamlet delete mode 100644 templates/configurators/repositories/table.hamlet diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index 8a4a7a16d0..cb9133b2a3 100644 --- a/Assistant/DaemonStatus.hs +++ b/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. -} diff --git a/Assistant/Threads/ConfigMonitor.hs b/Assistant/Threads/ConfigMonitor.hs index 2d012ad80f..47e197116e 100644 --- a/Assistant/Threads/ConfigMonitor.hs +++ b/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) diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs index df0928d6e7..7f868d957a 100644 --- a/Assistant/Types/DaemonStatus.hs +++ b/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 diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs index 89ce50380d..cd433ec40d 100644 --- a/Assistant/WebApp/Configurators.hs +++ b/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 diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs index c6e98741bc..fbfd69e16f 100644 --- a/Assistant/WebApp/Configurators/Pairing.hs +++ b/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 diff --git a/Assistant/WebApp/Configurators/XMPP.hs b/Assistant/WebApp/Configurators/XMPP.hs index 835eb51f26..52d6296bd1 100644 --- a/Assistant/WebApp/Configurators/XMPP.hs +++ b/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 diff --git a/Assistant/WebApp/Notifications.hs b/Assistant/WebApp/Notifications.hs index c841049312..2270d0b7dc 100644 --- a/Assistant/WebApp/Notifications.hs +++ b/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 diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs index b95b683a71..320438b333 100644 --- a/Assistant/WebApp/Types.hs +++ b/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 diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index 2d646724d0..9bc1d6efba 100644 --- a/Assistant/WebApp/routes +++ b/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 diff --git a/debian/changelog b/debian/changelog index 1114a45e42..4356bff1ef 100644 --- a/debian/changelog +++ b/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 Tue, 13 Nov 2012 13:17:07 -0400 diff --git a/templates/configurators/pairing/xmpp/end.hamlet b/templates/configurators/pairing/xmpp/end.hamlet index ee558e0f52..077430bb77 100644 --- a/templates/configurators/pairing/xmpp/end.hamlet +++ b/templates/configurators/pairing/xmpp/end.hamlet @@ -9,38 +9,23 @@ $nothing A pair request has been sent to all other devices using your jabber # account. - $else - Pair request accepted. -

- Configure a shared cloud repository + $else + Pair request accepted. +

+ Configure a shared cloud repository $maybe name <- friend

☂ To share files with #{name}, you'll need a repository in # the cloud, that you both can access. - $if null cloudrepolist -

- ^{makeCloudRepositories} - $else -

- Make sure that #{name} has access to one of these cloud repositories, # - and that the repository is enabled. - ^{repoTable cloudrepolist} -

- Or, add a new cloud repository: - ^{makeCloudRepositories} $nothing

☂ To share files with your other devices, when they're not # nearby, you'll need a repository in the cloud. - $if null cloudrepolist -

- ^{makeCloudRepositories} - $else -

- Make sure that your other devices are configured to access one of # - these cloud repositories, and that the repository is enabled here # - too. - ^{repoTable cloudrepolist} -

- Or, add a new cloud repository: - ^{makeCloudRepositories} +

+ Make sure that your other devices are configured to access a # + cloud repository, and that the same repository is enabled here # + too. + ^{cloudrepolist} +

+ Add a cloud repository + ^{makeCloudRepositories} diff --git a/templates/configurators/repositories.hamlet b/templates/configurators/repositories.hamlet index c2367536d6..d226799ad7 100644 --- a/templates/configurators/repositories.hamlet +++ b/templates/configurators/repositories.hamlet @@ -1,7 +1,5 @@
-

- Your repositories - ^{repoTable repolist} + ^{repolist}

diff --git a/templates/configurators/repositories/list.hamlet b/templates/configurators/repositories/list.hamlet new file mode 100644 index 0000000000..5829e23e0a --- /dev/null +++ b/templates/configurators/repositories/list.hamlet @@ -0,0 +1,36 @@ +
+ $if onlyCloud reposelector + $if not (null repolist) +

+ Cloud repositories + $else + No cloud repositories are configured yet. + $else + $if not (null repolist) +

+ Repositories + + + $forall (num, name, actions) <- repolist + +
+ #{num} + + #{name} + + $if needsEnabled actions + + not enabled + $else + + $if notSyncing actions + syncing paused + $else + syncing enabled + + $if needsEnabled actions + + enable + $else + + configure diff --git a/templates/configurators/repositories/table.hamlet b/templates/configurators/repositories/table.hamlet deleted file mode 100644 index 81442e4dff..0000000000 --- a/templates/configurators/repositories/table.hamlet +++ /dev/null @@ -1,25 +0,0 @@ - - - $forall (num, name, actions) <- repolist - -
- #{num} - - #{name} - - $if needsEnabled actions - - not enabled - $else - - $if notSyncing actions - syncing paused - $else - syncing enabled - - $if needsEnabled actions - - enable - $else - - configure