From fb9fa44ea545c4ede11c778153f1a3d4bbd573b5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 30 Nov 2013 14:15:39 -0400 Subject: better data type --- Git/Fsck.hs | 19 +++++++++++-------- Git/Repair.hs | 42 +++++++++++++++++++----------------------- 2 files changed, 30 insertions(+), 31 deletions(-) diff --git a/Git/Fsck.hs b/Git/Fsck.hs index 8bfddb4..8555aa0 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -6,11 +6,12 @@ -} module Git.Fsck ( - FsckResults, + FsckResults(..), MissingObjects, findBroken, foundBroken, findMissing, + knownMissing, ) where import Common @@ -23,9 +24,7 @@ import qualified Data.Set as S type MissingObjects = S.Set Sha -{- If fsck succeeded, Just a set of missing objects it found. - - If it failed, Nothing. -} -type FsckResults = Maybe MissingObjects +data FsckResults = FsckFoundMissing MissingObjects | FsckFailed {- Runs fsck to find some of the broken objects in the repository. - May not find all broken objects, if fsck fails on bad data in some of @@ -42,8 +41,8 @@ findBroken batchmode r = do let objs = findShas output badobjs <- findMissing objs r if S.null badobjs && not fsckok - then return Nothing - else return $ Just badobjs + then return FsckFailed + else return $ FsckFoundMissing badobjs where (command, params) = ("git", fsckParams r) (command', params') @@ -51,8 +50,12 @@ findBroken batchmode r = do | otherwise = (command, params) foundBroken :: FsckResults -> Bool -foundBroken Nothing = True -foundBroken (Just s) = not (S.null s) +foundBroken FsckFailed = True +foundBroken (FsckFoundMissing s) = not (S.null s) + +knownMissing :: FsckResults -> MissingObjects +knownMissing FsckFailed = S.empty +knownMissing (FsckFoundMissing s) = s {- Finds objects that are missing from the git repsitory, or are corrupt. - diff --git a/Git/Repair.hs b/Git/Repair.hs index f1e6818..1495d23 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -42,17 +42,16 @@ import qualified Data.ByteString.Lazy as L import Data.Tuple.Utils {- Given a set of bad objects found by git fsck, which may not - - be complete, finds and removes all corrupt objects, and - - returns a list of missing objects, which need to be - - found elsewhere to finish recovery. + - be complete, finds and removes all corrupt objects, + - and returns missing objects. -} -cleanCorruptObjects :: FsckResults -> Repo -> IO (Maybe MissingObjects) +cleanCorruptObjects :: FsckResults -> Repo -> IO FsckResults cleanCorruptObjects fsckresults r = do void $ explodePacks r objs <- listLooseObjectShas r mapM_ (tryIO . allowRead . looseObjectFile r) objs bad <- findMissing objs r - void $ removeLoose r $ S.union bad (fromMaybe S.empty fsckresults) + void $ removeLoose r $ S.union bad (knownMissing fsckresults) -- Rather than returning the loose objects that were removed, re-run -- fsck. Other missing objects may have been in the packs, -- and this way fsck will find them. @@ -98,20 +97,17 @@ explodePacks r = do - If another clone of the repository exists locally, which might not be a - remote of the repo being repaired, its path can be passed as a reference - repository. - - - Can also be run with Nothing, if it's not known which objects are - - missing, just that some are. (Ie, fsck failed badly.) -} -retrieveMissingObjects :: Maybe MissingObjects -> Maybe FilePath -> Repo -> IO (Maybe MissingObjects) +retrieveMissingObjects :: FsckResults -> Maybe FilePath -> Repo -> IO FsckResults retrieveMissingObjects missing referencerepo r - | missing == Just S.empty = return $ Just S.empty + | not (foundBroken missing) = return missing | otherwise = withTmpDir "tmprepo" $ \tmpdir -> do unlessM (boolSystem "git" [Params "init", File tmpdir]) $ error $ "failed to create temp repository in " ++ tmpdir tmpr <- Config.read =<< Construct.fromAbsPath tmpdir stillmissing <- pullremotes tmpr (remotes r) fetchrefstags missing - if stillmissing == Just S.empty - then return $ Just S.empty + if S.null (knownMissing stillmissing) + then return stillmissing else pullremotes tmpr (remotes r) fetchallrefs stillmissing where pullremotes tmpr [] fetchrefs stillmissing = case referencerepo of @@ -121,12 +117,12 @@ retrieveMissingObjects missing referencerepo r void $ explodePacks tmpr void $ copyObjects tmpr r case stillmissing of - Nothing -> return $ Just S.empty - Just s -> Just <$> findMissing (S.toList s) r + FsckFailed -> return $ FsckFailed + FsckFoundMissing s -> FsckFoundMissing <$> findMissing (S.toList s) r , return stillmissing ) pullremotes tmpr (rmt:rmts) fetchrefs ms - | ms == Just S.empty = return $ Just S.empty + | not (foundBroken ms) = return ms | otherwise = do putStrLn $ "Trying to recover missing objects from remote " ++ repoDescribe rmt ++ "." ifM (fetchfrom (repoLocation rmt) fetchrefs tmpr) @@ -134,10 +130,10 @@ retrieveMissingObjects missing referencerepo r void $ explodePacks tmpr void $ copyObjects tmpr r case ms of - Nothing -> pullremotes tmpr rmts fetchrefs ms - Just s -> do + FsckFailed -> pullremotes tmpr rmts fetchrefs ms + FsckFoundMissing s -> do stillmissing <- findMissing (S.toList s) r - pullremotes tmpr rmts fetchrefs (Just stillmissing) + pullremotes tmpr rmts fetchrefs (FsckFoundMissing stillmissing) , pullremotes tmpr rmts fetchrefs ms ) fetchfrom fetchurl ps = runBool $ @@ -452,7 +448,7 @@ runRepair' fsckresult forced referencerepo g = do missing <- cleanCorruptObjects fsckresult g stillmissing <- retrieveMissingObjects missing referencerepo g case stillmissing of - Just s + FsckFoundMissing s | S.null s -> if repoIsLocalBare g then successfulfinish S.empty [] else ifM (checkIndex S.empty g) @@ -474,13 +470,13 @@ runRepair' fsckresult forced referencerepo g = do , "missing objects could not be recovered!" ] unsuccessfulfinish s - Nothing + FsckFailed | forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex S.empty g) ( do - missing' <- cleanCorruptObjects Nothing g + missing' <- cleanCorruptObjects FsckFailed g case missing' of - Nothing -> return (False, S.empty, []) - Just stillmissing' -> continuerepairs stillmissing' + FsckFailed -> return (False, S.empty, []) + FsckFoundMissing stillmissing' -> continuerepairs stillmissing' , corruptedindex ) | otherwise -> unsuccessfulfinish S.empty -- cgit v1.2.3