Avoid multiple calls to git ls-files when passed eg, "*".

Command.hs

@@ -107,14 +107,14 @@ isAnnexed file a = do
 withFilesInGit :: SubCmdSeekStrings
 withFilesInGit a params = do
 	repo <- Annex.gitRepo
-	files <- liftIO $ mapM (Git.inRepo repo) params
+	files <- liftIO $ Git.inRepo repo params
-	files' <- filterFiles $ foldl (++) [] files
+	files' <- filterFiles files
 	return $ map a files'
 withAttrFilesInGit :: String -> SubCmdSeekAttrFiles
 withAttrFilesInGit attr a params = do
 	repo <- Annex.gitRepo
-	files <- liftIO $ mapM (Git.inRepo repo) params
+	files <- liftIO $ Git.inRepo repo params
-	files' <- filterFiles $ foldl (++) [] files
+	files' <- filterFiles files
 	pairs <- liftIO $ Git.checkAttr repo attr files'
 	return $ map a pairs
 withFilesMissing :: SubCmdSeekStrings
@@ -129,8 +129,8 @@ withFilesMissing a params = do
 withFilesNotInGit :: SubCmdSeekBackendFiles
 withFilesNotInGit a params = do
 	repo <- Annex.gitRepo
-	newfiles <- liftIO $ mapM (Git.notInRepo repo) params
+	newfiles <- liftIO $ Git.notInRepo repo params
-	newfiles' <- filterFiles $ foldl (++) [] newfiles
+	newfiles' <- filterFiles newfiles
 	backendPairs a newfiles'
 withString :: SubCmdSeekStrings
 withString a params = return [a $ unwords params]
@@ -139,21 +139,20 @@ withStrings a params = return $ map a params
 withFilesToBeCommitted :: SubCmdSeekStrings
 withFilesToBeCommitted a params = do
 	repo <- Annex.gitRepo
-	tocommit <- liftIO $ mapM (Git.stagedFiles repo) params
+	tocommit <- liftIO $ Git.stagedFiles repo params
-	tocommit' <- filterFiles $ foldl (++) [] tocommit
+	tocommit' <- filterFiles tocommit
 	return $ map a tocommit'
 withFilesUnlocked :: SubCmdSeekBackendFiles
 withFilesUnlocked = withFilesUnlocked' Git.typeChangedFiles
 withFilesUnlockedToBeCommitted :: SubCmdSeekBackendFiles
 withFilesUnlockedToBeCommitted = withFilesUnlocked' Git.typeChangedStagedFiles
-withFilesUnlocked' :: (Git.Repo -> FilePath -> IO [FilePath]) -> SubCmdSeekBackendFiles
+withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> SubCmdSeekBackendFiles
 withFilesUnlocked' typechanged a params = do
 	-- unlocked files have changed type from a symlink to a regular file
 	repo <- Annex.gitRepo
-	typechangedfiles <- liftIO $ mapM (typechanged repo) params
+	typechangedfiles <- liftIO $ typechanged repo params
 	unlockedfiles <- liftIO $ filterM notSymlink $
-		map (\f -> Git.workTree repo ++ "/" ++ f) $
+		map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles
-		foldl (++) [] typechangedfiles
 	unlockedfiles' <- filterFiles unlockedfiles
 	backendPairs a unlockedfiles'
 withKeys :: SubCmdSeekStrings

Core.hs

@@ -204,6 +204,6 @@ getKeysPresent' dir = do
 getKeysReferenced :: Annex [Key]
 getKeysReferenced = do
 	g <- Annex.gitRepo
-	files <- liftIO $ Git.inRepo g $ Git.workTree g
+	files <- liftIO $ Git.inRepo g [Git.workTree g]
 	keypairs <- mapM Backend.lookupFile files
 	return $ map fst $ catMaybes keypairs

GitRepo.hs

@@ -230,41 +230,39 @@ hPipeRead :: Repo -> [String] -> IO (PipeHandle, String)
 hPipeRead repo params = assertLocal repo $ do
 	pipeFrom "git" (gitCommandLine repo params)
 
-{- Passed a location, recursively scans for all files that
+{- Scans for files that are checked into git at the specified locations. -}
- - are checked into git at that location. -}
+inRepo :: Repo -> [FilePath] -> IO [FilePath]
-inRepo :: Repo -> FilePath -> IO [FilePath]
+inRepo repo l = pipeNullSplit repo $
-inRepo repo l = pipeNullSplit repo
+	["ls-files", "--cached", "--exclude-standard", "-z", "--"] ++ l
-	["ls-files", "--cached", "--exclude-standard", "-z", "--", l]
 
-{- Passed a location, recursively scans for all files that are not checked
+{- Scans for files at the specified locations that are not checked into git,
- - into git, and not gitignored. -}
+ - and not gitignored. -}
-notInRepo :: Repo -> FilePath -> IO [FilePath]
+notInRepo :: Repo -> [FilePath] -> IO [FilePath]
-notInRepo repo l = pipeNullSplit repo
+notInRepo repo l = pipeNullSplit repo $
-	["ls-files", "--others", "--exclude-standard", "-z", "--", l]
+	["ls-files", "--others", "--exclude-standard", "-z", "--"] ++ l
 
-{- Passed a location, returns a list of the files, staged for
+{- Returns a list of the files, staged for commit, that are being added,
- - commit, that are being added, moved, or changed (but not deleted). -}
+ - moved, or changed (but not deleted), from the specified locations. -}
-stagedFiles :: Repo -> FilePath -> IO [FilePath]
+stagedFiles :: Repo -> [FilePath] -> IO [FilePath]
-stagedFiles repo l = pipeNullSplit repo
+stagedFiles repo l = pipeNullSplit repo $
 	["diff", "--cached", "--name-only", "--diff-filter=ACMRT", "-z", 
-		"--", l]
+		"--"] ++ l
 
-{- Passed a location, returns a list of the files, staged for
+{- Returns a list of the files in the specified locations that are staged
- - commit, whose type has changed. -}
+ - for commit, and whose type has changed. -}
-typeChangedStagedFiles :: Repo -> FilePath -> IO [FilePath]
+typeChangedStagedFiles :: Repo -> [FilePath] -> IO [FilePath]
 typeChangedStagedFiles repo l = typeChangedFiles' repo l ["--cached"]
 
-{- Passed a location, returns a list of the files whose type has changed. 
+{- Returns a list of the files in the specified locations whose type has
- - Files only staged for commit will not be included. -}
+ - changed.  Files only staged for commit will not be included. -}
-typeChangedFiles :: Repo -> FilePath -> IO [FilePath]
+typeChangedFiles :: Repo -> [FilePath] -> IO [FilePath]
 typeChangedFiles repo l = typeChangedFiles' repo l []
 
-typeChangedFiles' :: Repo -> FilePath -> [String] -> IO [FilePath]
+typeChangedFiles' :: Repo -> [FilePath] -> [String] -> IO [FilePath]
 typeChangedFiles' repo l middle = pipeNullSplit repo $ start ++ middle ++ end
 	where
 		start = ["diff", "--name-only", "--diff-filter=T", "-z"]
-		end = ["--", l]
+		end = ["--"] ++ l
-	
 
 {- Reads null terminated output of a git command (as enabled by the -z 
  - parameter), and splits it into a list of files. -}

Upgrade.hs

@@ -44,7 +44,7 @@ upgradeFrom0 = do
 	_ <- mapM (\k -> moveAnnex k $ olddir ++ "/" ++ keyFile k) keys
 
 	-- update the symlinks to the files
-	files <- liftIO $ Git.inRepo g $ Git.workTree g
+	files <- liftIO $ Git.inRepo g [Git.workTree g]
 	fixlinks files
 	Annex.queueRun
 

debian/changelog

@@ -2,6 +2,7 @@ git-annex (0.14) UNRELEASED; urgency=low
 
   * Bugfix to git annex unused in a repository with nothing yet annexed.
   * Support upgrading from a v0 annex with nothing in it.
+  * Avoid multiple calls to git ls-files when passed eg, "*".
 
  -- Joey Hess <joeyh@debian.org>  Mon, 20 Dec 2010 14:54:49 -0400