diff options
Diffstat (limited to 'Assistant/Threads/Pusher.hs')
-rw-r--r-- | Assistant/Threads/Pusher.hs | 50 |
1 files changed, 1 insertions, 49 deletions
diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index 4753e355a..4b80297fa 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -12,15 +12,11 @@ import Assistant.Commits import Assistant.Pushes import Assistant.Alert import Assistant.ThreadedMonad -import Assistant.Threads.Merger import Assistant.DaemonStatus -import qualified Command.Sync +import Assistant.Sync import Utility.ThreadScheduler -import Utility.Parallel -import qualified Git.Branch import Data.Time.Clock -import qualified Data.Map as M thisThread :: ThreadName thisThread = "Pusher" @@ -76,47 +72,3 @@ shouldPush :: UTCTime -> [Commit] -> Bool shouldPush _now commits | not (null commits) = True | otherwise = False - -{- Updates the local sync branch, then pushes it to all remotes, in - - parallel. - - - - Avoids running possibly long-duration commands in the Annex monad, so - - as not to block other threads. -} -pushToRemotes :: ThreadName -> UTCTime -> ThreadState -> (Maybe FailedPushMap) -> [Remote] -> IO Bool -pushToRemotes threadname now st mpushmap remotes = do - (g, branch) <- runThreadState st $ - (,) <$> fromRepo id <*> inRepo Git.Branch.current - go True branch g remotes - where - go _ Nothing _ _ = return True -- no branch, so nothing to do - go shouldretry (Just branch) g rs = do - debug threadname - [ "pushing to" - , show rs - ] - Command.Sync.updateBranch (Command.Sync.syncBranch branch) g - (succeeded, failed) <- inParallel (push g branch) rs - let ok = null failed - case mpushmap of - Nothing -> noop - Just pushmap -> - changeFailedPushMap pushmap $ \m -> - M.union (makemap failed) $ - M.difference m (makemap succeeded) - unless (ok) $ - debug threadname - [ "failed to push to" - , show failed - ] - if (ok || not shouldretry) - then return ok - else retry branch g failed - - makemap l = M.fromList $ zip l (repeat now) - - push g branch remote = Command.Sync.pushBranch remote branch g - - retry branch g rs = do - debug threadname [ "trying manual pull to resolve failed pushes" ] - runThreadState st $ manualPull (Just branch) rs - go False (Just branch) g rs |