diff options
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/DaemonStatus.hs | 4 | ||||
| -rw-r--r-- | Assistant/Sync.hs | 23 |
2 files changed, 18 insertions, 9 deletions
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 |