From e011fd72ef69dbbaa4f63bfd61564e0918cb3e22 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 19 Nov 2013 16:09:44 -0400
Subject: initial work on git repository destroyer

I suspect this might sometimes corrupt the **source** repo, so use with
caution!
---
 test-runner.hs | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 66 insertions(+)
 create mode 100644 test-runner.hs

(limited to 'test-runner.hs')

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"
-- 
cgit v1.2.3