diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-08-03 12:37:12 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-08-03 12:37:12 -0400 |
commit | 508517de485e77196a8d8e33558f4185c50dea96 (patch) | |
tree | 319fc6e63da144e40dd124a07f4bb6c0ad25c5ee /CmdLine/Seek.hs | |
parent | 019733f00d01301d71acc46245d2dc130934d951 (diff) |
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/
Diffstat (limited to 'CmdLine/Seek.hs')
-rw-r--r-- | CmdLine/Seek.hs | 21 |
1 files changed, 16 insertions, 5 deletions
diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index 56592349b..5d20ad0db 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -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 |