summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess <joey@kitenet.net>2013-11-30 14:15:39 -0400
committerJoey Hess <joey@kitenet.net>2013-11-30 14:15:39 -0400
commitfb9fa44ea545c4ede11c778153f1a3d4bbd573b5 (patch)
treeff89b9559ef229d65753a20b8f129ef2c2e8da09
parenta0cc01f89964f6670ff60e5ddf0a08d72d1094b7 (diff)
downloadgit-repair-fb9fa44ea545c4ede11c778153f1a3d4bbd573b5.tar.gz
better data type
-rw-r--r--Git/Fsck.hs19
-rw-r--r--Git/Repair.hs42
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