diff --git a/Command/Copy.hs b/Command/Copy.hs index 85a556a14f..3b5080c3be 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -20,46 +20,55 @@ cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMat paramPaths (seek <--< optParser) data CopyOptions = CopyOptions - { moveOptions :: Command.Move.MoveOptions + { copyFiles :: CmdParams + , fromToOptions :: FromToHereOptions + , keyOptions :: Maybe KeyOptions , autoMode :: Bool + , batchOption :: BatchMode } optParser :: CmdParamsDesc -> Parser CopyOptions optParser desc = CopyOptions - <$> Command.Move.optParser desc + <$> cmdParams desc + <*> parseFromToHereOptions + <*> optional (parseKeyOptions <|> parseFailedTransfersOption) <*> parseAutoOption + <*> parseBatchOption instance DeferredParseClass CopyOptions where finishParse v = CopyOptions - <$> finishParse (moveOptions v) + <$> pure (copyFiles v) + <*> finishParse (fromToOptions v) + <*> pure (keyOptions v) <*> pure (autoMode v) + <*> pure (batchOption v) seek :: CopyOptions -> CommandSeek seek o = allowConcurrentOutput $ do let go = whenAnnexed $ start o - case Command.Move.batchOption (moveOptions o) of + case batchOption o of Batch -> batchInput Right (batchCommandAction . go) NoBatch -> withKeyOptions - (Command.Move.keyOptions $ moveOptions o) (autoMode o) - (Command.Move.startKey (moveOptions o) False) + (keyOptions o) (autoMode o) + (Command.Move.startKey (fromToOptions o) False) (withFilesInGit go) - =<< workTreeItems (Command.Move.moveFiles $ moveOptions o) + =<< workTreeItems (copyFiles o) {- 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 -> FilePath -> Key -> CommandStart start o file key = stopUnless shouldCopy $ - Command.Move.start (moveOptions o) False file key + Command.Move.start (fromToOptions o) False file key where shouldCopy | autoMode o = want <||> numCopiesCheck file key (<) | otherwise = return True - want = case Command.Move.fromToOptions (moveOptions o) of + want = case fromToOptions o of Right (ToRemote dest) -> (Remote.uuid <$> getParsed dest) >>= checkwantsend Right (FromRemote _) -> checkwantget - Left Command.Move.ToHere -> checkwantget + Left ToHere -> checkwantget checkwantsend = wantSend False (Just key) (AssociatedFile (Just file)) checkwantget = wantGet False (Just key) (AssociatedFile (Just file)) diff --git a/Command/Move.hs b/Command/Move.hs index 844d9ad013..cbb7d9a2b0 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -48,25 +48,25 @@ instance DeferredParseClass MoveOptions where seek :: MoveOptions -> CommandSeek seek o = allowConcurrentOutput $ do - let go = whenAnnexed $ start o True + let go = whenAnnexed $ start (fromToOptions o) True case batchOption o of Batch -> batchInput Right (batchCommandAction . go) NoBatch -> withKeyOptions (keyOptions o) False - (startKey o True) + (startKey (fromToOptions o) True) (withFilesInGit go) =<< workTreeItems (moveFiles o) -start :: MoveOptions -> Bool -> FilePath -> Key -> CommandStart -start o move f k = start' o move afile k (mkActionItem afile) +start :: FromToHereOptions -> Bool -> FilePath -> Key -> CommandStart +start fromto move f k = start' fromto move afile k (mkActionItem afile) where afile = AssociatedFile (Just f) -startKey :: MoveOptions -> Bool -> Key -> ActionItem -> CommandStart -startKey o move = start' o move (AssociatedFile Nothing) +startKey :: FromToHereOptions -> Bool -> Key -> ActionItem -> CommandStart +startKey fromto move = start' fromto move (AssociatedFile Nothing) -start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart -start' o move afile key ai = onlyActionOn key $ - case fromToOptions o of +start' :: FromToHereOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart +start' fromto move afile key ai = onlyActionOn key $ + case fromto of Right (FromRemote src) -> checkFailedTransferDirection ai Download $ fromStart move afile key ai =<< getParsed src