refactor

1 files changed, 11 insertions, 89 deletions

diff --git a/configure.hs b/configure.hs
index 9f50328d3..8d1c117a7 100644
--- a/configure.hs
+++ b/configure.hs
@@ -1,37 +1,17 @@
 {- Checks system configuration and generates SysConfig.hs. -}
 
-import System.IO
-import System.Cmd
-import System.Exit
 import System.Directory
 
-type ConfigKey = String
-data ConfigValue = BoolConfig Bool | StringConfig String
-data Config = Config ConfigKey ConfigValue
-
-type Test = IO Config
-type TestName = String
-data TestCase = TestCase TestName Test
-
-instance Show Config where
-        show (Config key value) = unlines [
-			  key ++ " :: " ++ valuetype value
-			, key ++ " = " ++ showvalue value
-		]
-		where
-			valuetype (BoolConfig _) = "Bool"
-			valuetype (StringConfig _) = "String"
-			showvalue (BoolConfig b) = show b
-			showvalue (StringConfig s) = show s
+import TestConfig
 
 tests :: [TestCase]
 tests = [
-	  TestCase "cp -a" $ testCp "cp_a" "-a"
-	, TestCase "cp -p" $ testCp "cp_p" "-p"
-	, TestCase "cp --reflink=auto" $ testCp "cp_reflink_auto" "--reflink=auto"
-	, TestCase "uuid" $ selectCmd "uuid" ["uuid", "uuidgen"]
-	, TestCase "xargs -0" $ requireCmd "xargs_0" "xargs -0" "xargs -0 </dev/null"
-	, TestCase "rsync" $ requireCmd "rsync" "rsync" "rsync --version >/dev/null"
+	  testCp "cp_a" "-a"
+	, testCp "cp_p" "-p"
+	, testCp "cp_reflink_auto" "--reflink=auto"
+	, TestCase "uuid generator" $ selectCmd "uuid" ["uuid", "uuidgen"]
+	, TestCase "xargs -0" $ requireCmd "xargs_0" "xargs -0 </dev/null"
+	, TestCase "rsync" $ requireCmd "rsync" "rsync --version >/dev/null"
 	]
 
 tmpDir :: String
@@ -40,69 +20,11 @@ tmpDir = "tmp"
 testFile :: String
 testFile = tmpDir ++ "/testfile"
 
-requireCmd :: ConfigKey -> String -> String -> Test
-requireCmd k c cmdline = do
-	ret <- testCmd k cmdline
-	handle ret
-	where
-		handle r@(Config _ (BoolConfig True)) = return r
-		handle r = do
-			testEnd r
-			error $ "** the " ++ c ++ " command is required to use git-annex"
-
-testCp :: ConfigKey -> String -> Test
-testCp k option = testCmd k $
-	"cp " ++ option ++ " " ++ testFile ++ " " ++ testFile ++ ".new"
-
-testCmd :: ConfigKey -> String -> Test
-testCmd k c = do
-	ret <- system $ quiet c
-	return $ Config k (BoolConfig $ ret == ExitSuccess)
-
-selectCmd :: ConfigKey -> [String] -> Test
-selectCmd k cmds = search cmds
+testCp :: ConfigKey -> String -> TestCase
+testCp k option = TestCase cmd $ testCmd k run
 	where
-		search [] = do
-			testEnd $ Config k (BoolConfig False)
-			error $ "* need one of these commands, but none are available: " ++ show cmds
-		search (c:cs) = do
-			ret <- system $ quiet c
-			if (ret == ExitSuccess)
-				then return $ Config k (StringConfig c)
-				else search cs
-
-quiet :: String -> String
-quiet s = s ++ " >/dev/null 2>&1"
-
-testStart :: TestName -> IO ()
-testStart s = do
-	putStr $ "  checking " ++ s ++ "..."
-	hFlush stdout
-
-testEnd :: Config -> IO ()
-testEnd (Config _ (BoolConfig True)) = putStrLn $ " yes"
-testEnd (Config _ (BoolConfig False)) = putStrLn $ " no"
-testEnd (Config _ (StringConfig s)) = putStrLn $ " " ++ s
-
-writeSysConfig :: [Config] -> IO ()
-writeSysConfig config = writeFile "SysConfig.hs" body
-	where
-		body = unlines $ header ++ map show config ++ footer
-		header = [
-			  "{- Automatically generated by configure. -}"
-			, "module SysConfig where"
-			, ""
-			]
-		footer = []
-
-runTests :: [TestCase] -> IO [Config]
-runTests [] = return []
-runTests ((TestCase tname t):ts) = do
-	testStart tname
-	c <- t
-	testEnd c
-	rest <- runTests ts
-	return $ c:rest
+		cmd = "cp " ++ option
+		run = cmd ++ " " ++ testFile ++ " " ++ testFile ++ ".new"
 
 setup :: IO ()
 setup = do