diff options
author | 2012-08-22 14:32:17 -0400 | |
---|---|---|
committer | 2012-08-22 14:32:17 -0400 | |
commit | 68659f49983ca30a3c1a1a3f5e7da003f96741dc (patch) | |
tree | 31e100dcd657840b9628b043681bdd4a7e48e1c1 /Assistant/Threads/Pusher.hs | |
parent | 5a68acb521bae0277b2c8a8ca023dc57a5ff4b33 (diff) |
refactor
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 |