summaryrefslogtreecommitdiff
path: root/Assistant/Threads/Pusher.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-08-22 14:32:17 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-08-22 14:32:17 -0400
commit68659f49983ca30a3c1a1a3f5e7da003f96741dc (patch)
tree31e100dcd657840b9628b043681bdd4a7e48e1c1 /Assistant/Threads/Pusher.hs
parent5a68acb521bae0277b2c8a8ca023dc57a5ff4b33 (diff)
refactor
Diffstat (limited to 'Assistant/Threads/Pusher.hs')
-rw-r--r--Assistant/Threads/Pusher.hs50
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