No more cabal-dev usage

This commit is contained in:
Michael Snoyman 2012-11-29 15:32:11 +02:00
parent fd62aee254
commit a0d0948dea
6 changed files with 79 additions and 25 deletions

View File

@ -21,3 +21,10 @@ general, the following set of commands should be good for getting started:
git submodule update --init # get the Haskell Platform files
runghc app/stackage.hs build # takes a *long* time
runghc app/stackage.hs init # modifies your ~/.cabal/config file
Notes
-----
Make sure to have Cabal-1.16 installed in either your global or user database,
regardless of any sandboxing, as custom build types require it to be present.
You must build with cabal-install 1.16, due to several important bug fixes.

View File

@ -2,6 +2,7 @@ module Stackage.Build
( build
) where
import Distribution.Text (simpleParse)
import Control.Monad (unless)
import Stackage.CheckPlan
import Stackage.InstallInfo
@ -10,28 +11,63 @@ import Stackage.Test
import Stackage.Util
import System.Exit (ExitCode (ExitSuccess), exitWith)
import System.IO (IOMode (WriteMode), withBinaryFile)
import System.Process (runProcess, waitForProcess)
import System.Process (runProcess, waitForProcess, rawSystem, readProcess)
import System.Directory (createDirectoryIfMissing, canonicalizePath)
import Distribution.Version (thisVersion, withinRange)
import Control.Exception (assert)
build :: IO ()
build = do
build :: FilePath
-> ([String] -> [String]) -- ^ extra build rgs
-> IO ()
build root' extraBuildArgs = do
putStrLn "Creating a build plan"
ii <- getInstallInfo
putStrLn "Wiping out old cabal-dev folder"
rm_r "cabal-dev"
putStrLn "Wiping out old sandbox folder"
rm_r root'
rm_r "logs"
createDirectoryIfMissing True root'
root <- canonicalizePath root'
checkPlan ii
ec1 <- rawSystem "ghc-pkg" ["init", packageDir root]
unless (ec1 == ExitSuccess) $ do
putStrLn "Unable to create package database via ghc-pkg init"
exitWith ec1
let extraArgs = ("-fnetwork23":)
checkPlan (addCabalArgs root . extraArgs) ii
putStrLn "No mismatches, starting the sandboxed build."
versionString <- readProcess "cabal" ["--version"] ""
libVersion <-
case map words $ lines versionString of
[_,["using","version",libVersion,"of","the","Cabal","library"]] -> return libVersion
_ -> error "Did not understand cabal --version output"
case (simpleParse libVersion, simpleParse ">= 1.16") of
(Nothing, _) -> error $ "Invalid Cabal library version: " ++ libVersion
(_, Nothing) -> assert False $ return ()
(Just v, Just vr)
| v `withinRange` vr -> return ()
| otherwise -> error $ "Unsupported Cabal version: " ++ libVersion
ph <- withBinaryFile "build.log" WriteMode $ \handle ->
runProcess "cabal-dev" ("install":"-fnetwork23":iiPackageList ii) Nothing Nothing Nothing (Just handle) (Just handle)
let args = addCabalArgs root
$ "install"
: ("--cabal-lib-version=" ++ libVersion)
: "--build-log=logs/$pkg.log"
: "--enable-shared"
: "-j"
: (extraBuildArgs . extraArgs) (iiPackageList ii)
in runProcess "cabal" args Nothing Nothing Nothing (Just handle) (Just handle)
ec <- waitForProcess ph
unless (ec == ExitSuccess) $ do
putStrLn "Build failed, please see build.log"
exitWith ec
putStrLn "Sandbox built, beginning individual test suites"
runTestSuites ii
runTestSuites root ii
putStrLn "All test suites that were expected to pass did pass, building tarballs."
makeTarballs ii

View File

@ -16,13 +16,13 @@ import System.Process (readProcessWithExitCode)
data Mismatch = OnlyDryRun String | OnlySimpleList String
deriving Show
checkPlan :: InstallInfo -> IO ()
checkPlan ii = do
(ec, dryRun', stderr) <- readProcessWithExitCode "cabal-dev" ("install":"--dry-run":"-fnetwork23":iiPackageList ii) ""
checkPlan :: ([String] -> [String]) -> InstallInfo -> IO ()
checkPlan extraArgs ii = do
(ec, dryRun', stderr) <- readProcessWithExitCode "cabal" (extraArgs $ "install":"--dry-run":iiPackageList ii) ""
when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
putStr stderr
putStr dryRun'
putStrLn "cabal-dev returned a bad result, exiting"
putStrLn "cabal returned a bad result, exiting"
exitWith ec
let dryRun = sort $ filter notOptionalCore $ map (takeWhile (/= ' ')) $ drop 2 $ lines dryRun'
let mismatches = getMismatches dryRun (filter notOptionalCore $ iiPackageList ii)

View File

@ -20,12 +20,12 @@ import System.Process (runProcess, waitForProcess)
import Control.Exception (handle, Exception, throwIO)
import Data.Typeable (Typeable)
runTestSuites :: InstallInfo -> IO ()
runTestSuites ii = do
runTestSuites :: FilePath -> InstallInfo -> IO ()
runTestSuites root ii = do
let testdir = "runtests"
rm_r testdir
createDirectory testdir
allPass <- foldM (runTestSuite testdir) True $ filter hasTestSuites $ Map.toList $ iiPackages ii
allPass <- foldM (runTestSuite root testdir) True $ filter hasTestSuites $ Map.toList $ iiPackages ii
unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
where
PackageDB pdb = iiPackageDB ii
@ -48,12 +48,11 @@ data TestException = TestException
deriving (Show, Typeable)
instance Exception TestException
runTestSuite :: FilePath -> Bool -> (PackageName, (Version, Maintainer)) -> IO Bool
runTestSuite testdir prevPassed (packageName, (version, Maintainer maintainer)) = do
-- Set up a new environment that includes the cabal-dev/bin folder in PATH.
runTestSuite :: FilePath -> FilePath -> Bool -> (PackageName, (Version, Maintainer)) -> IO Bool
runTestSuite root testdir prevPassed (packageName, (version, Maintainer maintainer)) = do
-- Set up a new environment that includes the sandboxed bin folder in PATH.
env' <- getEnvironment
bin <- canonicalizePath "cabal-dev/bin"
let menv = Just $ map (fixEnv bin) env'
let menv = Just $ map (fixEnv $ binDir root) env'
let run cmd args wdir handle = do
ph <- runProcess cmd args (Just wdir) menv Nothing (Just handle) (Just handle)
@ -62,10 +61,10 @@ runTestSuite testdir prevPassed (packageName, (version, Maintainer maintainer))
passed <- handle (\TestException -> return False) $ do
getHandle WriteMode $ run "cabal" ["unpack", package] testdir
getHandle AppendMode $ run "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] dir
getHandle AppendMode $ run "cabal-dev" ["build"] dir
getHandle AppendMode $ run "cabal-dev" ["test"] dir
getHandle AppendMode $ run "cabal-dev" ["haddock"] dir
getHandle AppendMode $ run "cabal" (addCabalArgs root ["configure", "--enable-tests"]) dir
getHandle AppendMode $ run "cabal" ["build"] dir
getHandle AppendMode $ run "cabal" ["test"] dir
getHandle AppendMode $ run "cabal" ["haddock"] dir
return True
let expectedFailure = packageName `Set.member` expectedFailures
if passed

View File

@ -68,3 +68,15 @@ getPackageVersion e = do
-- not there. Defaulting to @False@ would result in silent failures.
defaultHasTestSuites :: Bool
defaultHasTestSuites = True
packageDir = (</> "package-db")
libDir = (</> "lib")
binDir = (</> "bin")
addCabalArgs root rest
= "--package-db=clear"
: "--package-db=global"
: ("--package-db=" ++ packageDir root)
: ("--libdir=" ++ libDir root)
: ("--bindir=" ++ binDir root)
: rest

View File

@ -6,7 +6,7 @@ main :: IO ()
main = do
args <- getArgs
case args of
["build"] -> build
["build"] -> build "sandbox" id
["init"] -> stackageInit
["update"] -> stackageInit >> error "FIXME update"
_ -> do