move/copy: option parsing for --from with --to

Allowing --from and --to as an alternative to --from or --to
is hard to do with optparse-applicative!

The obvious approach of (pfrom <|> pto <|> pfromandto) does not work
when pfromandto uses the same option names as pfrom and pto do.
It compiles but the generated parser does not work for all desired
combinations.

Instead, have to parse optionally from and optionally to. When neither
is provided, the parser succeeds, but it's a result that can't be
handled. So, have to giveup after option parsing. There does not seem to
be a way to make an optparse-applicative Parser give up internally
either.

Also, need seek' because I first tried making fto be a where binding,
but that resulted in a hang when git-annex move was run without --from
or --to. I think because startConcurrency was not expecting the stages
value to contain an exception and so ended up blocking.

Sponsored-by: Dartmouth College's DANDI project

CmdLine/GitAnnex/Options.hs

@@ -1,6 +1,6 @@
 {- git-annex command-line option parsing
  -
- - Copyright 2010-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -134,7 +134,7 @@ parseDryRunOption = DryRun <$> switch
 	<> help "don't make changes, but show what would be done"
 	)
 
--- | From or To a remote.
+-- | From or To a remote but not both.
 data FromToOptions
 	= FromRemote (DeferredParse Remote)
 	| ToRemote (DeferredParse Remote)
@@ -162,23 +162,34 @@ parseToOption = strOption
 	<> completeRemotes
 	)
 
--- | Like FromToOptions, but with a special --to=here
-type FromToHereOptions = Either ToHere FromToOptions
+-- | From or to a remote, or both, or a special --to=here
+data FromToHereOptions 
+	= FromOrToRemote FromToOptions
+	| ToHere
+	| FromRemoteToRemote (DeferredParse Remote) (DeferredParse Remote)
 
-data ToHere = ToHere
-
-parseFromToHereOptions :: Parser FromToHereOptions
-parseFromToHereOptions = parsefrom <|> parseto
+parseFromToHereOptions :: Parser (Maybe FromToHereOptions)
+parseFromToHereOptions = go
+	<$> optional parseFromOption
+	<*> optional parseToOption
   where
-	parsefrom = Right . FromRemote . parseRemoteOption <$> parseFromOption
-	parseto = herespecialcase <$> parseToOption
-	  where
-		herespecialcase "here" = Left ToHere
-		herespecialcase "." = Left ToHere
-		herespecialcase n = Right $ ToRemote $ parseRemoteOption n
+	go (Just from) (Just to) = Just $ FromRemoteToRemote
+		(parseRemoteOption from)
+		(parseRemoteOption to)
+	go (Just from) Nothing = Just $ FromOrToRemote
+		(FromRemote $ parseRemoteOption from)
+	go Nothing (Just to) = Just $ case to of
+		"here" -> ToHere
+		"." -> ToHere
+		_ -> FromOrToRemote $ ToRemote $ parseRemoteOption to
+	go Nothing Nothing = Nothing
 
 instance DeferredParseClass FromToHereOptions where
-	finishParse = either (pure . Left) (Right <$$> finishParse)
+	finishParse (FromOrToRemote v) = FromOrToRemote <$> finishParse v
+	finishParse ToHere = pure ToHere
+	finishParse (FromRemoteToRemote v1 v2) = FromRemoteToRemote
+		<$> finishParse v1
+		<*> finishParse v2
 
 -- Options for acting on keys, rather than work tree files.
 data KeyOptions