make a pipeReadStrict, that properly waits on the process

Nearly everything that's reading from git is operating on a small
amount of output and has been switched to use that. Only pipeNullSplit
stuff continues using the lazy version that yields zombies.

3 files changed, 30 insertions, 14 deletions

diff --git a/Git/Branch.hs b/Git/Branch.hs
index f73ae5e2a..3407845d1 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -27,7 +27,7 @@ current r = do
 	case v of
 		Nothing -> return Nothing
 		Just branch -> 
-			ifM (null <$> pipeRead [Param "show-ref", Param $ show branch] r)
+			ifM (null <$> pipeReadStrict [Param "show-ref", Param $ show branch] r)
 				( return Nothing
 				, return v
 				)
@@ -35,7 +35,7 @@ current r = do
 {- The current branch, which may not really exist yet. -}
 currentUnsafe :: Repo -> IO (Maybe Git.Ref)
 currentUnsafe r = parse . firstLine
-	<$> pipeRead [Param "symbolic-ref", Param "HEAD"] r
+	<$> pipeReadStrict [Param "symbolic-ref", Param "HEAD"] r
 	where
 		parse l
 			| null l = Nothing
@@ -48,7 +48,7 @@ changed origbranch newbranch repo
 	| origbranch == newbranch = return False
 	| otherwise = not . null <$> diffs
 	where
-		diffs = pipeRead
+		diffs = pipeReadStrict
 			[ Param "log"
 			, Param (show origbranch ++ ".." ++ show newbranch)
 			, Params "--oneline -n1"
@@ -93,7 +93,7 @@ fastForward branch (first:rest) repo =
 commit :: String -> Branch -> [Ref] -> Repo -> IO Sha
 commit message branch parentrefs repo = do
 	tree <- getSha "write-tree" $
-		pipeRead [Param "write-tree"] repo
+		pipeReadStrict [Param "write-tree"] repo
 	sha <- getSha "commit-tree" $ pipeWriteRead
 		(map Param $ ["commit-tree", show tree] ++ ps)
 		message repo
diff --git a/Git/Command.hs b/Git/Command.hs
index 687f6802c..71579808b 100644
--- a/Git/Command.hs
+++ b/Git/Command.hs
@@ -43,14 +43,27 @@ run subcommand params repo = assertLocal repo $
  - Note that this leaves the git process running, and so zombies will
  - result unless reap is called.
  -}
-pipeRead :: [CommandParam] -> Repo -> IO String
-pipeRead params repo = assertLocal repo $
+pipeReadLazy :: [CommandParam] -> Repo -> IO String
+pipeReadLazy params repo = assertLocal repo $
 	withHandle StdoutHandle createBackgroundProcess p $ \h -> do
 		fileEncoding h
 		hGetContents h
 	where
-		p  = (proc "git" $ toCommand $ gitCommandLine params repo)
-			{ env = gitEnv repo }
+		p  = gitCreateProcess params repo
+
+{- Runs a git subcommand, and returns its output, strictly.
+ -
+ - Nonzero exit status is ignored.
+ -}
+pipeReadStrict :: [CommandParam] -> Repo -> IO String
+pipeReadStrict params repo = assertLocal repo $
+	withHandle StdoutHandle (createProcessChecked ignoreFailureProcess) p $ \h -> do
+		fileEncoding h
+		output <- hGetContentsStrict h
+		hClose h
+		return output
+	where
+		p  = gitCreateProcess params repo
 
 {- Runs a git subcommand, feeding it input, and returning its output,
  - which is expected to be fairly small, since it's all read into memory
@@ -62,16 +75,19 @@ pipeWriteRead params s repo = assertLocal repo $
 
 {- Runs a git subcommand, feeding it input on a handle with an action. -}
 pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()
-pipeWrite params repo = withHandle StdinHandle createProcessSuccess p
-	where
-		p = (proc "git" $ toCommand $ gitCommandLine params repo)
+pipeWrite params repo = withHandle StdinHandle createProcessSuccess $
+	gitCreateProcess params repo
+
+gitCreateProcess :: [CommandParam] -> Repo -> CreateProcess
+gitCreateProcess params repo =
+	(proc "git" $ toCommand $ gitCommandLine params repo)
 			{ env = gitEnv repo }
 
 {- Reads null terminated output of a git command (as enabled by the -z 
  - parameter), and splits it. -}
 pipeNullSplit :: [CommandParam] -> Repo -> IO [String]
 pipeNullSplit params repo =
-	filter (not . null) . split sep <$> pipeRead params repo
+	filter (not . null) . split sep <$> pipeReadLazy params repo
 	where
 		sep = "\0"
 
diff --git a/Git/Ref.hs b/Git/Ref.hs
index cfaafacef..6fec46c22 100644
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -41,7 +41,7 @@ exists ref = runBool "show-ref"
 sha :: Branch -> Repo -> IO (Maybe Sha)
 sha branch repo = process <$> showref repo
 	where
-		showref = pipeRead [Param "show-ref",
+		showref = pipeReadStrict [Param "show-ref",
 			Param "--hash", -- get the hash
 			Param $ show branch]
 		process [] = Nothing
@@ -50,7 +50,7 @@ sha branch repo = process <$> showref repo
 {- List of (refs, branches) matching a given ref spec. -}
 matching :: Ref -> Repo -> IO [(Ref, Branch)]
 matching ref repo = map gen . lines <$> 
-	pipeRead [Param "show-ref", Param $ show ref] repo
+	pipeReadStrict [Param "show-ref", Param $ show ref] repo
 	where
 		gen l = let (r, b) = separate (== ' ') l in
 			(Ref r, Ref b)