Branch module complete

Refactored some code that it needs into GitRepo.

1 files changed, 21 insertions, 39 deletions

diff --git a/GitUnionMerge.hs b/GitUnionMerge.hs
index 8aa04f53a..ba9ea79e4 100644
--- a/GitUnionMerge.hs
+++ b/GitUnionMerge.hs
@@ -9,10 +9,7 @@ module GitUnionMerge (
 	unionMerge
 ) where
 
-import System.FilePath
-import System.Directory
 import System.Cmd.Utils
-import Control.Monad (when)
 import Data.List
 import Data.Maybe
 import Data.String.Utils
@@ -21,18 +18,24 @@ import qualified GitRepo as Git
 import Utility
 
 {- Performs a union merge. Should be run with a temporary index file
- - configured by Git.withIndex. -}
-unionMerge :: Git.Repo -> String -> String -> String -> IO ()
-unionMerge g aref bref newref = do
-	stage g aref bref
+ - configured by Git.useIndex.
+ -
+ - Use indexpopulated only if the index file already contains exactly the
+ - contents of aref.
+ -}
+unionMerge :: Git.Repo -> String -> String -> String -> Bool -> IO ()
+unionMerge g aref bref newref indexpopulated = do
+	stage g aref bref indexpopulated
 	commit g aref bref newref
 
 {- Stages the content of both refs into the index. -}
-stage :: Git.Repo -> String -> String -> IO ()
-stage g aref bref = do
-	-- Get the contents of aref, as a starting point.
-	ls <- fromgit
-		["ls-tree", "-z", "-r", "--full-tree", aref]
+stage :: Git.Repo -> String -> String -> Bool -> IO ()
+stage g aref bref indexpopulated = do
+	-- Get the contents of aref, as a starting point, unless
+	-- the index is already populated with it.
+	ls <- if indexpopulated
+		then return []
+		else fromgit ["ls-tree", "-z", "-r", "--full-tree", aref]
 	-- Identify files that are different between aref and bref, and
 	-- inject merged versions into git.
 	diff <- fromgit
@@ -45,18 +48,12 @@ stage g aref bref = do
 		fromgit l = Git.pipeNullSplit g (map Param l)
 		togit l content = Git.pipeWrite g (map Param l) content
 			>>= forceSuccess
-		tofromgit l content = do
-			(h, s) <- Git.pipeWriteRead g (map Param l) content
-			length s `seq` do
-				forceSuccess h
-				Git.reap
-				return ((), s)
 
 		pairs [] = []
 		pairs (_:[]) = error "parse error"
 		pairs (a:b:rest) = (a,b):pairs rest
 		
-		nullsha = take shaSize $ repeat '0'
+		nullsha = take Git.shaSize $ repeat '0'
 		ls_tree_line sha file = "100644 blob " ++ sha ++ "\t" ++ file
 		unionmerge = unlines . nub . lines
 		
@@ -68,32 +65,17 @@ stage g aref bref = do
 		mergefile' file asha bsha = do
 			let shas = filter (/= nullsha) [asha, bsha]
 			content <- Git.pipeRead g $ map Param ("show":shas)
-			sha <- getSha "hash-object" $
-				tofromgit ["hash-object", "-w", "--stdin"] $
-					unionmerge content
+			sha <- Git.hashObject g $ unionmerge content
 			return $ Just $ ls_tree_line sha file
 
 {- Commits the index into the specified branch, as a merge commit. -}
 commit :: Git.Repo -> String -> String -> String -> IO ()
 commit g aref bref newref = do
-	tree <- getSha "write-tree"  $
+	tree <- Git.getSha "write-tree" $ ignorehandle $
 		pipeFrom "git" ["write-tree"]
-	sha <- getSha "commit-tree" $
+	sha <- Git.getSha "commit-tree" $ ignorehandle $ 
 		pipeBoth "git" ["commit-tree", tree, "-p", aref, "-p", bref]
 			"union merge"
 	Git.run g "update-ref" [Param newref, Param sha]
-
-{- Runs an action that causes a git subcommand to emit a sha, and strips
-   any trailing newline, returning the sha. -}
-getSha :: String -> IO (a, String) -> IO String
-getSha subcommand a = do
-	(_, t) <- a
-	let t' = if last t == '\n'
-		then take (length t - 1) t
-		else t
-	when (length t' /= shaSize) $
-		error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")"
-	return t'
-
-shaSize :: Int
-shaSize = 40
+	where
+		ignorehandle a = return . snd =<< a