blob: 668774459cf2811f36ad91cf015b8b2ca1dfa767 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
{- Test runner
-
- Passed a git repository, makes a temporary clone of the git repository,
- corrupts part of it, then tries to repair it, and logs the result.
-}
module Main where
import Options.Applicative
import Common
import qualified Git.Construct
import qualified Git.Config
import qualified Git.Destroyer
import qualified Git.Repair
import Utility.Tmp
data Settings = Settings
{ originalGitRepo :: FilePath
, forced :: Bool
}
parseSettings :: Parser Settings
parseSettings = Settings
<$> argument str (metavar "REPO")
<*> switch forceopt
where
forceopt = long "force"
<> help "Force repair"
main :: IO ()
main = execParser opts >>= runTest
where
opts = info (helper <*> parseSettings) desc
desc = fullDesc
<> header "test-runner - test command in corrupted git repository"
runTest :: Settings -> IO ()
runTest settings = withTmpDir "tmprepo" $ \tmpdir -> do
let cloneloc = tmpdir </> "clone"
cloned <- boolSystem "git"
[ Param "clone"
, File (originalGitRepo settings)
, File cloneloc
]
unless cloned $
error $ "failed to clone " ++ originalGitRepo settings
-- Note that we read the config before destroying the repo.
-- Recovering from repos with a corrupted config is not currently
-- a goal.
g <- Git.Config.read =<< Git.Construct.fromPath cloneloc
damage <- Git.Destroyer.generateDamage
Git.Destroyer.applyDamage damage g
result <- catchMaybeIO $ Git.Repair.successfulRepair
<$> Git.Repair.runRepair (forced settings) g
logTest damage result
case result of
Just True -> exitSuccess
_ -> exitFailure
data TestLog = TestLog [Git.Destroyer.Damage] (Maybe Bool)
deriving (Read, Show)
logTest :: [Git.Destroyer.Damage] -> Maybe Bool -> IO ()
logTest damage result =
appendFile "test-runner.log" $ show (TestLog damage result) ++ "\n"
|
