From 2b0b3ca7e8cd1b659f21757a6036758d24be445e Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 10 Dec 2013 16:17:52 -0400
Subject: merge from git-annex

---
 Git/Repair.hs | 37 ++++++++++++++++++++-----------------
 git-repair.hs |  4 ++--
 2 files changed, 22 insertions(+), 19 deletions(-)

diff --git a/Git/Repair.hs b/Git/Repair.hs
index b8841fc..3ae9c9f 100644
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -13,11 +13,11 @@ module Git.Repair (
 	cleanCorruptObjects,
 	retrieveMissingObjects,
 	resetLocalBranches,
-	removeTrackingBranches,
 	checkIndex,
 	checkIndexFast,
 	missingIndex,
 	emptyGoodCommits,
+	isTrackingBranch,
 ) where
 
 import Common
@@ -189,15 +189,17 @@ resetLocalBranches missing goodcommits r =
 			, Param (show c)
 			] r
 
+isTrackingBranch :: Ref -> Bool
+isTrackingBranch b = "refs/remotes/" `isPrefixOf` show b
+
 {- To deal with missing objects that cannot be recovered, removes
- - any remote tracking branches that reference them. Returns a list of
- - all removed branches.
+ - any branches (filtered by a predicate) that reference them
+ - Returns a list of all removed branches.
  -}
-removeTrackingBranches :: MissingObjects -> GoodCommits -> Repo -> IO ([Branch], GoodCommits)
-removeTrackingBranches missing goodcommits r =
-	go [] goodcommits =<< filter istrackingbranch <$> getAllRefs r
+removeBadBranches :: (Ref -> Bool) -> MissingObjects -> GoodCommits -> Repo -> IO ([Branch], GoodCommits)
+removeBadBranches removablebranch missing goodcommits r =
+	go [] goodcommits =<< filter removablebranch <$> getAllRefs r
   where
-  	istrackingbranch b = "refs/remotes/" `isPrefixOf` show b
 	go removed gcs [] = return (removed, gcs)
 	go removed gcs (b:bs) = do
 		(ok, gcs') <- verifyCommit missing gcs b r
@@ -434,24 +436,24 @@ preRepair g = do
 	validhead s = "ref: refs/" `isPrefixOf` s || isJust (extractSha s)
 
 {- Put it all together. -}
-runRepair :: Bool -> Repo -> IO (Bool, [Branch])
-runRepair forced g = do
+runRepair :: (Ref -> Bool) -> Bool -> Repo -> IO (Bool, [Branch])
+runRepair removablebranch forced g = do
 	preRepair g
 	putStrLn "Running git fsck ..."
 	fsckresult <- findBroken False g
 	if foundBroken fsckresult
-		then runRepair' fsckresult forced Nothing g
+		then runRepair' removablebranch fsckresult forced Nothing g
 		else do
 			putStrLn "No problems found."
 			return (True, [])
 
-runRepairOf :: FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, [Branch])
-runRepairOf fsckresult forced referencerepo g = do
+runRepairOf :: FsckResults -> (Ref -> Bool) -> Bool -> Maybe FilePath -> Repo -> IO (Bool, [Branch])
+runRepairOf fsckresult removablebranch forced referencerepo g = do
 	preRepair g
-	runRepair' fsckresult forced referencerepo g
+	runRepair' removablebranch fsckresult forced referencerepo g
 
-runRepair' :: FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, [Branch])
-runRepair' fsckresult forced referencerepo g = do
+runRepair' :: (Ref -> Bool) -> FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, [Branch])
+runRepair' removablebranch fsckresult forced referencerepo g = do
 	missing <- cleanCorruptObjects fsckresult g
 	stillmissing <- retrieveMissingObjects missing referencerepo g
 	case stillmissing of
@@ -490,7 +492,8 @@ runRepair' fsckresult forced referencerepo g = do
 			| otherwise -> unsuccessfulfinish
   where
 	continuerepairs stillmissing = do
-		(remotebranches, goodcommits) <- removeTrackingBranches stillmissing emptyGoodCommits g
+		(removedbranches, goodcommits) <- removeBadBranches removablebranch stillmissing emptyGoodCommits g
+		let remotebranches = filter isTrackingBranch removedbranches
 		unless (null remotebranches) $
 			putStrLn $ unwords
 				[ "Removed"
@@ -528,7 +531,7 @@ runRepair' fsckresult forced referencerepo g = do
 		-- The corrupted index can prevent fsck from finding other
 		-- problems, so re-run repair.
 		fsckresult' <- findBroken False g
-		result <- runRepairOf fsckresult' forced referencerepo g
+		result <- runRepairOf fsckresult' removablebranch forced referencerepo g
 		putStrLn "Removed the corrupted index file. You should look at what files are present in your working tree and git add them back to the index when appropriate."
 		return result
 
diff --git a/git-repair.hs b/git-repair.hs
index 0aedc27..847ef0c 100644
--- a/git-repair.hs
+++ b/git-repair.hs
@@ -59,7 +59,7 @@ main = execParser opts >>= go
 repair :: Settings -> IO ()
 repair settings = do
 	g <- Git.Config.read =<< Git.CurrentRepo.get
-	ifM (Git.Repair.successfulRepair <$> Git.Repair.runRepair (forced settings) g)
+	ifM (Git.Repair.successfulRepair <$> Git.Repair.runRepair Git.Repair.isTrackingBranch (forced settings) g)
 		( exitSuccess
 		, exitFailure
 		)
@@ -94,7 +94,7 @@ runTest settings damage = withTmpDir "tmprepo" $ \tmpdir -> do
 	g <- Git.Config.read =<< Git.Construct.fromPath cloneloc
 	Git.Destroyer.applyDamage damage g
 	repairstatus <- catchMaybeIO $ Git.Repair.successfulRepair
-		<$> Git.Repair.runRepair (forced settings) g
+		<$> Git.Repair.runRepair Git.Repair.isTrackingBranch (forced settings) g
 	case repairstatus of
 		Just True -> testResult repairstatus 
 			. Just . not . Git.Fsck.foundBroken
-- 
cgit v1.2.3