improve transfer stages for some commands

move --to, copy --to, mirror --to: When concurrency is enabled, run cleanup
actions in separate job pool from uploads.

transferStages was confusingly named, it's only useful when doing downloads
as then the verify actions can be run concurrently with other downloads.
For commands that upload, there will be more concurrency from running
cleanup actions in a separate job pool.

As for sync, I left it using downloadStages although that's not optimal
for the part of a sync that uploads. Perhaps it should use the union of
both?

CHANGELOG

@@ -5,6 +5,8 @@ git-annex (8.20200523) UNRELEASED; urgency=medium
   * addurl: Make --preserve-filename also apply when eg a torrent contains
     multiple files.
   * export: Let concurrent transfers be done with -J or annex.jobs.
+  * move --to, copy --to, mirror --to: When concurrency is enabled, run
+    cleanup actions in separate job pool from uploads.
 
  -- Joey Hess <id@joeyh.name>  Tue, 26 May 2020 10:20:52 -0400
 

Command/Get.hs

@@ -38,7 +38,7 @@ optParser desc = GetOptions
 	<*> parseBatchOption
 
 seek :: GetOptions -> CommandSeek
-seek o = startConcurrency transferStages $ do
+seek o = startConcurrency downloadStages $ do
 	from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
 	let go = whenAnnexed $ start o from
 	case batchOption o of

Command/Mirror.hs

@@ -41,11 +41,15 @@ instance DeferredParseClass MirrorOptions where
 		<*> pure (keyOptions v)
 
 seek :: MirrorOptions -> CommandSeek
-seek o = startConcurrency transferStages $ 
+seek o = startConcurrency stages $ 
 	withKeyOptions (keyOptions o) False
 		(commandAction . startKey o (AssociatedFile Nothing))
 		(withFilesInGit (commandAction . (whenAnnexed $ start o)))
 		=<< workTreeItems (mirrorFiles o)
+  where
+	stages = case fromToOptions o of
+		FromRemote _ -> downloadStages
+		ToRemote _ -> commandStages
 
 start :: MirrorOptions -> RawFilePath -> Key -> CommandStart
 start o file k = startKey o afile (k, ai)

Command/Move.hs

@@ -54,7 +54,7 @@ data RemoveWhen = RemoveSafe | RemoveNever
 	deriving (Show, Eq)
 
 seek :: MoveOptions -> CommandSeek
-seek o = startConcurrency transferStages $ do
+seek o = startConcurrency stages $ do
 	let go = whenAnnexed $ start (fromToOptions o) (removeWhen o)
 	case batchOption o of
 		Batch fmt -> batchFilesMatching fmt (go . toRawFilePath)
@@ -62,6 +62,11 @@ seek o = startConcurrency transferStages $ do
 			(commandAction . startKey (fromToOptions o) (removeWhen o))
 			(withFilesInGit (commandAction . go))
 			=<< workTreeItems (moveFiles o)
+  where
+	stages = case fromToOptions o of
+		Right (FromRemote _) -> downloadStages
+		Right (ToRemote _) -> commandStages
+		Left ToHere -> downloadStages
 
 start :: FromToHereOptions -> RemoveWhen -> RawFilePath -> Key -> CommandStart
 start fromto removewhen f k = start' fromto removewhen afile k ai

Command/Sync.hs

@@ -194,7 +194,7 @@ instance DeferredParseClass SyncOptions where
 seek :: SyncOptions -> CommandSeek
 seek o = do
 	prepMerge
-	startConcurrency transferStages (seek' o)
+	startConcurrency downloadStages (seek' o)
 	
 seek' :: SyncOptions -> CommandSeek
 seek' o = do

Types/WorkerPool.hs

@@ -82,12 +82,13 @@ commandStages = UsedStages
 	, stageSet = S.fromList [PerformStage, CleanupStage]
 	}
 
--- | When a command is transferring content, it can use this instead.
--- Transfers are often bottlenecked on the network another disk than the one
--- containing the repository, while verification bottlenecks on
--- the disk containing the repository or on the CPU.
-transferStages :: UsedStages
-transferStages = UsedStages
+-- | When a command is downloading content, it can use this instead.
+-- Downloads are often bottlenecked on the network or another disk
+-- than the one containing the repository, while verification bottlenecks
+-- on the disk containing the repository or on the CPU. So, run the
+-- transfer and verify stage separately.
+downloadStages :: UsedStages
+downloadStages = UsedStages
 	{ initialStage = TransferStage
 	, stageSet = S.fromList [TransferStage, VerifyStage]
 	}