get -J: Download different files from different remotes when the remotes have the same costs.

Only done in -J mode because only if there's concurrency can downloading
from two remotes be faster. Without concurrency, it's likely the case that
sequential downloads from the same remote are faster than switching back
and forth between two remotes.

There is some hairy MVar code here, but basically it just keeps
the activeremotes MVar full except when deciding which remote to assign
to a thread.

Also affects gets by sync --content -J

This commit was sponsored by Jochen Bartl.

1 files changed, 52 insertions, 48 deletions

diff --git a/Annex.hs b/Annex.hs
index 5ab2b748d..9bd6d34b8 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -77,7 +77,7 @@ import qualified Data.Set as S
  - The MVar is not exposed outside this module.
  -
  - Note that when an Annex action fails and the exception is caught,
- - ny changes the action has made to the AnnexState are retained,
+ - any changes the action has made to the AnnexState are retained,
  - due to the use of the MVar to store the state.
  -}
 newtype Annex a = Annex { runAnnex :: ReaderT (MVar AnnexState) IO a }
@@ -135,56 +135,60 @@ data AnnexState = AnnexState
 	, desktopnotify :: DesktopNotify
 	, workers :: [Either AnnexState (Async AnnexState)]
 	, concurrentjobs :: Maybe Int
+	, activeremotes :: MVar (S.Set (Types.Remote.RemoteA Annex))
 	, keysdbhandle :: Maybe Keys.DbHandle
 	, cachedcurrentbranch :: Maybe Git.Branch
 	}
 
-newState :: GitConfig -> Git.Repo -> AnnexState
-newState c r = AnnexState
-	{ repo = r
-	, repoadjustment = return
-	, gitconfig = c
-	, backends = []
-	, remotes = []
-	, remoteannexstate = M.empty
-	, output = def
-	, force = False
-	, fast = False
-	, daemon = False
-	, branchstate = startBranchState
-	, repoqueue = Nothing
-	, catfilehandles = M.empty
-	, hashobjecthandle = Nothing
-	, checkattrhandle = Nothing
-	, checkignorehandle = Nothing
-	, forcebackend = Nothing
-	, globalnumcopies = Nothing
-	, forcenumcopies = Nothing
-	, limit = BuildingMatcher []
-	, uuidmap = Nothing
-	, preferredcontentmap = Nothing
-	, requiredcontentmap = Nothing
-	, forcetrust = M.empty
-	, trustmap = Nothing
-	, groupmap = Nothing
-	, ciphers = M.empty
-	, lockcache = M.empty
-	, flags = M.empty
-	, fields = M.empty
-	, cleanup = M.empty
-	, sentinalstatus = Nothing
-	, useragent = Nothing
-	, errcounter = 0
-	, unusedkeys = Nothing
-	, tempurls = M.empty
-	, quviversion = Nothing
-	, existinghooks = M.empty
-	, desktopnotify = mempty
-	, workers = []
-	, concurrentjobs = Nothing
-	, keysdbhandle = Nothing
-	, cachedcurrentbranch = Nothing
-	}
+newState :: GitConfig -> Git.Repo -> IO AnnexState
+newState c r = do
+	emptyactiveremotes <- newMVar S.empty
+	return $ AnnexState
+		{ repo = r
+		, repoadjustment = return
+		, gitconfig = c
+		, backends = []
+		, remotes = []
+		, remoteannexstate = M.empty
+		, output = def
+		, force = False
+		, fast = False
+		, daemon = False
+		, branchstate = startBranchState
+		, repoqueue = Nothing
+		, catfilehandles = M.empty
+		, hashobjecthandle = Nothing
+		, checkattrhandle = Nothing
+		, checkignorehandle = Nothing
+		, forcebackend = Nothing
+		, globalnumcopies = Nothing
+		, forcenumcopies = Nothing
+		, limit = BuildingMatcher []
+		, uuidmap = Nothing
+		, preferredcontentmap = Nothing
+		, requiredcontentmap = Nothing
+		, forcetrust = M.empty
+		, trustmap = Nothing
+		, groupmap = Nothing
+		, ciphers = M.empty
+		, lockcache = M.empty
+		, flags = M.empty
+		, fields = M.empty
+		, cleanup = M.empty
+		, sentinalstatus = Nothing
+		, useragent = Nothing
+		, errcounter = 0
+		, unusedkeys = Nothing
+		, tempurls = M.empty
+		, quviversion = Nothing
+		, existinghooks = M.empty
+		, desktopnotify = mempty
+		, workers = []
+		, concurrentjobs = Nothing
+		, activeremotes = emptyactiveremotes
+		, keysdbhandle = Nothing
+		, cachedcurrentbranch = Nothing
+		}
 
 {- Makes an Annex state object for the specified git repo.
  - Ensures the config is read, if it was not already, and performs
@@ -193,7 +197,7 @@ new :: Git.Repo -> IO AnnexState
 new r = do
 	r' <- Git.Config.read =<< Git.relPath r
 	let c = extractGitConfig r'
-	newState c <$> fixupRepo r' c
+	newState c =<< fixupRepo r' c
 
 {- Performs an action in the Annex monad from a starting state,
  - returning a new state. -}