diff --git a/README.md b/README.md index bb942298..f9024931 100644 --- a/README.md +++ b/README.md @@ -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. diff --git a/Stackage/Build.hs b/Stackage/Build.hs index 33416aa7..a33ffffc 100644 --- a/Stackage/Build.hs +++ b/Stackage/Build.hs @@ -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 diff --git a/Stackage/CheckPlan.hs b/Stackage/CheckPlan.hs index 8a6c9c42..d70da939 100644 --- a/Stackage/CheckPlan.hs +++ b/Stackage/CheckPlan.hs @@ -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) diff --git a/Stackage/Test.hs b/Stackage/Test.hs index 6c37e66d..8a99c0be 100644 --- a/Stackage/Test.hs +++ b/Stackage/Test.hs @@ -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 diff --git a/Stackage/Util.hs b/Stackage/Util.hs index 9a62073a..a33396d0 100644 --- a/Stackage/Util.hs +++ b/Stackage/Util.hs @@ -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 diff --git a/app/stackage.hs b/app/stackage.hs index 7b173a11..853c5d75 100644 --- a/app/stackage.hs +++ b/app/stackage.hs @@ -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