diff options
| -rw-r--r-- | Git/Repair.hs | 37 | ||||
| -rw-r--r-- | 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 |