summaryrefslogtreecommitdiff
path: root/Git/RecoverRepository.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Git/RecoverRepository.hs')
-rw-r--r--Git/RecoverRepository.hs29
1 files changed, 29 insertions, 0 deletions
diff --git a/Git/RecoverRepository.hs b/Git/RecoverRepository.hs
index 8dce04f1e..c2cad53f2 100644
--- a/Git/RecoverRepository.hs
+++ b/Git/RecoverRepository.hs
@@ -10,6 +10,7 @@ module Git.RecoverRepository (
retrieveMissingObjects,
resetLocalBranches,
removeTrackingBranches,
+ rewriteIndex,
emptyGoodCommits,
) where
@@ -19,17 +20,21 @@ import Git.Command
import Git.Fsck
import Git.Objects
import Git.Sha
+import Git.Types
import qualified Git.Config
import qualified Git.Construct
import qualified Git.LsTree as LsTree
+import qualified Git.LsFiles as LsFiles
import qualified Git.Ref as Ref
import qualified Git.RefLog as RefLog
+import qualified Git.UpdateIndex as UpdateIndex
import Utility.Tmp
import Utility.Rsync
import qualified Data.Set as S
import qualified Data.ByteString.Lazy as L
import System.Log.Logger
+import Data.Tuple.Utils
{- Finds and removes corrupt objects from the repository, returning a list
- of all such objects, which need to be found elsewhere to finish
@@ -349,6 +354,30 @@ verifyTree missing treesha r
-- as long as ls-tree succeeded, we're good
else cleanup
+{- Rewrites the index file, removing from it any files whose blobs are
+ - missing. Returns the list of affected files. -}
+rewriteIndex :: MissingObjects -> Repo -> IO [FilePath]
+rewriteIndex missing r
+ | repoIsLocalBare r = return []
+ | otherwise = do
+ (indexcontents, cleanup) <- LsFiles.stagedDetails [Git.repoPath r] r
+ let (missing, present) = partition ismissing indexcontents
+ unless (null missing) $ do
+ nukeFile (localGitDir r </> "index")
+ UpdateIndex.streamUpdateIndex r
+ =<< (catMaybes <$> mapM reinject present)
+ void cleanup
+ return $ map fst3 missing
+ where
+ getblob (_file, Just sha, Just _mode) = Just sha
+ getblob _ = Nothing
+ ismissing = maybe False (`S.member` missing) . getblob
+ reinject (file, Just sha, Just mode) = case toBlobType mode of
+ Nothing -> return Nothing
+ Just blobtype -> Just <$>
+ UpdateIndex.stageFile sha blobtype file r
+ reinject _ = return Nothing
+
newtype GoodCommits = GoodCommits (S.Set Sha)
emptyGoodCommits :: GoodCommits