77 lines
1.7 KiB
Haskell
77 lines
1.7 KiB
Haskell
{- 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
|
|
|
|
instance Show Config where
|
|
show (Config key value) = unlines $ [
|
|
key ++ " :: Bool"
|
|
, key ++ " = " ++ show value
|
|
]
|
|
|
|
tests :: [TestDesc]
|
|
tests = [
|
|
TestDesc "cp -a" "cp_a" $ testCp "-a"
|
|
, TestDesc "cp -p" "cp_p" $ testCp "-p"
|
|
, TestDesc "cp --reflink=auto" "cp_reflink_auto" $ testCp "--reflink=auto"
|
|
]
|
|
|
|
tmpDir :: String
|
|
tmpDir = "tmp"
|
|
|
|
testFile :: String
|
|
testFile = tmpDir ++ "/testfile"
|
|
|
|
quiet :: String -> String
|
|
quiet s = s ++ " 2>/dev/null"
|
|
|
|
testCp :: String -> Test
|
|
testCp option = testCmd $ quiet $ "cp " ++ option ++ " " ++ 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 ++ map show config ++ footer
|
|
where
|
|
header = [
|
|
"{- Automatically generated by configure. -}"
|
|
, "module SysConfig where"
|
|
, ""
|
|
]
|
|
footer = []
|
|
|
|
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
|