got rid of several more calls to git when finding unlocked files

CmdLine.hs

@@ -10,6 +10,7 @@ module CmdLine (parseCmd) where
 import System.Console.GetOpt
 import Control.Monad.State (liftIO)
 import System.Directory
+import System.Posix.Files
 import Control.Monad (filterM, when)
 
 import qualified GitRepo as Git
@@ -17,7 +18,6 @@ import qualified Annex
 import Locations
 import qualified Backend
 import Types
-import Core
 
 import Command
 import qualified Command.Add
@@ -138,8 +138,11 @@ withFilesNotInGit a params = do
 	backendPairs a $ foldl (++) [] newfiles
 withFilesUnlocked :: SubCmdSeekBackendFiles
 withFilesUnlocked a params = do
-	unlocked <- mapM unlockedFiles params
+	-- unlocked files have changed type from a symlink to a regular file
-	backendPairs a $ foldl (++) [] unlocked
+	repo <- Annex.gitRepo
+	typechangedfiles <- liftIO $ mapM (Git.typeChangedFiles repo) params
+	unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles
+	backendPairs a $ filter notState unlockedfiles
 backendPairs :: SubCmdSeekBackendFiles
 backendPairs a files = do
 	pairs <- Backend.chooseBackends files
@@ -154,10 +157,9 @@ withFilesToBeCommitted a params = do
 withUnlockedFilesToBeCommitted :: SubCmdSeekStrings
 withUnlockedFilesToBeCommitted a params = do
 	repo <- Annex.gitRepo
-	unlocked <- mapM unlockedFiles params
+	typechangedfiles <- liftIO $ mapM (Git.typeChangedStagedFiles repo) params
-	tocommit <- liftIO $ mapM (Git.stagedFiles repo) $
+	unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles
-		filter notState $ foldl (++) [] unlocked
+	return $ map a $ filter notState unlockedfiles
-	return $ map a $ foldl (++) [] tocommit
 withKeys :: SubCmdSeekStrings
 withKeys a params = return $ map a params
 withTempFile :: SubCmdSeekStrings
@@ -169,6 +171,12 @@ withNothing a _ = return [a]
 notState :: FilePath -> Bool
 notState f = stateLoc /= take (length stateLoc) f
 	
+{- filter out symlinks -}	
+notSymlink :: FilePath -> IO Bool
+notSymlink f = do
+	s <- liftIO $ getSymbolicLinkStatus f
+	return $ not $ isSymbolicLink s
+
 {- Parses command line and returns two lists of actions to be 
  - run in the Annex monad. The first actions configure it
  - according to command line options, while the second actions

Core.hs

@@ -224,20 +224,6 @@ getKeysReferenced = do
 	keypairs <- mapM Backend.lookupFile files
 	return $ map fst $ catMaybes keypairs
 
-{- Passed a location (a directory or a single file, returns
- - files there that are unlocked for editing. -}
-unlockedFiles :: FilePath -> Annex [FilePath]
-unlockedFiles l = do
-	-- unlocked files have changed type from a symlink to a regular file
-	g <- Annex.gitRepo
-	typechangedfiles <- liftIO $ Git.typeChangedFiles g l
-	unlockedfiles <- filterM notsymlink typechangedfiles
-	return unlockedfiles
-	where
-		notsymlink f = do
-			s <- liftIO $ getSymbolicLinkStatus f
-			return $ not $ isSymbolicLink s
-
 {- Uses the annex.version git config setting to automate upgrades. -}
 autoUpgrade :: Annex ()
 autoUpgrade = do

GitRepo.hs

@@ -40,6 +40,7 @@ module GitRepo (
 	decodeGitFile,
 	encodeGitFile,
 	typeChangedFiles,
+	typeChangedStagedFiles,
 
 	prop_idempotent_deencode
 ) where
@@ -59,7 +60,6 @@ import Data.Char
 import Data.Word (Word8)
 import Codec.Binary.UTF8.String (encode)
 import Text.Printf
-import Data.List
 
 import Utility
 
@@ -244,17 +244,23 @@ stagedFiles repo l = pipeNullSplit repo
 	["diff", "--cached", "--name-only", "--diff-filter=ACMRT", "-z", 
 		"--", l]
 
-{- Passed a location, returns a list of the files whose type has changed. -}
+{- Passed a location, returns a list of the files, staged for
+ - commit, whose type has changed. -}
+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. 
+ - Files only staged for commit will not be included. -}
 typeChangedFiles :: Repo -> FilePath -> IO [FilePath]
-typeChangedFiles repo l = do
+typeChangedFiles repo l = typeChangedFiles' repo l []
-	changed <- pipeNullSplit repo $ start ++ end
+
-	changedCached <- pipeNullSplit repo $ start ++ ["--cached"] ++ end
+typeChangedFiles' :: Repo -> FilePath -> [String] -> IO [FilePath]
-	-- a file can be found twice by the above, so nub
+typeChangedFiles' repo l middle = pipeNullSplit repo $ start ++ middle ++ end
-	return $ nub $ changed ++ changedCached
 	where
 		start = ["diff", "--name-only", "--diff-filter=T", "-z"]
 		end = ["--", l]
 	
+
 {- Reads null terminated output of a git command (as enabled by the -z 
  - parameter), and splits it into a list of files. -}
 pipeNullSplit :: Repo -> [String] -> IO [FilePath]