optimize index updating

The last branch ref that the index was updated to is stored in
.git/annex/index.lck, and the index only updated when the current
branch ref differs.

(The .lck file should later be used for locking too.)

Some more optimization is still needed, since there is some redundancy in
calls to git show-ref.

Annex/Branch.hs

@@ -61,9 +61,26 @@ mergeIndex branches = do
 	inRepo $ \g -> Git.UnionMerge.merge_index h g branches
 
 {- Updates the branch's index to reflect the current contents of the branch.
- - Any changes staged in the index will be preserved. -}
+ - Any changes staged in the index will be preserved.
+ -
+ - Compares the ref stored in the lock file with the current
+ - ref of the branch to see if an update is needed.
+ -}
 updateIndex :: Annex ()
-updateIndex = withIndex $ mergeIndex [fullname]
+updateIndex = do
+        lock <- fromRepo gitAnnexIndexLock
+	lockref <- firstRef <$> liftIO (catchDefaultIO (readFileStrict lock) "")
+	branchref <- getRef fullname
+	when (lockref /= branchref) $ do
+		withIndex $ mergeIndex [fullname]
+		setIndexRef branchref
+
+{- Record that the branch's index has been updated to correspond to a
+ - given ref of the branch. -}
+setIndexRef :: Git.Ref -> Annex ()
+setIndexRef ref = do
+        lock <- fromRepo gitAnnexIndexLock
+	liftIO $ writeFile lock $ show ref ++ "\n"
 
 {- Runs an action using the branch's index file. -}
 withIndex :: Annex a -> Annex a
@@ -109,12 +126,13 @@ getCache file = getState >>= go
 
 {- Creates the branch, if it does not already exist. -}
 create :: Annex ()
-create = unlessM hasBranch $ do
-	e <- hasOrigin
-	if e
-		then inRepo $ Git.run "branch"
-			[Param $ show name, Param $ show originname]
-		else withIndex' True $
+create = unlessM hasBranch $ hasOrigin >>= go >>= setIndexRef
+	where
+		go True = do
+			inRepo $ Git.run "branch"
+				[Param $ show name, Param $ show originname]
+			getRef fullname
+		go False = withIndex' True $
 			inRepo $ Git.commit "branch created" fullname []
 
 {- Stages the journal, and commits staged changes to the branch. -}
@@ -122,7 +140,8 @@ commit :: String -> Annex ()
 commit message = whenM journalDirty $ lockJournal $ do
 	updateIndex
 	stageJournalFiles
-	withIndex $ inRepo $ Git.commit message fullname [fullname]
+	withIndex $ 
+		setIndexRef =<< inRepo (Git.commit message fullname [fullname])
 
 {- Ensures that the branch and index are is up-to-date; should be
  - called before data is read from it. Runs only once per git-annex run.
@@ -159,8 +178,9 @@ update = onceonly $ do
 			showSideAction merge_desc
 			mergeIndex branches
 		ff <- if dirty then return False else tryFastForwardTo refs
-		unless ff $ inRepo $
-			Git.commit merge_desc fullname (nub $ fullname:refs)
+		unless ff $ 
+			setIndexRef =<< 
+				inRepo (Git.commit merge_desc fullname (nub $ fullname:refs))
 		invalidateCache
 	where
 		onceonly a = unlessM (branchUpdated <$> getState) $ do
@@ -253,6 +273,18 @@ siblingBranches = do
 		gen l = (Git.Ref $ head l, Git.Ref $ last l)
 		uref (a, _) (b, _) = a == b
 
+{- Get the ref of a branch. -}
+getRef :: Git.Ref -> Annex Git.Ref
+getRef branch = firstRef . L.unpack <$> showref
+	where
+		showref = inRepo $ Git.pipeRead [Param "show-ref",
+			Param "--hash", -- get the hash
+			Param "--verify", -- only exact match
+			Param $ show branch]
+
+firstRef :: String-> Git.Ref
+firstRef = Git.Ref . takeWhile (/= '\n')
+
 {- Applies a function to modifiy the content of a file.
  -
  - Note that this does not cause the branch to be merged, it only

Git.hs

@@ -463,8 +463,8 @@ shaSize :: Int
 shaSize = 40
 
 {- Commits the index into the specified branch (or other ref), 
- - with the specified parent refs. -}
-commit :: String -> Ref -> [Ref] -> Repo -> IO ()
+ - with the specified parent refs, and returns the new ref -}
+commit :: String -> Ref -> [Ref] -> Repo -> IO Ref
 commit message newref parentrefs repo = do
 	tree <- getSha "write-tree" $ asString $
 		pipeRead [Param "write-tree"] repo
@@ -473,6 +473,7 @@ commit message newref parentrefs repo = do
 			(map Param $ ["commit-tree", show tree] ++ ps)
 			(L.pack message) repo
 	run "update-ref" [Param $ show newref, Param $ show sha] repo
+	return sha
 	where
 		ignorehandle a = snd <$> a
 		asString a = L.unpack <$> a

Locations.hs

@@ -21,6 +21,7 @@ module Locations (
 	gitAnnexJournalDir,
 	gitAnnexJournalLock,
 	gitAnnexIndex,
+	gitAnnexIndexLock,
 	isLinkToAnnex,
 	annexHashes,
 	hashDirMixed,
@@ -136,6 +137,10 @@ gitAnnexJournalLock r = gitAnnexDir r </> "journal.lck"
 gitAnnexIndex :: Git.Repo -> FilePath
 gitAnnexIndex r = gitAnnexDir r </> "index"
 
+{- Lock file for .git/annex/index. -}
+gitAnnexIndexLock :: Git.Repo -> FilePath
+gitAnnexIndexLock r = gitAnnexDir r </> "index.lck"
+
 {- Checks a symlink target to see if it appears to point to annexed content. -}
 isLinkToAnnex :: FilePath -> Bool
 isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s

git-union-merge.hs

@@ -42,5 +42,5 @@ main = do
 	_ <- Git.useIndex (tmpIndex g)
 	setup g
 	Git.UnionMerge.merge aref bref g
-	Git.commit "union merge" newref [aref, bref] g
+	_ <- Git.commit "union merge" newref [aref, bref] g
 	cleanup g