incomplete multiple --from / --to support

Note that --from foo --to bar is still not allowed by the option parser.
The goal of this change is only to support the same action over a group
of remotes, not multiple different actions. For the same reason
--to here --to foo is not allowed, since that's really two different
actions.

Each file is processed for all listed remotes in turn, so this is not
the same as two git-annex commands run in sequence. Instead, it allows
concurrent actions to several remotes.

Only move and transferkey converted so far. The code in Command.Move is
ugly and needs to be refactored and generalized.
Build fails due to unconverted modules.

This commit was sponsored by Fernando Jimenez on Patreon.

CHANGELOG

@@ -1,5 +1,8 @@
 git-annex (6.20180927) UNRELEASED; urgency=medium
 
+  * Multiple --from and --to options can be used in a single command,
+    eg git annex copy -J2 --to foo --to bar will copy files to two remotes
+    at the same time.
   * sync: Warn when a remote's export is not updated to the current
     tree because export tracking is not configured.
 

CmdLine/GitAnnex/Options.hs

@@ -119,18 +119,16 @@ parseRemoteOption = DeferredParse
 	. Just
 
 -- | From or To a remote.
-data FromToOptions
+data FromToOptions r = From r | To r
-	= FromRemote (DeferredParse Remote)
-	| ToRemote (DeferredParse Remote)
 
-instance DeferredParseClass FromToOptions where
+instance DeferredParseClass (FromToOptions [DeferredParse r]) where
-	finishParse (FromRemote v) = FromRemote <$> finishParse v
+	finishParse (From l) = From <$> finishParse l
-	finishParse (ToRemote v) = ToRemote <$> finishParse v
+	finishParse (To l) = To <$> finishParse l
 
-parseFromToOptions :: Parser FromToOptions
+parseFromToOptions :: Parser (FromToOptions [DeferredParse Remote])
 parseFromToOptions = 
-	(FromRemote . parseRemoteOption <$> parseFromOption) 
+	(From . map parseRemoteOption <$> some parseFromOption) 
-	<|> (ToRemote . parseRemoteOption <$> parseToOption)
+	<|> (To . map parseRemoteOption <$> some parseToOption)
 
 parseFromOption :: Parser RemoteName
 parseFromOption = strOption
@@ -147,21 +145,25 @@ parseToOption = strOption
 	)
 
 -- | Like FromToOptions, but with a special --to=here
-type FromToHereOptions = Either ToHere FromToOptions
+type FromToHereOptions r = Either ToHere (FromToOptions r)
 
 data ToHere = ToHere
 
-parseFromToHereOptions :: Parser FromToHereOptions
+parseFromToHereOptions :: Parser (FromToHereOptions [DeferredParse Remote])
 parseFromToHereOptions = parsefrom <|> parseto
   where
-	parsefrom = Right . FromRemote . parseRemoteOption <$> parseFromOption
+	parsefrom = Right . From . map parseRemoteOption <$> some parseFromOption
-	parseto = herespecialcase <$> parseToOption
+	parseto = herespecialcase <$> some parseToOption
 	  where
-		herespecialcase "here" = Left ToHere
+		herespecialcase l
-		herespecialcase "." = Left ToHere
+			| any ishere l && all ishere l = Left ToHere
-		herespecialcase n = Right $ ToRemote $ parseRemoteOption n
+			| any ishere l = fail "Cannot mix --to=here with --to=remote"
+			| otherwise = Right $ To $ map parseRemoteOption l
+		ishere "here" = True
+		ishere "." = True
+		ishere _ = False
 
-instance DeferredParseClass FromToHereOptions where
+instance DeferredParseClass (FromToHereOptions [DeferredParse r]) where
 	finishParse = either (pure . Left) (Right <$$> finishParse)
 
 -- Options for acting on keys, rather than work tree files.

Command/Move.hs

@@ -28,7 +28,7 @@ cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMat
 
 data MoveOptions = MoveOptions
 	{ moveFiles :: CmdParams
-	, fromToOptions :: FromToHereOptions
+	, fromToOptions :: FromToHereOptions [DeferredParse Remote]
 	, removeWhen :: RemoveWhen
 	, keyOptions :: Maybe KeyOptions
 	, batchOption :: BatchMode
@@ -54,34 +54,42 @@ data RemoveWhen = RemoveSafe | RemoveNever
 	deriving (Show, Eq)
 
 seek :: MoveOptions -> CommandSeek
-seek o = allowConcurrentOutput $ do
+seek o = allowConcurrentOutput $
-	let go = whenAnnexed $ start (fromToOptions o) (removeWhen o)
 	case batchOption o of
-		Batch fmt -> batchFilesMatching fmt go
+		Batch fmt -> batchFilesMatching fmt $ \f -> seekremotes' $ \r -> go r f
 		NoBatch -> withKeyOptions (keyOptions o) False
-			(commandAction . startKey (fromToOptions o) (removeWhen o))
+			(\kai -> seekremotes $ \r -> commandAction $ startKey r (removeWhen o) kai)
-			(withFilesInGit (commandAction . go))
+			(withFilesInGit $ \f -> seekremotes $ \r -> commandAction $ go r f)
 			=<< workTreeItems (moveFiles o)
+  where
+	go r = whenAnnexed $ start r (removeWhen o)
 
-start :: FromToHereOptions -> RemoveWhen -> FilePath -> Key -> CommandStart
+	seekremotes :: (FromToHereOptions Remote -> Annex ()) -> Annex ()
+	seekremotes a = case fromToOptions o of
+		Right (From rs) -> mapM_ (a . Right . From) =<< mapM getParsed rs
+		Right (To rs) -> mapM_ (a . Right . To) =<< mapM getParsed rs
+		Left ToHere -> a $ Left ToHere
+	seekremotes' = undefined
+
+start :: FromToHereOptions Remote -> RemoveWhen -> FilePath -> Key -> CommandStart
 start fromto removewhen f k =
 	start' fromto removewhen afile k (mkActionItem afile)
   where
 	afile = AssociatedFile (Just f)
 
-startKey :: FromToHereOptions -> RemoveWhen -> (Key, ActionItem) -> CommandStart
+startKey :: FromToHereOptions Remote -> RemoveWhen -> (Key, ActionItem) -> CommandStart
 startKey fromto removewhen = 
 	uncurry $ start' fromto removewhen (AssociatedFile Nothing)
 
-start' :: FromToHereOptions -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> CommandStart
+start' :: FromToHereOptions Remote -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> CommandStart
 start' fromto removewhen afile key ai = onlyActionOn key $
 	case fromto of
-		Right (FromRemote src) ->
+		Right (From src) ->
 			checkFailedTransferDirection ai Download $
-				fromStart removewhen afile key ai =<< getParsed src
+				fromStart removewhen afile key ai src
-		Right (ToRemote dest) ->
+		Right (To dest) ->
 			checkFailedTransferDirection ai Upload $
-				toStart removewhen afile key ai =<< getParsed dest
+				toStart removewhen afile key ai dest
 		Left ToHere ->
 			checkFailedTransferDirection ai Download $
 				toHereStart removewhen afile key ai

Command/TransferKey.hs

@@ -22,7 +22,7 @@ cmd = noCommit $
 
 data TransferKeyOptions = TransferKeyOptions
 	{ keyOptions :: CmdParams 
-	, fromToOptions :: FromToOptions
+	, fromToOptions :: FromToOptions [DeferredParse Remote]
 	, fileOption :: AssociatedFile
 	}
 
@@ -42,26 +42,27 @@ instance DeferredParseClass TransferKeyOptions where
 		<*> pure (fileOption v)
 
 seek :: TransferKeyOptions -> CommandSeek
-seek o = withKeys (commandAction . start o) (keyOptions o)
+seek o = withKeys go (keyOptions o)
+  where
+	go k = case fromToOptions o of
+		To dest -> commandActions =<<
+			(map (toStart k (fileOption o)) <$> mapM getParsed dest)
+		From src -> commandActions =<<
+			(map (fromStart k (fileOption o)) <$> mapM getParsed src)
 
-start :: TransferKeyOptions -> Key -> CommandStart
+toStart :: Key -> AssociatedFile -> Remote -> CommandStart
-start o key = case fromToOptions o of
+toStart key file remote = next $ perform Upload file $
-	ToRemote dest -> next $ toPerform key (fileOption o) =<< getParsed dest
-	FromRemote src -> next $ fromPerform key (fileOption o) =<< getParsed src
-
-toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
-toPerform key file remote = go Upload file $
 	upload (uuid remote) key file stdRetry $ \p -> do
 		ok <- Remote.storeKey remote key file p
 		when ok $
 			Remote.logStatus remote key InfoPresent
 		return ok
 
-fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
+fromStart :: Key -> AssociatedFile -> Remote -> CommandStart
-fromPerform key file remote = go Upload file $
+fromStart key file remote = next $ perform Upload file $
 	download (uuid remote) key file stdRetry $ \p ->
 		getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key $ 
 			\t -> Remote.retrieveKeyFile remote key file t p
 
-go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform
+perform :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform
-go direction file a = notifyTransfer direction file a >>= liftIO . exitBool
+perform direction file a = notifyTransfer direction file a >>= liftIO . exitBool

doc/git-annex-move.mdwn

@@ -4,7 +4,7 @@ git-annex move - move content of files to/from another repository
 
 # SYNOPSIS
 
-git annex move `[path ...] [--from=remote|--to=remote|--to=here]`
+git annex move `[path ...] [--from=remote ... |--to=remote ... |--to=here]`
 
 # DESCRIPTION
 
@@ -16,10 +16,16 @@ Moves the content of files from or to another remote.
 
   Move the content of files from the specified remote to the local repository.
 
+  Can be specified multiple times to move from multiple remotes, and when
+  the --jobs option is used, will download from the remotes in parallel.
+
 * `--to=remote`
 
   Move the content of files from the local repository to the specified remote.
 
+  Can be specified multiple times to move to multiple remotes, and when
+  the --jobs option is used, will upload to the remotes in parallel.
+
 * `--to=here`
 
   Move the content of files from all reachable remotes to the local

doc/git-annex-transferkey.mdwn

@@ -4,7 +4,7 @@ git-annex transferkey - transfers a key from or to a remote
 
 # SYNOPSIS
 
-git annex transferkey `key [--from=remote|--to=remote]`
+git annex transferkey `key [--from=remote ... |--to=remote ...]`
 
 # DESCRIPTION