diff options
author | Joey Hess <joey@kitenet.net> | 2012-06-22 15:46:21 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-06-22 15:49:48 -0400 |
commit | e9630e90decac4fe0c999af88131bd4b7c9d979f (patch) | |
tree | d0d7d897ab63fe8d7d76b47771e9c7c34f08618f /Assistant | |
parent | 28e28bc0436cb0a33e570b1a1f678e80a770a21a (diff) |
the syncer now pushes out changes to remotes, in parallel
Note that, since this always pushes branch synced/master to the remote, it
assumes that master has already gotten all the commits that are on the
remote merged in. Otherwise, fast-forward prevention may prevent the push.
That's probably ok, because the next stage is to automatically detect
incoming pushes and merge.
Diffstat (limited to 'Assistant')
-rw-r--r-- | Assistant/Syncer.hs | 64 |
1 files changed, 51 insertions, 13 deletions
diff --git a/Assistant/Syncer.hs b/Assistant/Syncer.hs index 059859c07..c579c1c28 100644 --- a/Assistant/Syncer.hs +++ b/Assistant/Syncer.hs @@ -5,25 +5,63 @@ module Assistant.Syncer where +import Common.Annex import Assistant.Commits import Assistant.ThreadedMonad import qualified Command.Sync import Utility.ThreadScheduler +import Utility.Parallel + +import Data.Time.Clock + +data FailedSync = FailedSync + { failedRemote :: Remote + , failedTimeStamp :: UTCTime + } {- This thread syncs git commits out to remotes. -} syncThread :: ThreadState -> CommitChan -> IO () -syncThread st commitchan = runEvery (Seconds 2) $ do - -- We already waited two seconds as a simple rate limiter. - -- Next, wait until at least one commit has been made - commits <- getCommits commitchan - -- Now see if now's a good time to sync. - if shouldSync commits - then syncToRemotes - else refillCommits commitchan commits +syncThread st commitchan = do + remotes <- runThreadState st $ Command.Sync.syncRemotes [] + runEveryWith (Seconds 2) [] $ \failedsyncs -> do + -- We already waited two seconds as a simple rate limiter. + -- Next, wait until at least one commit has been made + commits <- getCommits commitchan + -- Now see if now's a good time to sync. + time <- getCurrentTime + if shouldSync time commits failedsyncs + then syncToRemotes time st remotes + else do + refillCommits commitchan commits + return failedsyncs -{- Decide if now is a good time to sync commits to remotes. -} -shouldSync :: [Commit] -> Bool -shouldSync commits = not (null commits) +{- Decide if now is a good time to sync to remotes. + - + - Current strategy: Immediately sync all commits. The commit machinery + - already determines batches of changes, so we can't easily determine + - batches better. + - + - TODO: FailedSyncs are only retried the next time there's a commit. + - Should retry them periodically, or when a remote that was not available + - becomes available. + -} +shouldSync :: UTCTime -> [Commit] -> [FailedSync] -> Bool +shouldSync _now commits _failedremotes + | not (null commits) = True + | otherwise = False -syncToRemotes :: IO () -syncToRemotes = return () -- TOOD +{- 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. -} +syncToRemotes :: UTCTime -> ThreadState -> [Remote] -> IO [FailedSync] +syncToRemotes now st remotes = do + (g, branch) <- runThreadState st $ + (,) <$> fromRepo id <*> Command.Sync.currentBranch + Command.Sync.updateBranch (Command.Sync.syncBranch branch) g + map (`FailedSync` now) <$> inParallel (go g branch) remotes + where + go g branch remote = + ifM (Command.Sync.pushBranch remote branch g) + ( exitSuccess, exitFailure) |