Avoid repeated checking that files passed on the command line exist.

git annex add, git annex lock etc make multiple seek passes,
and each seek pass checked that files existed. That was unncessary
redundant work.

Fixed by adding a new WorkTreeItem type, make seek actions use it,
and check that the files exist when constructing it.

This commit was supported by the NSF-funded DataLad project.

1 files changed, 52 insertions, 43 deletions

diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 556a108eb..72f1303af 100644
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -32,22 +32,20 @@ import qualified Remote
 import Annex.CatFile
 import Annex.Content
 
-withFilesInGit :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
-withFilesInGit a params = seekActions $ prepFiltered a $
-	seekHelper LsFiles.inRepo params
+withFilesInGit :: (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
+withFilesInGit a l = seekActions $ prepFiltered a $
+	seekHelper LsFiles.inRepo l
 
-withFilesInGitNonRecursive :: String -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek
-withFilesInGitNonRecursive needforce a params = ifM (Annex.getState Annex.force)
-	( withFilesInGit a params
-	, if null params
+withFilesInGitNonRecursive :: String -> (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
+withFilesInGitNonRecursive needforce a l = ifM (Annex.getState Annex.force)
+	( withFilesInGit a l
+	, if null l
 		then giveup needforce
-		else do
-			checkFileOrDirectoryExists params
-			seekActions $ prepFiltered a (getfiles [] params)
+		else seekActions $ prepFiltered a (getfiles [] l)
 	)
   where
 	getfiles c [] = return (reverse c)
-	getfiles c (p:ps) = do
+	getfiles c ((WorkTreeItem p):ps) = do
 		(fs, cleanup) <- inRepo $ LsFiles.inRepo [p]
 		case fs of
 			[f] -> do
@@ -58,24 +56,25 @@ withFilesInGitNonRecursive needforce a params = ifM (Annex.getState Annex.force)
 				getfiles c ps
 			_ -> giveup needforce
 
-withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek
-withFilesNotInGit skipdotfiles a params
+withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
+withFilesNotInGit skipdotfiles a l
 	| skipdotfiles = do
 		{- dotfiles are not acted on unless explicitly listed -}
 		files <- filter (not . dotfile) <$>
-			seekunless (null ps && not (null params)) ps
+			seekunless (null ps && not (null l)) ps
 		dotfiles <- seekunless (null dotps) dotps
 		go (files++dotfiles)
-	| otherwise = go =<< seekunless False params
+	| otherwise = go =<< seekunless False l
   where
-	(dotps, ps) = partition dotfile params
+	(dotps, ps) = partition (\(WorkTreeItem f) -> dotfile f) l
 	seekunless True _ = return []
-	seekunless _ l = do
+	seekunless _ l' = do
 		force <- Annex.getState Annex.force
 		g <- gitRepo
-		liftIO $ Git.Command.leaveZombie <$> LsFiles.notInRepo force l g
-	go l = seekActions $ prepFiltered a $
-		return $ concat $ segmentPaths params l
+		liftIO $ Git.Command.leaveZombie
+			<$> LsFiles.notInRepo force (map (\(WorkTreeItem f) -> f) l') g
+	go fs = seekActions $ prepFiltered a $
+		return $ concat $ segmentPaths (map (\(WorkTreeItem f) -> f) l) fs
 
 withFilesInRefs :: (FilePath -> Key -> CommandStart) -> [Git.Ref] -> CommandSeek
 withFilesInRefs a = mapM_ go
@@ -121,14 +120,14 @@ withPairs a params = seekActions $ return $ map a $ pairs [] params
 	pairs c (x:y:xs) = pairs ((x,y):c) xs
 	pairs _ _ = giveup "expected pairs"
 
-withFilesToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
-withFilesToBeCommitted a params = seekActions $ prepFiltered a $
-	seekHelper LsFiles.stagedNotDeleted params
+withFilesToBeCommitted :: (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
+withFilesToBeCommitted a l = seekActions $ prepFiltered a $
+	seekHelper LsFiles.stagedNotDeleted l
 
-withFilesOldUnlocked :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
+withFilesOldUnlocked :: (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
 withFilesOldUnlocked = withFilesOldUnlocked' LsFiles.typeChanged
 
-withFilesOldUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
+withFilesOldUnlockedToBeCommitted :: (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
 withFilesOldUnlockedToBeCommitted = withFilesOldUnlocked' LsFiles.typeChangedStaged
 
 {- Unlocked files before v6 have changed type from a symlink to a regular file.
@@ -136,23 +135,23 @@ withFilesOldUnlockedToBeCommitted = withFilesOldUnlocked' LsFiles.typeChangedSta
  - Furthermore, unlocked files used to be a git-annex symlink,
  - not some other sort of symlink.
  -}
-withFilesOldUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek
-withFilesOldUnlocked' typechanged a params = seekActions $
+withFilesOldUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
+withFilesOldUnlocked' typechanged a l = seekActions $
 	prepFiltered a unlockedfiles
   where
-	unlockedfiles = filterM isOldUnlocked =<< seekHelper typechanged params
+	unlockedfiles = filterM isOldUnlocked =<< seekHelper typechanged l
 
 isOldUnlocked :: FilePath -> Annex Bool
 isOldUnlocked f = liftIO (notSymlink f) <&&> 
 	(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)
 
 {- Finds files that may be modified. -}
-withFilesMaybeModified :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
+withFilesMaybeModified :: (FilePath -> CommandStart) -> [WorkTreeItem] -> CommandSeek
 withFilesMaybeModified a params = seekActions $
 	prepFiltered a $ seekHelper LsFiles.modified params
 
 withKeys :: (Key -> CommandStart) -> CmdParams -> CommandSeek
-withKeys a params = seekActions $ return $ map (a . parse) params
+withKeys a l = seekActions $ return $ map (a . parse) l
   where
 	parse p = fromMaybe (giveup "bad key") $ file2key p
 
@@ -172,8 +171,8 @@ withKeyOptions
 	:: Maybe KeyOptions
 	-> Bool
 	-> (Key -> ActionItem -> CommandStart)
-	-> (CmdParams -> CommandSeek)
-	-> CmdParams
+	-> ([WorkTreeItem] -> CommandSeek)
+	-> [WorkTreeItem]
 	-> CommandSeek
 withKeyOptions ko auto keyaction = withKeyOptions' ko auto mkkeyaction
   where
@@ -187,8 +186,8 @@ withKeyOptions'
 	:: Maybe KeyOptions
 	-> Bool
 	-> Annex (Key -> ActionItem -> Annex ())
-	-> (CmdParams -> CommandSeek)
-	-> CmdParams
+	-> ([WorkTreeItem] -> CommandSeek)
+	-> [WorkTreeItem]
 	-> CommandSeek
 withKeyOptions' ko auto mkkeyaction fallbackaction params = do
 	bare <- fromRepo Git.repoIsLocalBare
@@ -243,17 +242,27 @@ prepFiltered a fs = do
 seekActions :: Annex [CommandStart] -> Annex ()
 seekActions gen = mapM_ commandAction =<< gen
 
-seekHelper :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> [FilePath] -> Annex [FilePath]
-seekHelper a params = do
-	checkFileOrDirectoryExists params
-	inRepo $ \g -> concat . concat <$> forM (segmentXargsOrdered params)
+seekHelper :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> [WorkTreeItem] -> Annex [FilePath]
+seekHelper a l = inRepo $ \g ->
+	concat . concat <$> forM (segmentXargsOrdered l')
 		(runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g))
+  where
+	l' = map (\(WorkTreeItem f) -> f) l
+
+-- An item in the work tree, which may be a file or a directory.
+newtype WorkTreeItem = WorkTreeItem FilePath
 
-checkFileOrDirectoryExists :: [FilePath] -> Annex ()
-checkFileOrDirectoryExists ps = forM_ ps $ \p ->
-	unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $ do
-		toplevelWarning False (p ++ " not found")
-		Annex.incError
+-- Many git commands seek work tree items matching some criteria,
+-- and silently skip over anything that does not exist. But users expect
+-- an error message when one of the files they provided as a command-line
+-- parameter doesn't exist, so this checks that each exists.
+workTreeItems :: CmdParams -> Annex [WorkTreeItem]
+workTreeItems ps = do
+	forM_ ps $ \p ->
+		unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $ do
+			toplevelWarning False (p ++ " not found")
+			Annex.incError
+	return (map WorkTreeItem ps)
 
 notSymlink :: FilePath -> IO Bool
 notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f