git-annex/Command/Copy.hs
Joey Hess 152be2948b
use transfer stages for copy --from
See commit e04a931439 for an explanation
of why move uses transfer stages for --from, but command stages for
--to. At the point of that commit, copy was actually already using
command stages for everything, so the commit was incorrect about
improving copy --to.

But, the same reasoning about --from applies to copy as to move; when
verification is not done incrementally, download and verification are
the main two stages. The cleanup stage for copy is even less work than
for move (it doesn't drop from the remote).

Sponsored-by: Dartmouth College's DANDI project
2023-01-24 14:07:49 -04:00

95 lines
2.9 KiB
Haskell

{- git-annex command
-
- Copyright 2010-2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.Copy where
import Command
import qualified Command.Move
import qualified Remote
import Annex.Wanted
import Annex.NumCopies
cmd :: Command
cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $
command "copy" SectionCommon
"copy content of files to/from another repository"
paramPaths (seek <--< optParser)
data CopyOptions = CopyOptions
{ copyFiles :: CmdParams
, fromToOptions :: Maybe FromToHereOptions
, keyOptions :: Maybe KeyOptions
, autoMode :: Bool
, batchOption :: BatchMode
}
optParser :: CmdParamsDesc -> Parser CopyOptions
optParser desc = CopyOptions
<$> cmdParams desc
<*> parseFromToHereOptions
<*> optional (parseKeyOptions <|> parseFailedTransfersOption)
<*> parseAutoOption
<*> parseBatchOption True
instance DeferredParseClass CopyOptions where
finishParse v = CopyOptions
<$> pure (copyFiles v)
<*> maybe (pure Nothing) (Just <$$> finishParse)
(fromToOptions v)
<*> pure (keyOptions v)
<*> pure (autoMode v)
<*> pure (batchOption v)
seek :: CopyOptions -> CommandSeek
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 (Command.Move.stages fto) $ do
case batchOption o of
NoBatch -> withKeyOptions
(keyOptions o) (autoMode o) seeker
(commandAction . keyaction)
(withFilesInGitAnnex ww seeker)
=<< workTreeItems ww (copyFiles o)
Batch fmt -> batchOnly (keyOptions o) (copyFiles o) $
batchAnnexed fmt seeker keyaction
where
ww = WarnUnmatchLsFiles
seeker = AnnexedFileSeeker
{ 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 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 -> 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 fto of
FromOrToRemote (ToRemote dest) ->
(Remote.uuid <$> getParsed dest) >>= checkwantsend
FromOrToRemote (FromRemote _) -> checkwantget
ToHere -> checkwantget
FromRemoteToRemote _ dest ->
(Remote.uuid <$> getParsed dest) >>= checkwantsend
checkwantsend = wantGetBy False (Just key) (AssociatedFile (Just file))
checkwantget = wantGet False (Just key) (AssociatedFile (Just file))