{- Checks system configuration and generates SysConfig.hs.
 -}

import System.IO
import System.Cmd
import System.Exit
import System.Directory

type Test = IO Bool
data TestDesc = TestDesc String String Test
data Config = Config String Bool

tests :: [TestDesc]
tests = [
	  TestDesc "cp -a" "cp_a" cp_a
	, TestDesc "cp --reflink" "cp_reflink" cp_reflink
	]

tmpDir :: String
tmpDir = "tmp"

testFile :: String
testFile = tmpDir ++ "/testfile"

quiet :: String -> String
quiet s = s ++ " 2>/dev/null"

cp_a :: Test
cp_a = testCmd $ quiet $ "cp -a " ++ testFile ++ " " ++ testFile ++ ".new"

cp_reflink :: Test
cp_reflink = testCmd $ quiet $ "cp --reflink=auto " ++ testFile ++ " " ++ testFile ++ ".new"

testCmd :: String -> Test
testCmd c = do
	ret <- system c
	return $ ret == ExitSuccess

testStart :: String -> IO ()
testStart s = do
	putStr $ "  checking " ++ s ++ "..."
	hFlush stdout

testEnd :: Bool -> IO ()
testEnd r = putStrLn $ " " ++ (show r)

writeSysConfig :: [Config] -> IO ()
writeSysConfig config = do
	writeFile "SysConfig.hs" $ unlines $ header ++ vars config ++ footer
	where
		header = [
			  "{- Automatically generated by configure. -}"
			, "module SysConfig where"
			]
		footer = []
		vars [] = []
		vars (c:cs) = showvar c ++ vars cs
		showvar (Config name val) = [
			  name ++ " :: Bool"
			, name ++ " = " ++ show val
			]

runTests :: [TestDesc] -> IO [Config]
runTests [] = return []
runTests ((TestDesc tname key t):ts) = do
	testStart tname
	val <- t
	testEnd val
	rest <- runTests ts
	return $ (Config key val):rest

main :: IO ()
main = do
	createDirectoryIfMissing True tmpDir
	writeFile testFile "test file contents"
	config <- runTests tests
	removeDirectoryRecursive tmpDir
	writeSysConfig config