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.

Command/Uninit.hs

@@ -32,7 +32,7 @@ check = do
 		error "can only run uninit from the top of the git repository"
 	where
 		current_branch = Git.Ref . Prelude.head . lines <$> revhead
-		revhead = inRepo $ Git.Command.pipeRead 
+		revhead = inRepo $ Git.Command.pipeReadStrict
 			[Params "rev-parse --abbrev-ref HEAD"]
 
 seek :: [CommandSeek]

Command/Unused.hs

@@ -251,7 +251,7 @@ withKeysReferencedInGit a = do
 	rs <- relevantrefs <$> showref
 	forM_ rs (withKeysReferencedInGitRef a)
 	where
-		showref = inRepo $ Git.Command.pipeRead [Param "show-ref"]
+		showref = inRepo $ Git.Command.pipeReadStrict [Param "show-ref"]
 		relevantrefs = map (Git.Ref .  snd) .
 			nubBy uniqref .
 			filter ourbranches .

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

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"
 

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)

Utility/Process.hs

@@ -116,8 +116,10 @@ checkSuccessProcess pid = do
 	code <- waitForProcess pid
 	return $ code == ExitSuccess
 
-ignoreFailureProcess :: ProcessHandle -> IO ()
-ignoreFailureProcess = void . waitForProcess
+ignoreFailureProcess :: ProcessHandle -> IO Bool
+ignoreFailureProcess pid = do
+	void $ waitForProcess pid
+	return True
 
 {- Runs createProcess, then an action on its handles, and then
  - forceSuccessProcess. -}