refactor

TestConfig.hs

@@ -72,26 +72,28 @@ testCmd k cmdline = do
 
 {- Ensures that one of a set of commands is available by running each in
  - turn. The Config is set to the first one found. -}
-selectCmd :: Bool -> ConfigKey -> [String] -> String -> Test
+selectCmd :: ConfigKey -> [String] -> String -> Test
-selectCmd required k cmds param = search cmds
+selectCmd k = searchCmd
+		(\match -> return $ Config k $ StringConfig match)
+		(\cmds -> do
+			testEnd $ Config k $ BoolConfig False
+			error $ "* need one of these commands, but none are available: " ++ show cmds
+		)
+
+maybeSelectCmd :: ConfigKey -> [String] -> String -> Test
+maybeSelectCmd k = searchCmd
+		(\match -> return $ Config k $ MaybeStringConfig $ Just match)
+		(\_ -> return $ Config k $ MaybeStringConfig Nothing)
+
+searchCmd :: (String -> Test) -> ([String] -> Test) -> [String] -> String -> Test
+searchCmd success failure cmds param = search cmds
 	where
-		search [] = failure
+		search [] = failure cmds
 		search (c:cs) = do
 			ret <- system $ quiet c ++ " " ++ param
 			if (ret == ExitSuccess)
 				then success c
 				else search cs
-		success c
-			| required == True = return $ Config k (StringConfig c)
-			| otherwise = return $ Config k (MaybeStringConfig $ Just c)
-		failure
-			| required == True = do
-				testEnd $ Config k (BoolConfig False)
-				error $ "* need one of these commands, but none are available: " ++ show cmds
-			| otherwise = do
-				let r = Config k (MaybeStringConfig Nothing)
-				testEnd r
-				return r			
 
 quiet :: String -> String
 quiet s = s ++ " >/dev/null 2>&1"

configure.hs

@@ -6,12 +6,12 @@ import Data.List
 import TestConfig
 
 tests :: [TestCase]
-tests = [
+tests =
-	  TestCase "version" $ getVersion
+	[ TestCase "version" $ getVersion
 	, testCp "cp_a" "-a"
 	, testCp "cp_p" "-p"
 	, testCp "cp_reflink_auto" "--reflink=auto"
-	, TestCase "uuid generator" $ selectCmd True "uuid" ["uuid", "uuidgen"] ""
+	, 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"
 	, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null"
@@ -24,7 +24,7 @@ shaTestCases l = map make l
 		let
 			cmds = map (\x -> "sha" ++ show n ++ x) ["", "sum"]
 			key = "sha" ++ show n
-		in TestCase key $ selectCmd False key cmds "</dev/null"
+		in TestCase key $ maybeSelectCmd key cmds "</dev/null"
 
 tmpDir :: String
 tmpDir = "tmp"