Setup.hs: import configure

Rather than running make, which runs configure, let Setup.hs just include
the configure code. The standalone configure is retained for use by the
Makefile.

This may work better with cabal-dev, since it avoids the Makefile running
ghc, and lets cabal handle all the compiler running, with whatever
flags it uses to expose dependencies.
This commit is contained in:
Joey Hess 2012-03-10 14:00:26 -04:00
parent eaa80be917
commit 468fecc315
3 changed files with 119 additions and 109 deletions

107
Build/Configure.hs Normal file
View file

@ -0,0 +1,107 @@
{- Checks system configuration and generates SysConfig.hs. -}
module Build.Configure where
import System.Directory
import Data.List
import System.Cmd.Utils
import Control.Applicative
import Build.TestConfig
import Utility.SafeCommand
tests :: [TestCase]
tests =
[ TestCase "version" getVersion
, TestCase "git" $ requireCmd "git" "git --version >/dev/null"
, TestCase "git version" getGitVersion
, 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"
, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null"
, TestCase "wget" $ testCmd "wget" "wget --version >/dev/null"
, TestCase "bup" $ testCmd "bup" "bup --version >/dev/null"
, TestCase "gpg" $ testCmd "gpg" "gpg --version >/dev/null"
, TestCase "ssh connection caching" getSshConnectionCaching
] ++ shaTestCases [1, 256, 512, 224, 384]
shaTestCases :: [Int] -> [TestCase]
shaTestCases l = map make l
where make n =
let
cmds = map (\x -> "sha" ++ show n ++ x) ["", "sum"]
key = "sha" ++ show n
in TestCase key $ maybeSelectCmd key cmds "</dev/null"
tmpDir :: String
tmpDir = "tmp"
testFile :: String
testFile = tmpDir ++ "/testfile"
testCp :: ConfigKey -> String -> TestCase
testCp k option = TestCase cmd $ testCmd k cmdline
where
cmd = "cp " ++ option
cmdline = cmd ++ " " ++ testFile ++ " " ++ testFile ++ ".new"
{- Pulls package version out of the changelog. -}
getVersion :: Test
getVersion = do
version <- getVersionString
return $ Config "packageversion" (StringConfig version)
getVersionString :: IO String
getVersionString = do
changelog <- readFile "CHANGELOG"
let verline = head $ lines changelog
return $ middle (words verline !! 1)
where
middle = drop 1 . init
getGitVersion :: Test
getGitVersion = do
(_, s) <- pipeFrom "git" ["--version"]
let version = last $ words $ head $ lines s
return $ Config "gitversion" (StringConfig version)
getSshConnectionCaching :: Test
getSshConnectionCaching = Config "sshconnectioncaching" . BoolConfig <$>
boolSystem "sh" [Param "-c", Param "ssh -o ControlPersist=yes -V >/dev/null 2>/dev/null"]
{- Set up cabal file with version. -}
cabalSetup :: IO ()
cabalSetup = do
version <- getVersionString
cabal <- readFile cabalfile
writeFile tmpcabalfile $ unlines $
map (setfield "Version" version) $
lines cabal
renameFile tmpcabalfile cabalfile
where
cabalfile = "git-annex.cabal"
tmpcabalfile = cabalfile++".tmp"
setfield field value s
| fullfield `isPrefixOf` s = fullfield ++ value
| otherwise = s
where
fullfield = field ++ ": "
setup :: IO ()
setup = do
createDirectoryIfMissing True tmpDir
writeFile testFile "test file contents"
cleanup :: IO ()
cleanup = removeDirectoryRecursive tmpDir
run :: [TestCase] -> IO ()
run ts = do
setup
config <- runTests ts
writeSysConfig config
cleanup
cabalSetup

View file

@ -3,15 +3,10 @@
import Distribution.Simple import Distribution.Simple
import System.Cmd import System.Cmd
main = defaultMainWithHooks simpleUserHooks { import qualified Build.Configure as Configure
preConf = makeSources,
postClean = makeClean
}
makeSources _ _ = do main = defaultMainWithHooks simpleUserHooks { preConf = configure }
system "make sources"
configure _ _ = do
Configure.run Configure.tests
return (Nothing, []) return (Nothing, [])
makeClean _ _ _ _ = do
system "make clean"
return ()

View file

@ -1,113 +1,21 @@
{- Checks system configuration and generates SysConfig.hs. -} {- configure program -}
import System.Directory
import Data.List
import Data.Maybe import Data.Maybe
import System.Cmd.Utils
import Control.Applicative
import qualified Build.Configure as Configure
import Build.TestConfig import Build.TestConfig
import Utility.StatFS import Utility.StatFS
import Utility.SafeCommand
tests :: [TestCase] tests :: [TestCase]
tests = tests = [ TestCase "StatFS" testStatFS
[ TestCase "version" getVersion ] ++ Configure.tests
, TestCase "git" $ requireCmd "git" "git --version >/dev/null"
, TestCase "git version" getGitVersion
, 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"
, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null"
, TestCase "wget" $ testCmd "wget" "wget --version >/dev/null"
, TestCase "bup" $ testCmd "bup" "bup --version >/dev/null"
, TestCase "gpg" $ testCmd "gpg" "gpg --version >/dev/null"
, TestCase "ssh connection caching" getSshConnectionCaching
, TestCase "StatFS" testStatFS
] ++ shaTestCases [1, 256, 512, 224, 384]
shaTestCases :: [Int] -> [TestCase]
shaTestCases l = map make l
where make n =
let
cmds = map (\x -> "sha" ++ show n ++ x) ["", "sum"]
key = "sha" ++ show n
in TestCase key $ maybeSelectCmd key cmds "</dev/null"
tmpDir :: String
tmpDir = "tmp"
testFile :: String
testFile = tmpDir ++ "/testfile"
testCp :: ConfigKey -> String -> TestCase
testCp k option = TestCase cmd $ testCmd k run
where
cmd = "cp " ++ option
run = cmd ++ " " ++ testFile ++ " " ++ testFile ++ ".new"
{- Pulls package version out of the changelog. -}
getVersion :: Test
getVersion = do
version <- getVersionString
return $ Config "packageversion" (StringConfig version)
getVersionString :: IO String
getVersionString = do
changelog <- readFile "CHANGELOG"
let verline = head $ lines changelog
return $ middle (words verline !! 1)
where
middle = drop 1 . init
getGitVersion :: Test
getGitVersion = do
(_, s) <- pipeFrom "git" ["--version"]
let version = last $ words $ head $ lines s
return $ Config "gitversion" (StringConfig version)
getSshConnectionCaching :: Test
getSshConnectionCaching = Config "sshconnectioncaching" . BoolConfig <$>
boolSystem "sh" [Param "-c", Param "ssh -o ControlPersist=yes -V >/dev/null 2>/dev/null"]
{- This test cannot be included in Build.Configure due to needing
- Utility/StatFS.hs to be built. -}
testStatFS :: Test testStatFS :: Test
testStatFS = do testStatFS = do
s <- getFileSystemStats "." s <- getFileSystemStats "."
return $ Config "statfs_sane" $ BoolConfig $ isJust s return $ Config "statfs_sane" $ BoolConfig $ isJust s
{- Set up cabal file with version. -}
cabalSetup :: IO ()
cabalSetup = do
version <- getVersionString
cabal <- readFile cabalfile
writeFile tmpcabalfile $ unlines $
map (setfield "Version" version) $
lines cabal
renameFile tmpcabalfile cabalfile
where
cabalfile = "git-annex.cabal"
tmpcabalfile = cabalfile++".tmp"
setfield field value s
| fullfield `isPrefixOf` s = fullfield ++ value
| otherwise = s
where
fullfield = field ++ ": "
setup :: IO ()
setup = do
createDirectoryIfMissing True tmpDir
writeFile testFile "test file contents"
cleanup :: IO ()
cleanup = removeDirectoryRecursive tmpDir
main :: IO () main :: IO ()
main = do main = Configure.run tests
setup
config <- runTests tests
writeSysConfig config
cleanup
cabalSetup