Sped up git-annex merge by using git hash-object --batch.

This does mean that it has to write out temp files containing updated
objects for the merge. So may use more disk space, and disk IO, but that
should generally win out over needing to launch N separate
git hash-object processes.

3 files changed, 24 insertions, 18 deletions

diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index a46a90ee9..d6735be88 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -50,6 +50,7 @@ import Git.Types
 import Git.FilePath
 import Annex.CatFile
 import Annex.Perms
+import Annex.HashObject (hashObjectHandle)
 import Logs
 import Logs.Transitions
 import Logs.Trust.Pure
@@ -342,8 +343,9 @@ genIndex g = Git.UpdateIndex.streamUpdateIndex g
 mergeIndex :: JournalLocked -> [Git.Ref] -> Annex ()
 mergeIndex jl branches = do
 	prepareModifyIndex jl
-	h <- catFileHandle
-	inRepo $ \g -> Git.UnionMerge.mergeIndex h g branches
+	hashhandle <- hashObjectHandle
+	ch <- catFileHandle
+	inRepo $ \g -> Git.UnionMerge.mergeIndex hashhandle ch g branches
 
 {- Removes any stale git lock file, to avoid git falling over when
  - updating the index.
diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs
index bb42e7cc5..9ae8295ae 100644
--- a/Git/UnionMerge.hs
+++ b/Git/UnionMerge.hs
@@ -30,12 +30,14 @@ import Git.FilePath
  -}
 merge :: Ref -> Ref -> Repo -> IO ()
 merge x y repo = do
-	h <- catFileStart repo
+	hashhandle <- hashObjectStart repo
+	ch <- catFileStart repo
 	streamUpdateIndex repo
 		[ lsTree x repo
-		, mergeTrees x y h repo
+		, mergeTrees x y hashhandle ch repo
 		]
-	catFileStop h
+	catFileStop ch
+	hashObjectStop hashhandle
 
 {- Merges a list of branches into the index. Previously staged changes in
  - the index are preserved (and participate in the merge).
@@ -45,17 +47,18 @@ merge x y repo = do
  - harder to calculate a single union merge involving all the refs, as well
  - as the index.
  -}
-mergeIndex :: CatFileHandle -> Repo -> [Ref] -> IO ()
-mergeIndex h repo bs = forM_ bs $ \b ->
-	streamUpdateIndex repo [mergeTreeIndex b h repo]
+mergeIndex :: HashObjectHandle -> CatFileHandle -> Repo -> [Ref] -> IO ()
+mergeIndex hashhandle ch repo bs = forM_ bs $ \b ->
+	streamUpdateIndex repo [mergeTreeIndex b hashhandle ch repo]
 
 {- For merging two trees. -}
-mergeTrees :: Ref -> Ref -> CatFileHandle -> Repo -> Streamer
-mergeTrees (Ref x) (Ref y) h = doMerge h $ "diff-tree":diffOpts ++ [x, y, "--"]
+mergeTrees :: Ref -> Ref -> HashObjectHandle -> CatFileHandle -> Repo -> Streamer
+mergeTrees (Ref x) (Ref y) hashhandle ch = doMerge hashhandle ch
+	("diff-tree":diffOpts ++ [x, y, "--"])
 
 {- For merging a single tree into the index. -}
-mergeTreeIndex :: Ref -> CatFileHandle -> Repo -> Streamer
-mergeTreeIndex (Ref r) h = doMerge h $
+mergeTreeIndex :: Ref -> HashObjectHandle -> CatFileHandle -> Repo -> Streamer
+mergeTreeIndex (Ref r) hashhandle ch = doMerge hashhandle ch $
 	"diff-index" : diffOpts ++ ["--cached", r, "--"]
 
 diffOpts :: [String]
@@ -63,26 +66,26 @@ diffOpts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
 
 {- Streams update-index changes to perform a merge,
  - using git to get a raw diff. -}
-doMerge :: CatFileHandle -> [String] -> Repo -> Streamer
-doMerge ch differ repo streamer = do
+doMerge :: HashObjectHandle -> CatFileHandle -> [String] -> Repo -> Streamer
+doMerge hashhandle ch differ repo streamer = do
 	(diff, cleanup) <- pipeNullSplit (map Param differ) repo
 	go diff
 	void $ cleanup
   where
 	go [] = noop
-	go (info:file:rest) = mergeFile info file ch repo >>=
+	go (info:file:rest) = mergeFile info file hashhandle ch >>=
 		maybe (go rest) (\l -> streamer l >> go rest)
 	go (_:[]) = error $ "parse error " ++ show differ
 
 {- Given an info line from a git raw diff, and the filename, generates
  - a line suitable for update-index that union merges the two sides of the
  - diff. -}
-mergeFile :: String -> FilePath -> CatFileHandle -> Repo -> IO (Maybe String)
-mergeFile info file h repo = case filter (/= nullSha) [Ref asha, Ref bsha] of
+mergeFile :: String -> FilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe String)
+mergeFile info file hashhandle h = case filter (/= nullSha) [Ref asha, Ref bsha] of
 	[] -> return Nothing
 	(sha:[]) -> use sha
 	shas -> use
-		=<< either return (\s -> hashObject BlobObject (unlines s) repo)
+		=<< either return (\s -> hashBlob hashhandle (unlines s))
 		=<< calcMerge . zip shas <$> mapM getcontents shas
   where
 	[_colonmode, _bmode, asha, bsha, _status] = words info
diff --git a/debian/changelog b/debian/changelog
index d5b98c192..80d07cb77 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -15,6 +15,7 @@ git-annex (6.20160230) UNRELEASED; urgency=medium
   * Correct git-annex info to include unlocked files in v6 repository.
   * Sped up git-annex add in direct mode and v6 by using
     git hash-object --batch.
+  * Sped up git-annex merge by using git hash-object --batch.
 
  -- Joey Hess <id@joeyh.name>  Mon, 29 Feb 2016 13:00:30 -0400