diff options
author | Joey Hess <joey@kitenet.net> | 2013-11-19 16:09:44 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-11-19 16:09:44 -0400 |
commit | e011fd72ef69dbbaa4f63bfd61564e0918cb3e22 (patch) | |
tree | a371af17996f35ffa2d4bfa66c09a06124c40539 /test-runner.hs | |
parent | d39035d46df979abcf34d1411f96b5a70bd2d93c (diff) | |
download | git-repair-e011fd72ef69dbbaa4f63bfd61564e0918cb3e22.tar.gz |
initial work on git repository destroyer
I suspect this might sometimes corrupt the **source** repo, so use with
caution!
Diffstat (limited to 'test-runner.hs')
-rw-r--r-- | test-runner.hs | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/test-runner.hs b/test-runner.hs new file mode 100644 index 0000000..6687744 --- /dev/null +++ b/test-runner.hs @@ -0,0 +1,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" |