precommit: Optimise to avoid calling git-check-attr more than once.

Command.hs

@@ -41,8 +41,9 @@ type SubCmdCleanup = Annex Bool
  - functions. -}
 type SubCmdSeekStrings = SubCmdStartString -> SubCmdSeek
 type SubCmdStartString = String -> SubCmdStart
+type BackendFile = (FilePath, Maybe Backend)
 type SubCmdSeekBackendFiles = SubCmdStartBackendFile -> SubCmdSeek
-type SubCmdStartBackendFile = (FilePath, Maybe Backend) -> SubCmdStart
+type SubCmdStartBackendFile = BackendFile -> SubCmdStart
 type SubCmdSeekNothing = SubCmdStart -> SubCmdSeek
 type SubCmdStartNothing = SubCmdStart
 
@@ -116,17 +117,6 @@ withFilesNotInGit a params = do
 	repo <- Annex.gitRepo
 	newfiles <- liftIO $ mapM (Git.notInRepo repo) params
 	backendPairs a $ filter notState $ foldl (++) [] newfiles
-withFilesUnlocked :: SubCmdSeekBackendFiles
-withFilesUnlocked a params = do
-	-- unlocked files have changed type from a symlink to a regular file
-	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
-	return $ map a pairs
 withString :: SubCmdSeekStrings
 withString a params = return [a $ unwords params]
 withStrings :: SubCmdSeekStrings
@@ -136,12 +126,17 @@ withFilesToBeCommitted a params = do
 	repo <- Annex.gitRepo
 	tocommit <- liftIO $ mapM (Git.stagedFiles repo) params
 	return $ map a $ filter notState $ foldl (++) [] tocommit
-withUnlockedFilesToBeCommitted :: SubCmdSeekStrings
+withFilesUnlocked :: SubCmdSeekBackendFiles
-withUnlockedFilesToBeCommitted a params = do
+withFilesUnlocked = withFilesUnlocked' Git.typeChangedFiles
+withFilesUnlockedToBeCommitted :: SubCmdSeekBackendFiles
+withFilesUnlockedToBeCommitted = withFilesUnlocked' Git.typeChangedStagedFiles
+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 (Git.typeChangedStagedFiles repo) params
+	typechangedfiles <- liftIO $ mapM (typechanged repo) params
 	unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles
-	return $ map a $ filter notState unlockedfiles
+	backendPairs a $ filter notState unlockedfiles
 withKeys :: SubCmdSeekStrings
 withKeys a params = return $ map a params
 withTempFile :: SubCmdSeekStrings
@@ -150,6 +145,11 @@ withNothing :: SubCmdSeekNothing
 withNothing a [] = return [a]
 withNothing _ _ = return []
 
+backendPairs :: SubCmdSeekBackendFiles
+backendPairs a files = do
+	pairs <- Backend.chooseBackends files
+	return $ map a pairs
+
 {- Default to acting on all files matching the seek action if
  - none are specified. -}
 withAll :: SubCmdSeekStrings -> SubCmdSeekStrings

Command/Add.hs

@@ -34,7 +34,7 @@ start pair@(file, _) = notAnnexed file $ do
 			showStart "add" file
 			return $ Just $ perform pair
 
-perform :: (FilePath, Maybe Backend) -> SubCmdPerform
+perform :: BackendFile -> SubCmdPerform
 perform (file, backend) = do
 	stored <- Backend.storeFileKey file backend
 	case stored of

Command/PreCommit.hs

@@ -11,7 +11,6 @@ import Control.Monad.State (liftIO)
 
 import Command
 import qualified Annex
-import qualified Backend
 import qualified GitRepo as Git
 import qualified Command.Add
 import qualified Command.Fix
@@ -20,15 +19,14 @@ import qualified Command.Fix
  - And, it needs to inject unlocked files into the annex. -}
 seek :: [SubCmdSeek]
 seek = [withFilesToBeCommitted Command.Fix.start,
-	withUnlockedFilesToBeCommitted start]
+	withFilesUnlockedToBeCommitted start]
 
-start :: SubCmdStartString
+start :: SubCmdStartBackendFile
-start file = return $ Just $ perform file
+start pair = return $ Just $ perform pair
 
-perform :: FilePath -> SubCmdPerform
+perform :: BackendFile -> SubCmdPerform
-perform file = do
+perform pair@(file, _) = do
-	pairs <- Backend.chooseBackends [file]
+	ok <- doSubCmd $ Command.Add.start pair
-	ok <- doSubCmd $ Command.Add.start $ head pairs
 	if ok
 		then return $ Just $ cleanup file
 		else error $ "failed to add " ++ file ++ "; canceling commit"

Command/Unlock.hs

@@ -15,7 +15,6 @@ import qualified Annex
 import Types
 import Messages
 import Locations
-import Utility
 import Core
 import CopyFile
 

debian/changelog

@@ -1,3 +1,9 @@
+git-annex (0.10) UNRELEASED; urgency=low
+
+  * precommit: Optimise to avoid calling git-check-attr more than once.
+
+ -- Joey Hess <joeyh@debian.org>  Sun, 28 Nov 2010 14:19:15 -0400
+
 git-annex (0.09) unstable; urgency=low
 
   * Add copy subcommand.