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
parent
eaa80be917
commit
468fecc315
3 changed files with 119 additions and 109 deletions
107
Build/Configure.hs
Normal file
107
Build/Configure.hs
Normal 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
|
||||
15
Setup.hs
15
Setup.hs
|
|
@ -3,15 +3,10 @@
|
|||
import Distribution.Simple
|
||||
import System.Cmd
|
||||
|
||||
main = defaultMainWithHooks simpleUserHooks {
|
||||
preConf = makeSources,
|
||||
postClean = makeClean
|
||||
}
|
||||
import qualified Build.Configure as Configure
|
||||
|
||||
makeSources _ _ = do
|
||||
system "make sources"
|
||||
main = defaultMainWithHooks simpleUserHooks { preConf = configure }
|
||||
|
||||
configure _ _ = do
|
||||
Configure.run Configure.tests
|
||||
return (Nothing, [])
|
||||
|
||||
makeClean _ _ _ _ = do
|
||||
system "make clean"
|
||||
return ()
|
||||
|
|
|
|||
106
configure.hs
106
configure.hs
|
|
@ -1,113 +1,21 @@
|
|||
{- Checks system configuration and generates SysConfig.hs. -}
|
||||
{- configure program -}
|
||||
|
||||
import System.Directory
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import System.Cmd.Utils
|
||||
import Control.Applicative
|
||||
|
||||
import qualified Build.Configure as Configure
|
||||
import Build.TestConfig
|
||||
import Utility.StatFS
|
||||
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
|
||||
, 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"]
|
||||
tests = [ TestCase "StatFS" testStatFS
|
||||
] ++ Configure.tests
|
||||
|
||||
{- This test cannot be included in Build.Configure due to needing
|
||||
- Utility/StatFS.hs to be built. -}
|
||||
testStatFS :: Test
|
||||
testStatFS = do
|
||||
s <- getFileSystemStats "."
|
||||
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 = do
|
||||
setup
|
||||
config <- runTests tests
|
||||
writeSysConfig config
|
||||
cleanup
|
||||
cabalSetup
|
||||
main = Configure.run tests
|
||||
|
|
|
|||
Loading…
Reference in a new issue