Improve memory usage when git fsck finds a great many broken objects.

From 1.7 gb to 900 mb on 300 thousand unique reported shas.

When shas are not unique, this streams much better than before, so won't
buffer the full list before putting them into the Set and throwing away
dups. And when fsck output includes ignorable lines, especially
dangling object lines, they won't be buffered in memory at all.

1 files changed, 17 insertions, 3 deletions

diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index e90683bc0..b3948cb1d 100644
--- a/Git/Fsck.hs
+++ b/Git/Fsck.hs
@@ -23,6 +23,7 @@ import Utility.Batch
 import qualified Git.Version
 
 import qualified Data.Set as S
+import System.Process (std_out, std_err)
 
 type MissingObjects = S.Set Sha
 
@@ -46,9 +47,17 @@ findBroken batchmode r = do
 	(command', params') <- if batchmode
 		then toBatchCommand (command, params)
 		else return (command, params)
-	(output, fsckok) <- processTranscript command' (toCommand params') Nothing
-	let objs = findShas supportsNoDangling output
-	badobjs <- findMissing objs r
+	
+	p@(_, _, _, pid) <- createProcess $
+		(proc command' (toCommand params'))
+			{ std_out = CreatePipe
+			, std_err = CreatePipe
+			}
+	bad1 <- readMissingObjs r supportsNoDangling (stdoutHandle p)
+	bad2 <- readMissingObjs r supportsNoDangling (stderrHandle p)
+	fsckok <- checkSuccessProcess pid
+	let badobjs = S.union bad1 bad2
+
 	if S.null badobjs && not fsckok
 		then return FsckFailed
 		else return $ FsckFoundMissing badobjs
@@ -69,6 +78,11 @@ knownMissing (FsckFoundMissing s) = s
 findMissing :: [Sha] -> Repo -> IO MissingObjects
 findMissing objs r = S.fromList <$> filterM (`isMissing` r) objs
 
+readMissingObjs :: Repo -> Bool -> Handle -> IO MissingObjects
+readMissingObjs r supportsNoDangling h = do
+	objs <- findShas supportsNoDangling <$> hGetContents h
+	findMissing objs r
+
 isMissing :: Sha -> Repo -> IO Bool
 isMissing s r = either (const True) (const False) <$> tryIO dump
   where