aboutsummaryrefslogtreecommitdiff
path: root/Git/Fsck.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-01-21 13:22:48 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-01-21 13:22:48 -0400
commitcb22669ecd8e7bd4cb3cc41934ba8f5ddf24dd2b (patch)
tree7d1dcfe8e2204dd7d3ee67adc434b73829e00289 /Git/Fsck.hs
parent5a522daa314c5ec147e2075862825ffcc824abc4 (diff)
repair: Check git version at run time.
Diffstat (limited to 'Git/Fsck.hs')
-rw-r--r--Git/Fsck.hs19
1 files changed, 9 insertions, 10 deletions
diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index a49978d44..23d3a3558 100644
--- a/Git/Fsck.hs
+++ b/Git/Fsck.hs
@@ -20,7 +20,7 @@ import Git
import Git.Command
import Git.Sha
import Utility.Batch
-import qualified Git.BuildVersion
+import qualified Git.Version
import qualified Data.Set as S
@@ -40,12 +40,14 @@ data FsckResults = FsckFoundMissing MissingObjects | FsckFailed
-}
findBroken :: Bool -> Repo -> IO FsckResults
findBroken batchmode r = do
- let (command, params) = ("git", fsckParams r)
+ supportsNoDangling <- (>= Git.Version.normalize "1.7.10")
+ <$> Git.Version.installed
+ let (command, params) = ("git", fsckParams supportsNoDangling r)
(command', params') <- if batchmode
then toBatchCommand (command, params)
else return (command, params)
(output, fsckok) <- processTranscript command' (toCommand params') Nothing
- let objs = findShas output
+ let objs = findShas supportsNoDangling output
badobjs <- findMissing objs r
if S.null badobjs && not fsckok
then return FsckFailed
@@ -75,21 +77,18 @@ isMissing s r = either (const True) (const False) <$> tryIO dump
, Param (show s)
] r
-findShas :: String -> [Sha]
-findShas = catMaybes . map extractSha . concat . map words . filter wanted . lines
+findShas :: Bool -> String -> [Sha]
+findShas supportsNoDangling = catMaybes . map extractSha . concat . map words . filter wanted . lines
where
wanted l
| supportsNoDangling = True
| otherwise = not ("dangling " `isPrefixOf` l)
-fsckParams :: Repo -> [CommandParam]
-fsckParams = gitCommandLine $ map Param $ catMaybes
+fsckParams :: Bool -> Repo -> [CommandParam]
+fsckParams supportsNoDangling = gitCommandLine $ map Param $ catMaybes
[ Just "fsck"
, if supportsNoDangling
then Just "--no-dangling"
else Nothing
, Just "--no-reflogs"
]
-
-supportsNoDangling :: Bool
-supportsNoDangling = not $ Git.BuildVersion.older "1.7.10"