From 508517de485e77196a8d8e33558f4185c50dea96 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 3 Aug 2016 12:37:12 -0400
Subject: 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/
---
 CmdLine/GitAnnex/Options.hs | 49 +++++++++++++++++++++++++--------------------
 CmdLine/Seek.hs             | 21 ++++++++++++++-----
 2 files changed, 43 insertions(+), 27 deletions(-)

(limited to 'CmdLine')

diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index db2efeda5..64f70d178 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -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
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
-- 
cgit v1.2.3