converted copy and move
Got a little tricky..
This commit is contained in:
Joey Hess
parent
032e6485fa
commit
8ad927dbc6
8 changed files with 136 additions and 81 deletions
|
|
@ -15,34 +15,43 @@ import Annex.Wanted
|
|||
import Annex.NumCopies
|
||||
|
||||
cmd :: Command
|
||||
cmd = withOptions copyOptions $
|
||||
command "copy" SectionCommon
|
||||
"copy content of files to/from another repository"
|
||||
paramPaths (withParams seek)
|
||||
cmd = command "copy" SectionCommon
|
||||
"copy content of files to/from another repository"
|
||||
paramPaths ((seek <=< finishParse) <$$> optParser)
|
||||
|
||||
copyOptions :: [Option]
|
||||
copyOptions = Command.Move.moveOptions ++ [autoOption]
|
||||
data CopyOptions = CopyOptions
|
||||
{ moveOptions :: Command.Move.MoveOptions
|
||||
, autoMode :: Bool
|
||||
}
|
||||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek ps = do
|
||||
to <- getOptionField toOption Remote.byNameWithUUID
|
||||
from <- getOptionField fromOption Remote.byNameWithUUID
|
||||
auto <- getOptionFlag autoOption
|
||||
withKeyOptions auto
|
||||
(Command.Move.startKey to from False)
|
||||
(withFilesInGit $ whenAnnexed $ start auto to from)
|
||||
ps
|
||||
optParser :: CmdParamsDesc -> Parser CopyOptions
|
||||
optParser desc = CopyOptions
|
||||
<$> Command.Move.optParser desc
|
||||
<*> parseAutoOption
|
||||
|
||||
instance DeferredParseClass CopyOptions where
|
||||
finishParse v = CopyOptions
|
||||
<$> finishParse (moveOptions v)
|
||||
<*> pure (autoMode v)
|
||||
|
||||
seek :: CopyOptions -> CommandSeek
|
||||
seek o = withKeyOptions (Command.Move.keyOptions $ moveOptions o) (autoMode o)
|
||||
(Command.Move.startKey (moveOptions o) False)
|
||||
(withFilesInGit $ whenAnnexed $ start o)
|
||||
(Command.Move.moveFiles $ moveOptions 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 :: Bool -> Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
|
||||
start auto to from file key = stopUnless shouldCopy $
|
||||
Command.Move.start to from False file key
|
||||
start :: CopyOptions -> FilePath -> Key -> CommandStart
|
||||
start o file key = stopUnless shouldCopy $
|
||||
Command.Move.start (moveOptions o) False file key
|
||||
where
|
||||
shouldCopy
|
||||
| auto = want <||> numCopiesCheck file key (<)
|
||||
| autoMode o = want <||> numCopiesCheck file key (<)
|
||||
| otherwise = return True
|
||||
want = case to of
|
||||
Nothing -> wantGet False (Just key) (Just file)
|
||||
Just r -> wantSend False (Just key) (Just file) (Remote.uuid r)
|
||||
want = case Command.Move.fromToOptions (moveOptions o) of
|
||||
ToRemote _ ->
|
||||
wantGet False (Just key) (Just file)
|
||||
FromRemote dest -> (Remote.uuid <$> getParsed dest) >>=
|
||||
wantSend False (Just key) (Just file)
|
||||
|
|
|
|||
|
|
@ -19,10 +19,8 @@ import Annex.NumCopies
|
|||
import Annex.Content
|
||||
import Annex.Wanted
|
||||
import Annex.Notification
|
||||
import Git.Types (RemoteName)
|
||||
|
||||
import qualified Data.Set as S
|
||||
import Options.Applicative hiding (command)
|
||||
|
||||
cmd :: Command
|
||||
cmd = command "drop" SectionCommon
|
||||
|
|
@ -31,9 +29,9 @@ cmd = command "drop" SectionCommon
|
|||
|
||||
data DropOptions = DropOptions
|
||||
{ dropFiles :: CmdParams
|
||||
, dropFrom :: Maybe RemoteName
|
||||
, dropFrom :: Maybe (DeferredParse Remote)
|
||||
, autoMode :: Bool
|
||||
, keyOptions :: KeyOptions
|
||||
, keyOptions :: Maybe KeyOptions
|
||||
}
|
||||
|
||||
-- TODO: annexedMatchingOptions
|
||||
|
|
@ -41,12 +39,12 @@ data DropOptions = DropOptions
|
|||
optParser :: CmdParamsDesc -> Parser DropOptions
|
||||
optParser desc = DropOptions
|
||||
<$> cmdParams desc
|
||||
<*> parseDropFromOption
|
||||
<*> optional parseDropFromOption
|
||||
<*> parseAutoOption
|
||||
<*> parseKeyOptions False
|
||||
<*> optional (parseKeyOptions False)
|
||||
|
||||
parseDropFromOption :: Parser (Maybe RemoteName)
|
||||
parseDropFromOption = optional $ strOption
|
||||
parseDropFromOption :: Parser (DeferredParse Remote)
|
||||
parseDropFromOption = parseRemoteOption $ strOption
|
||||
( long "from" <> short 'f' <> metavar paramRemote
|
||||
<> help "drop content from a remote"
|
||||
)
|
||||
|
|
@ -62,7 +60,7 @@ start o file key = start' o key (Just file)
|
|||
|
||||
start' :: DropOptions -> Key -> AssociatedFile -> CommandStart
|
||||
start' o key afile = do
|
||||
from <- Remote.byNameWithUUID (dropFrom o)
|
||||
from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
|
||||
checkDropAuto (autoMode o) from afile key $ \numcopies ->
|
||||
stopUnless (want from) $
|
||||
case from of
|
||||
|
|
|
|||
|
|
@ -40,7 +40,6 @@ import qualified Database.Fsck as FsckDb
|
|||
|
||||
import Data.Time.Clock.POSIX
|
||||
import System.Posix.Types (EpochTime)
|
||||
import Options.Applicative hiding (command)
|
||||
|
||||
cmd :: Command
|
||||
cmd = command "fsck" SectionMaintenance
|
||||
|
|
|
|||
|
|
@ -18,36 +18,47 @@ import Annex.Transfer
|
|||
import Logs.Presence
|
||||
|
||||
cmd :: Command
|
||||
cmd = withOptions moveOptions $
|
||||
command "move" SectionCommon
|
||||
"move content of files to/from another repository"
|
||||
paramPaths (withParams seek)
|
||||
cmd = command "move" SectionCommon
|
||||
"move content of files to/from another repository"
|
||||
paramPaths ((seek <=< finishParse) <$$> optParser)
|
||||
|
||||
moveOptions :: [Option]
|
||||
moveOptions = fromToOptions ++ [jobsOption] ++ keyOptions ++ annexedMatchingOptions
|
||||
data MoveOptions = MoveOptions
|
||||
{ moveFiles :: CmdParams
|
||||
, fromToOptions :: FromToOptions
|
||||
, keyOptions :: Maybe KeyOptions
|
||||
}
|
||||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek ps = do
|
||||
to <- getOptionField toOption Remote.byNameWithUUID
|
||||
from <- getOptionField fromOption Remote.byNameWithUUID
|
||||
withKeyOptions False
|
||||
(startKey to from True)
|
||||
(withFilesInGit $ whenAnnexed $ start to from True)
|
||||
ps
|
||||
-- TODO: jobsOption, annexedMatchingOptions
|
||||
|
||||
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart
|
||||
start to from move = start' to from move . Just
|
||||
optParser :: CmdParamsDesc -> Parser MoveOptions
|
||||
optParser desc = MoveOptions
|
||||
<$> cmdParams desc
|
||||
<*> parseFromToOptions
|
||||
<*> optional (parseKeyOptions False)
|
||||
|
||||
startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
|
||||
startKey to from move = start' to from move Nothing
|
||||
instance DeferredParseClass MoveOptions where
|
||||
finishParse v = MoveOptions
|
||||
<$> pure (moveFiles v)
|
||||
<*> finishParse (fromToOptions v)
|
||||
<*> pure (keyOptions v)
|
||||
|
||||
start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart
|
||||
start' to from move afile key = do
|
||||
case (from, to) of
|
||||
(Nothing, Nothing) -> error "specify either --from or --to"
|
||||
(Nothing, Just dest) -> toStart dest move afile key
|
||||
(Just src, Nothing) -> fromStart src move afile key
|
||||
_ -> error "only one of --from or --to can be specified"
|
||||
seek :: MoveOptions -> CommandSeek
|
||||
seek o = withKeyOptions (keyOptions o) False
|
||||
(startKey o True)
|
||||
(withFilesInGit $ whenAnnexed $ start o True)
|
||||
(moveFiles o)
|
||||
|
||||
start :: MoveOptions -> Bool -> FilePath -> Key -> CommandStart
|
||||
start o move = start' o move . Just
|
||||
|
||||
startKey :: MoveOptions -> Bool -> Key -> CommandStart
|
||||
startKey o move = start' o move Nothing
|
||||
|
||||
start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> CommandStart
|
||||
start' o move afile key =
|
||||
case fromToOptions o of
|
||||
FromRemote src -> fromStart move afile key =<< getParsed src
|
||||
ToRemote dest -> toStart move afile key =<< getParsed dest
|
||||
|
||||
showMoveAction :: Bool -> Key -> AssociatedFile -> Annex ()
|
||||
showMoveAction move = showStart' (if move then "move" else "copy")
|
||||
|
|
@ -61,8 +72,8 @@ showMoveAction move = showStart' (if move then "move" else "copy")
|
|||
- A file's content can be moved even if there are insufficient copies to
|
||||
- allow it to be dropped.
|
||||
-}
|
||||
toStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
|
||||
toStart dest move afile key = do
|
||||
toStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart
|
||||
toStart move afile key dest = do
|
||||
u <- getUUID
|
||||
ishere <- inAnnex key
|
||||
if not ishere || u == Remote.uuid dest
|
||||
|
|
@ -124,8 +135,8 @@ toPerform dest move key afile fastcheck isthere =
|
|||
- If the current repository already has the content, it is still removed
|
||||
- from the remote.
|
||||
-}
|
||||
fromStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
|
||||
fromStart src move afile key
|
||||
fromStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart
|
||||
fromStart move afile key src
|
||||
| move = go
|
||||
| otherwise = stopUnless (not <$> inAnnex key) go
|
||||
where
|
||||
|
|
|
|||
|
|
@ -49,8 +49,8 @@ start (k:[]) = do
|
|||
, transferUUID = u
|
||||
, transferKey = key
|
||||
}
|
||||
info <- liftIO $ startTransferInfo file
|
||||
(update, tfile, _) <- mkProgressUpdater t info
|
||||
tinfo <- liftIO $ startTransferInfo file
|
||||
(update, tfile, _) <- mkProgressUpdater t tinfo
|
||||
liftIO $ mapM_ void
|
||||
[ tryIO $ forever $ do
|
||||
bytes <- readUpdate
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue