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.
This commit is contained in:
Joey Hess 2012-06-22 15:46:21 -04:00
parent 28e28bc043
commit e9630e90de
4 changed files with 105 additions and 28 deletions

View file

@ -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)