diff options
| -rw-r--r-- | Annex/Branch.hs | 9 | ||||
| -rw-r--r-- | Assistant/DaemonStatus.hs | 4 | ||||
| -rw-r--r-- | Assistant/Sync.hs | 23 | ||||
| -rw-r--r-- | Command/Sync.hs | 2 |
4 files changed, 25 insertions, 13 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 8e7f45a4a..a832efada 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -90,10 +90,10 @@ getBranch = maybe (hasOrigin >>= go >>= use) return =<< branchsha - called before data is read from it. Runs only once per git-annex run. -} update :: Annex () -update = runUpdateOnce $ updateTo =<< siblingBranches +update = runUpdateOnce $ void $ updateTo =<< siblingBranches {- Forces an update even if one has already been run. -} -forceUpdate :: Annex () +forceUpdate :: Annex Bool forceUpdate = updateTo =<< siblingBranches {- Merges the specified Refs into the index, if they have any changes not @@ -111,8 +111,10 @@ forceUpdate = updateTo =<< siblingBranches - - The branch is fast-forwarded if possible, otherwise a merge commit is - made. + - + - Returns True if any refs were merged in, False otherwise. -} -updateTo :: [(Git.Ref, Git.Branch)] -> Annex () +updateTo :: [(Git.Ref, Git.Branch)] -> Annex Bool updateTo pairs = do -- ensure branch exists, and get its current ref branchref <- getBranch @@ -139,6 +141,7 @@ updateTo pairs = do else commitBranch branchref merge_desc (nub $ fullname:refs) invalidateCache + return $ not $ null refs where isnewer (r, _) = inRepo $ Git.Branch.changed fullname r diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index aa990df34..4a0d271a3 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -238,7 +238,8 @@ updateAlertMap dstatus a = notifyAlert dstatus `after` modifyDaemonStatus_ dstat where go s = s { alertMap = a (alertMap s) } -{- Displays an alert while performing an activity. +{- Displays an alert while performing an activity that returns True on + - success. - - The alert is left visible afterwards, as filler. - Old filler is pruned, to prevent the map growing too large. -} @@ -247,6 +248,7 @@ alertWhile dstatus alert a = alertWhile' dstatus alert $ do r <- a return $ (r, r) +{- Like alertWhile, but allows the activity to return a value too. -} alertWhile' :: DaemonStatusHandle -> Alert -> IO (Bool, a) -> IO a alertWhile' dstatus alert a = do let alert' = alert { alertClass = Activity } diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index 11d33a54f..b0f3890ee 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -27,21 +27,27 @@ import qualified Data.Map as M {- Syncs with remotes that may have been disconnected for a while. - - After getting git in sync, queues a scan for file transfers. + - To avoid doing that expensive scan unnecessarily, it's only run + - if the git-annex branches of the remotes have diverged from the + - local git-annex branch. -} syncRemotes :: ThreadName -> ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> [Remote] -> IO () syncRemotes _ _ _ _ [] = noop -syncRemotes threadname st dstatus scanremotes rs = do - void $ alertWhile dstatus (syncAlert rs) $ do +syncRemotes threadname st dstatus scanremotes rs = void $ + alertWhile dstatus (syncAlert rs) $ do sync =<< runThreadState st (inRepo Git.Branch.current) - addScanRemotes scanremotes rs where sync (Just branch) = do - manualPull st (Just branch) rs + haddiverged <- manualPull st (Just branch) rs + when haddiverged $ + addScanRemotes scanremotes rs now <- getCurrentTime pushToRemotes threadname now st Nothing rs {- No local branch exists yet, but we can try pulling. -} sync Nothing = do - manualPull st Nothing rs + haddiverged <- manualPull st Nothing rs + when haddiverged $ + addScanRemotes scanremotes rs return True {- Updates the local sync branch, then pushes it to all remotes, in @@ -85,15 +91,16 @@ pushToRemotes threadname now st mpushmap remotes = do retry branch g rs = do debug threadname [ "trying manual pull to resolve failed pushes" ] - manualPull st (Just branch) rs + void $ manualPull st (Just branch) rs go False (Just branch) g rs {- Manually pull from remotes and merge their branches. -} -manualPull :: ThreadState -> (Maybe Git.Ref) -> [Remote] -> IO () +manualPull :: ThreadState -> (Maybe Git.Ref) -> [Remote] -> IO Bool manualPull st currentbranch remotes = do g <- runThreadState st $ fromRepo id forM_ remotes $ \r -> Git.Command.runBool "fetch" [Param $ Remote.name r] g - runThreadState st $ Annex.Branch.forceUpdate + haddiverged <- runThreadState st $ Annex.Branch.forceUpdate forM_ remotes $ \r -> runThreadState st $ Command.Sync.mergeRemote r currentbranch + return haddiverged diff --git a/Command/Sync.hs b/Command/Sync.hs index f40a2f621..023b1b84a 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -172,7 +172,7 @@ pushBranch remote branch g = mergeAnnex :: CommandStart mergeAnnex = do - Annex.Branch.forceUpdate + void $ Annex.Branch.forceUpdate stop mergeFrom :: Git.Ref -> Annex Bool |