mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-12 07:18:31 +01:00
No more cabal-dev usage
This commit is contained in:
parent
fd62aee254
commit
a0d0948dea
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user