mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

fixup merges now done when needed

Browse source
This commit is contained in:
Joey Hess 2012-06-25 20:16:30 -04:00
parent 14015036bc
commit 05c4dfb941
3 changed files with 22 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

17
Assistant/Threads/Pusher.hs
View file

@ -11,6 +11,7 @@ import Common.Annex
import Assistant.Commits
import Assistant.Pushes
import Assistant.ThreadedMonad
import Assistant.Threads.Merger
import qualified Command.Sync
import Utility.ThreadScheduler
import Utility.Parallel
@ -68,11 +69,19 @@ pushToRemotes :: UTCTime -> ThreadState -> FailedPushChan -> [Remote] -> IO ()
pushToRemotes now st pushchan remotes = do
(g, branch) <- runThreadState st $
(,) <$> fromRepo id <*> Command.Sync.currentBranch
Command.Sync.updateBranch (Command.Sync.syncBranch branch) g
failed <- map (`FailedPush` now) <$> inParallel (push g branch) remotes
unless (null failed) $
refillFailedPushes pushchan failed
go True branch g remotes
where
go shouldretry branch g rs = do
Command.Sync.updateBranch (Command.Sync.syncBranch branch) g
failed <- inParallel (push g branch) rs
unless (null failed) $
if shouldretry
then retry branch g rs
else refillFailedPushes pushchan $
map (`FailedPush` now) failed
push g branch remote =
ifM (Command.Sync.pushBranch remote branch g)
( exitSuccess, exitFailure)
retry branch g rs = do
runThreadState st $ manualPull branch rs
go False branch g rs