From b9186e3c2097cf8c94403b38c9dbe6ed382d82b0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 22 Oct 2013 14:39:45 -0400 Subject: make git fsck batch-capable --- Git/Fsck.hs | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) (limited to 'Git/Fsck.hs') diff --git a/Git/Fsck.hs b/Git/Fsck.hs index 5fdc73385..3872c6b04 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -16,6 +16,7 @@ import Git import Git.Command import Git.Sha import Git.CatFile +import Utility.Batch import qualified Data.Set as S @@ -31,17 +32,25 @@ type MissingObjects = S.Set Sha - to be a git sha. Not all such shas are of broken objects, so ask git - to try to cat the object, and see if it fails. -} -findBroken :: Repo -> IO (Maybe MissingObjects) -findBroken r = do - (output, fsckok) <- processTranscript "git" (toCommand $ fsckParams r) Nothing +findBroken :: Bool -> Repo -> IO (Maybe MissingObjects) +findBroken batchmode r = do + (output, fsckok) <- processTranscript command' (toCommand params') Nothing let objs = parseFsckOutput output badobjs <- findMissing objs r if S.null badobjs && not fsckok then return Nothing else return $ Just badobjs + where + (command, params) = ("git", fsckParams r) + (command', params') + | batchmode = toBatchCommand (command, params) + | otherwise = (command, params) {- Finds objects that are missing from the git repsitory, or are corrupt. - - Note that catting a corrupt object will cause cat-file to crash. -} + - + - Note that catting a corrupt object will cause cat-file to crash; + - this is detected and it's restarted. + -} findMissing :: [Sha] -> Repo -> IO MissingObjects findMissing objs r = go objs [] =<< start where -- cgit v1.2.3