get, move, copy, mirror: Added --failed switch which retries failed copies/moves
Note that get --from foo --failed will get things that a previous get --from bar tried and failed to get, etc. I considered making --failed only retry transfers from the same remote, but it was easier, and seems more useful, to not have the same remote requirement. Noisy due to some refactoring into Types/
This commit is contained in:
parent
0fc85c45b5
commit
1a0e2c9901
53 changed files with 254 additions and 127 deletions
|
@ -139,32 +139,37 @@ parseToOption = parseRemoteOption $ strOption
|
|||
data KeyOptions
|
||||
= WantAllKeys
|
||||
| WantUnusedKeys
|
||||
| WantFailedTransfers
|
||||
| WantSpecificKey Key
|
||||
| WantIncompleteKeys
|
||||
| WantBranchKeys [Branch]
|
||||
|
||||
parseKeyOptions :: Bool -> Parser KeyOptions
|
||||
parseKeyOptions allowincomplete = if allowincomplete
|
||||
then base
|
||||
<|> flag' WantIncompleteKeys
|
||||
( long "incomplete"
|
||||
<> help "resume previous downloads"
|
||||
)
|
||||
else base
|
||||
where
|
||||
base = parseAllOption
|
||||
<|> WantBranchKeys <$> some (option (str >>= pure . Ref)
|
||||
( long "branch" <> metavar paramRef
|
||||
<> help "operate on files in the specified branch or treeish"
|
||||
))
|
||||
<|> flag' WantUnusedKeys
|
||||
( long "unused" <> short 'U'
|
||||
<> help "operate on files found by last run of git-annex unused"
|
||||
)
|
||||
<|> (WantSpecificKey <$> option (str >>= parseKey)
|
||||
( long "key" <> metavar paramKey
|
||||
<> help "operate on specified key"
|
||||
))
|
||||
parseKeyOptions :: Parser KeyOptions
|
||||
parseKeyOptions = parseAllOption
|
||||
<|> WantBranchKeys <$> some (option (str >>= pure . Ref)
|
||||
( long "branch" <> metavar paramRef
|
||||
<> help "operate on files in the specified branch or treeish"
|
||||
))
|
||||
<|> flag' WantUnusedKeys
|
||||
( long "unused" <> short 'U'
|
||||
<> help "operate on files found by last run of git-annex unused"
|
||||
)
|
||||
<|> (WantSpecificKey <$> option (str >>= parseKey)
|
||||
( long "key" <> metavar paramKey
|
||||
<> help "operate on specified key"
|
||||
))
|
||||
|
||||
parseFailedTransfersOption :: Parser KeyOptions
|
||||
parseFailedTransfersOption = flag' WantFailedTransfers
|
||||
( long "failed"
|
||||
<> help "operate on files that recently failed to be transferred"
|
||||
)
|
||||
|
||||
parseIncompleteOption :: Parser KeyOptions
|
||||
parseIncompleteOption = flag' WantIncompleteKeys
|
||||
( long "incomplete"
|
||||
<> help "resume previous downloads"
|
||||
)
|
||||
|
||||
parseAllOption :: Parser KeyOptions
|
||||
parseAllOption = flag' WantAllKeys
|
||||
|
|
|
@ -25,6 +25,10 @@ import CmdLine.GitAnnex.Options
|
|||
import CmdLine.Action
|
||||
import Logs.Location
|
||||
import Logs.Unused
|
||||
import Types.Transfer
|
||||
import Logs.Transfer
|
||||
import Remote.List
|
||||
import qualified Remote
|
||||
import Annex.CatFile
|
||||
import Annex.Content
|
||||
|
||||
|
@ -154,8 +158,9 @@ withNothing :: CommandStart -> CmdParams -> CommandSeek
|
|||
withNothing a [] = seekActions $ return [a]
|
||||
withNothing _ _ = error "This command takes no parameters."
|
||||
|
||||
{- Handles the --all, --branch, --unused, --key, and --incomplete options,
|
||||
- which specify particular keys to run an action on.
|
||||
{- Handles the --all, --branch, --unused, --failed, --key, and
|
||||
- --incomplete options, which specify particular keys to run an
|
||||
- action on.
|
||||
-
|
||||
- In a bare repo, --all is the default.
|
||||
-
|
||||
|
@ -180,8 +185,7 @@ withKeyOptions'
|
|||
:: Maybe KeyOptions
|
||||
-> Bool
|
||||
-> Annex (Key -> ActionItem -> Annex ())
|
||||
-> (CmdParams
|
||||
-> CommandSeek)
|
||||
-> (CmdParams -> CommandSeek)
|
||||
-> CmdParams
|
||||
-> CommandSeek
|
||||
withKeyOptions' ko auto mkkeyaction fallbackaction params = do
|
||||
|
@ -195,10 +199,11 @@ withKeyOptions' ko auto mkkeyaction fallbackaction params = do
|
|||
(False, Nothing) -> fallbackaction params
|
||||
(True, Just WantAllKeys) -> noauto $ runkeyaction loggedKeys
|
||||
(True, Just WantUnusedKeys) -> noauto $ runkeyaction unusedKeys'
|
||||
(True, Just WantFailedTransfers) -> noauto runfailedtransfers
|
||||
(True, Just (WantSpecificKey k)) -> noauto $ runkeyaction (return [k])
|
||||
(True, Just WantIncompleteKeys) -> noauto $ runkeyaction incompletekeys
|
||||
(True, Just (WantBranchKeys bs)) -> noauto $ runbranchkeys bs
|
||||
(False, Just _) -> error "Can only specify one of file names, --all, --branch, --unused, --key, or --incomplete"
|
||||
(False, Just _) -> error "Can only specify one of file names, --all, --branch, --unused, --failed, --key, or --incomplete"
|
||||
where
|
||||
noauto a
|
||||
| auto = error "Cannot use --auto with --all or --branch or --unused or --key or --incomplete"
|
||||
|
@ -218,6 +223,12 @@ withKeyOptions' ko auto mkkeyaction fallbackaction params = do
|
|||
=<< catKey (LsTree.sha i)
|
||||
unlessM (liftIO cleanup) $
|
||||
error ("git ls-tree " ++ Git.fromRef b ++ " failed")
|
||||
runfailedtransfers = do
|
||||
keyaction <- mkkeyaction
|
||||
rs <- remoteList
|
||||
ts <- concat <$> mapM (getFailedTransfers . Remote.uuid) rs
|
||||
forM_ ts $ \(t, i) ->
|
||||
keyaction (transferKey t) (mkActionItem (t, i))
|
||||
|
||||
prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]
|
||||
prepFiltered a fs = do
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue