aboutsummaryrefslogtreecommitdiff
path: root/CmdLine/Seek.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-08-03 12:37:12 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-08-03 12:37:12 -0400
commit508517de485e77196a8d8e33558f4185c50dea96 (patch)
tree319fc6e63da144e40dd124a07f4bb6c0ad25c5ee /CmdLine/Seek.hs
parent019733f00d01301d71acc46245d2dc130934d951 (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.hs21
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