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
This commit is contained in:
Joey Hess 2023-01-18 14:42:39 -04:00
parent 2a92f5cc2c
commit a6c1d9752b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
6 changed files with 93 additions and 49 deletions

View file

@ -1,6 +1,6 @@
{- git-annex command
-
- Copyright 2010 Joey Hess <id@joeyh.name>
- Copyright 2010-2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@ -21,7 +21,7 @@ cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatc
data CopyOptions = CopyOptions
{ copyFiles :: CmdParams
, fromToOptions :: FromToHereOptions
, fromToOptions :: Maybe FromToHereOptions
, keyOptions :: Maybe KeyOptions
, autoMode :: Bool
, batchOption :: BatchMode
@ -38,13 +38,19 @@ optParser desc = CopyOptions
instance DeferredParseClass CopyOptions where
finishParse v = CopyOptions
<$> pure (copyFiles v)
<*> finishParse (fromToOptions v)
<*> maybe (pure Nothing) (Just <$$> finishParse)
(fromToOptions v)
<*> pure (keyOptions v)
<*> pure (autoMode v)
<*> pure (batchOption v)
seek :: CopyOptions -> CommandSeek
seek o = startConcurrency commandStages $ do
seek o = case fromToOptions o of
Just fto -> seek' o fto
Nothing -> giveup "Specify --from or --to"
seek' :: CopyOptions -> FromToHereOptions -> CommandSeek
seek' o fto = startConcurrency commandStages $ do
case batchOption o of
NoBatch -> withKeyOptions
(keyOptions o) (autoMode o) seeker
@ -57,30 +63,33 @@ seek o = startConcurrency commandStages $ do
ww = WarnUnmatchLsFiles
seeker = AnnexedFileSeeker
{ startAction = start o
, checkContentPresent = case fromToOptions o of
Right (FromRemote _) -> Just False
Right (ToRemote _) -> Just True
Left ToHere -> Just False
{ startAction = start o fto
, checkContentPresent = case fto of
FromOrToRemote (FromRemote _) -> Just False
FromOrToRemote (ToRemote _) -> Just True
ToHere -> Just False
FromRemoteToRemote _ _ -> Just False
, usesLocationLog = True
}
keyaction = Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever
keyaction = Command.Move.startKey fto Command.Move.RemoveNever
{- A copy is just a move that does not delete the source file.
- However, auto mode avoids unnecessary copies, and avoids getting or
- sending non-preferred content. -}
start :: CopyOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
start o si file key = stopUnless shouldCopy $
Command.Move.start (fromToOptions o) Command.Move.RemoveNever si file key
start :: CopyOptions -> FromToHereOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
start o fto si file key = stopUnless shouldCopy $
Command.Move.start fto Command.Move.RemoveNever si file key
where
shouldCopy
| autoMode o = want <||> numCopiesCheck file key (<)
| otherwise = return True
want = case fromToOptions o of
Right (ToRemote dest) ->
want = case fto of
FromOrToRemote (ToRemote dest) ->
(Remote.uuid <$> getParsed dest) >>= checkwantsend
FromOrToRemote (FromRemote _) -> checkwantget
ToHere -> checkwantget
FromRemoteToRemote _ dest ->
(Remote.uuid <$> getParsed dest) >>= checkwantsend
Right (FromRemote _) -> checkwantget
Left ToHere -> checkwantget
checkwantsend = wantGetBy False (Just key) (AssociatedFile (Just file))
checkwantget = wantGet False (Just key) (AssociatedFile (Just file))