summaryrefslogtreecommitdiff
path: root/Git/Fsck.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Git/Fsck.hs')
-rw-r--r--Git/Fsck.hs28
1 files changed, 15 insertions, 13 deletions
diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index 8bfddb4..8d5b75b 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
@@ -38,21 +37,24 @@ type FsckResults = Maybe MissingObjects
-}
findBroken :: Bool -> Repo -> IO FsckResults
findBroken batchmode r = do
+ let (command, params) = ("git", fsckParams r)
+ (command', params') <- if batchmode
+ then toBatchCommand (command, params)
+ else return (command, params)
(output, fsckok) <- processTranscript command' (toCommand params') Nothing
let objs = findShas output
badobjs <- findMissing objs r
if S.null badobjs && not fsckok
- then return Nothing
- else return $ Just badobjs
- where
- (command, params) = ("git", fsckParams r)
- (command', params')
- | batchmode = toBatchCommand (command, params)
- | otherwise = (command, params)
+ then return FsckFailed
+ else return $ FsckFoundMissing badobjs
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.
-