broke out Git/HashObject.hs

Annex/Branch.hs

@@ -17,7 +17,6 @@ module Annex.Branch (
 	files,
 ) where
 
-import System.Exit
 import qualified Data.ByteString.Lazy.Char8 as L
 
 import Common.Annex
@@ -25,9 +24,10 @@ import Annex.Exception
 import Annex.BranchState
 import Annex.Journal
 import qualified Git
-import qualified Git.UnionMerge
 import qualified Git.Ref
 import qualified Git.Branch
+import qualified Git.UnionMerge
+import qualified Git.HashObject
 import Annex.CatFile
 
 {- Name of the branch that is used to store git-annex's information. -}
@@ -291,23 +291,10 @@ stageJournal = do
 	withIndex $ liftIO $ do
 		let dir = gitAnnexJournalDir g
 		let paths = map (dir </>) fs
-		-- inject all the journal files directly into git
+		shas <- Git.HashObject.hashFiles paths g
-		-- in one quick command
-		(pid, fromh, toh) <- hPipeBoth "git" $ toCommand $ git_hash_object g
-		_ <- forkProcess $ do
-			hPutStr toh $ unlines paths
-			hClose toh
-			exitSuccess
-		hClose toh
-		shas <- map Git.Ref . lines <$> hGetContents fromh
-		-- update the index, also in just one command
 		Git.UnionMerge.update_index g $
 			index_lines shas (map fileJournal fs)
-		hClose fromh
-		forceSuccess pid
 		mapM_ removeFile paths
 	where
 		index_lines shas = map genline . zip shas
 		genline (sha, file) = Git.UnionMerge.update_index_line sha file
-		git_hash_object = Git.gitCommandLine
-			[Param "hash-object", Param "-w", Param "--stdin-paths"]

Git/HashObject.hs

@@ -0,0 +1,29 @@
+{- git hash-object interface
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.HashObject where
+
+import Common
+import Git
+
+{- Injects a set of files into git, returning the shas of the objects. -}
+hashFiles :: [FilePath] -> Repo -> IO [Sha]
+hashFiles paths repo = do
+	(pid, fromh, toh) <- hPipeBoth "git" $ toCommand $ git_hash_object repo
+	_ <- forkProcess (feeder toh)
+	hClose toh
+	shas <- map Git.Ref . lines <$> hGetContents fromh
+	hClose fromh
+	forceSuccess pid
+	return shas
+	where
+		git_hash_object = Git.gitCommandLine
+			[Param "hash-object", Param "-w", Param "--stdin-paths"]
+		feeder toh = do
+			hPutStr toh $ unlines paths
+			hClose toh
+			exitSuccess