From 3682ad56127f7714f097cd607bb7723eb52760f4 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 24 Jan 2013 19:59:19 +0200 Subject: [PATCH] Separate version selection and building #25 --- .gitignore | 1 + Stackage/Build.hs | 32 +++---------------- Stackage/CheckPlan.hs | 2 ++ Stackage/HaskellPlatform.hs | 2 +- Stackage/InstallInfo.hs | 8 ++--- Stackage/LoadDatabase.hs | 2 +- Stackage/NarrowDatabase.hs | 2 +- Stackage/Select.hs | 31 +++++++++++------- Stackage/Tarballs.hs | 1 + Stackage/Test.hs | 8 +++-- Stackage/Types.hs | 33 ++++++++++--------- app/stackage.hs | 63 ++++++++++++++++++++++++++----------- 12 files changed, 104 insertions(+), 81 deletions(-) diff --git a/.gitignore b/.gitignore index 126b175a..cbf7c29b 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,4 @@ cabal-dev /sandbox/ /build-tools.log /logs-tools/ +build-plan.txt diff --git a/Stackage/Build.hs b/Stackage/Build.hs index 007e191c..4a179b62 100644 --- a/Stackage/Build.hs +++ b/Stackage/Build.hs @@ -34,30 +34,16 @@ import Stackage.CheckCabalVersion (checkCabalVersion) defaultBuildSettings :: BuildSettings defaultBuildSettings = BuildSettings { sandboxRoot = "sandbox" - , extraBuildArgs = [] - , extraCore = defaultExtraCore - , expectedFailures = defaultExpectedFailures - , stablePackages = defaultStablePackages + , expectedFailuresBuild = defaultExpectedFailures , extraArgs = ["-fnetwork23"] - , haskellPlatformCabal = "haskell-platform/haskell-platform.cabal" - , requireHaskellPlatform = True - , excludedPackages = empty , testWorkerThreads = 4 - , flags = Set.fromList $ words "blaze_html_0_5" - , allowedPackage = const $ Right () } -build :: BuildSettings -> IO () -build settings' = do +build :: BuildSettings -> BuildPlan -> IO () +build settings' bp = do putStrLn "Checking Cabal version" libVersion <- checkCabalVersion - bp <- select settings' - - putStrLn "Checking build plan" - checkPlan bp - putStrLn "No mismatches, starting the sandboxed build." - putStrLn "Wiping out old sandbox folder" rm_r $ sandboxRoot settings' rm_r "logs" @@ -84,8 +70,7 @@ build settings' = do : "--build-log=logs-tools/$pkg.log" : "-j" : concat - [ extraBuildArgs settings - , extraArgs settings + [ extraArgs settings , tools ] hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args)) @@ -103,8 +88,7 @@ build settings' = do : "--build-log=logs/$pkg.log" : "-j" : concat - [ extraBuildArgs settings - , extraArgs settings + [ extraArgs settings , bpPackageList bp ] hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args)) @@ -114,12 +98,6 @@ build settings' = do putStrLn "Build failed, please see build.log" exitWith ec - putStrLn "Sandbox built, beginning individual test suites" - runTestSuites settings $ bpPackages bp - - putStrLn "All test suites that were expected to pass did pass, building tarballs." - makeTarballs bp - -- | Get all of the build tools required. iiBuildTools :: InstallInfo -> [String] iiBuildTools InstallInfo { iiPackageDB = PackageDB m, iiPackages = packages } = diff --git a/Stackage/CheckPlan.hs b/Stackage/CheckPlan.hs index 7bbc9d1c..0568a7ca 100644 --- a/Stackage/CheckPlan.hs +++ b/Stackage/CheckPlan.hs @@ -18,6 +18,7 @@ data Mismatch = OnlyDryRun String | OnlySimpleList String checkPlan :: BuildPlan -> IO () checkPlan bp = do + putStrLn "Checking build plan" (ec, dryRun', stderr) <- readProcessWithExitCode "cabal" (addCabalArgsOnlyGlobal $ "install":"--dry-run":bpPackageList bp) "" when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do putStr stderr @@ -30,6 +31,7 @@ checkPlan bp = do putStrLn "Found the following mismatches" mapM_ print mismatches exitWith $ ExitFailure 1 + putStrLn "Build plan checked, no mismatches" where optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ bpOptionalCore bp notOptionalCore s = not $ s `Set.member` optionalCore diff --git a/Stackage/HaskellPlatform.hs b/Stackage/HaskellPlatform.hs index bf25e539..fa3a7a40 100644 --- a/Stackage/HaskellPlatform.hs +++ b/Stackage/HaskellPlatform.hs @@ -11,7 +11,7 @@ import Data.Set (singleton) import Distribution.Text (simpleParse) import Stackage.Types -loadHaskellPlatform :: BuildSettings -> IO HaskellPlatform +loadHaskellPlatform :: SelectSettings -> IO HaskellPlatform loadHaskellPlatform = fmap parseHP . readFile . haskellPlatformCabal data HPLine = HPLPackage PackageIdentifier diff --git a/Stackage/InstallInfo.hs b/Stackage/InstallInfo.hs index 68bd99d9..6fd1625a 100644 --- a/Stackage/InstallInfo.hs +++ b/Stackage/InstallInfo.hs @@ -17,13 +17,13 @@ import Stackage.NarrowDatabase import Stackage.Types import Stackage.Util -dropExcluded :: BuildSettings +dropExcluded :: SelectSettings -> Map PackageName (VersionRange, Maintainer) -> Map PackageName (VersionRange, Maintainer) dropExcluded bs m0 = Set.foldl' (flip Map.delete) m0 (excludedPackages bs) -getInstallInfo :: BuildSettings -> IO InstallInfo +getInstallInfo :: SelectSettings -> IO InstallInfo getInstallInfo settings = do putStrLn "Loading Haskell Platform" hp <- loadHaskellPlatform settings @@ -96,14 +96,14 @@ bpPackageList :: BuildPlan -> [String] bpPackageList = map packageVersionString . Map.toList . Map.map spiVersion . bpPackages -- | Check for internal mismatches in required and actual package versions. -checkBadVersions :: BuildSettings +checkBadVersions :: SelectSettings -> PackageDB -> Map PackageName BuildInfo -> Map String (Map PackageName (Version, VersionRange)) checkBadVersions settings (PackageDB pdb) buildPlan = Map.unions $ map getBadVersions $ Map.toList $ Map.filterWithKey unexpectedFailure buildPlan where - unexpectedFailure name _ = name `Set.notMember` expectedFailures settings + unexpectedFailure name _ = name `Set.notMember` expectedFailuresSelect settings getBadVersions :: (PackageName, BuildInfo) -> Map String (Map PackageName (Version, VersionRange)) getBadVersions (name, bi) diff --git a/Stackage/LoadDatabase.hs b/Stackage/LoadDatabase.hs index 58963032..46026a70 100644 --- a/Stackage/LoadDatabase.hs +++ b/Stackage/LoadDatabase.hs @@ -53,7 +53,7 @@ import Stackage.Util -- version. -- -- * For other packages, select the maximum version number. -loadPackageDB :: BuildSettings +loadPackageDB :: SelectSettings -> Set PackageName -- ^ core packages -> Map PackageName (VersionRange, Maintainer) -- ^ additional deps -> IO PackageDB diff --git a/Stackage/NarrowDatabase.hs b/Stackage/NarrowDatabase.hs index 6c7ba928..1d2c11ef 100644 --- a/Stackage/NarrowDatabase.hs +++ b/Stackage/NarrowDatabase.hs @@ -10,7 +10,7 @@ import System.Exit (exitFailure) -- | Narrow down the database to only the specified packages and all of -- their dependencies. -narrowPackageDB :: BuildSettings +narrowPackageDB :: SelectSettings -> PackageDB -> Set (PackageName, Maintainer) -> IO (Map PackageName BuildInfo) diff --git a/Stackage/Select.hs b/Stackage/Select.hs index fff4c104..6d89dcfe 100644 --- a/Stackage/Select.hs +++ b/Stackage/Select.hs @@ -1,5 +1,6 @@ module Stackage.Select ( select + , defaultSelectSettings ) where import Control.Exception (assert) @@ -28,20 +29,28 @@ import System.Process (rawSystem, readProcess, runProcess, waitForProcess) import Stackage.BuildPlan -select :: BuildSettings -> IO BuildPlan +defaultSelectSettings :: SelectSettings +defaultSelectSettings = SelectSettings + { extraCore = defaultExtraCore + , expectedFailuresSelect = defaultExpectedFailures + , stablePackages = defaultStablePackages + , haskellPlatformCabal = "haskell-platform/haskell-platform.cabal" + , requireHaskellPlatform = True + , excludedPackages = empty + , flags = Set.fromList $ words "blaze_html_0_5" + , allowedPackage = const $ Right () + } + +select :: SelectSettings -> IO BuildPlan select settings' = do ii <- getInstallInfo settings' - let bp = BuildPlan - { bpTools = iiBuildTools ii - , bpPackages = iiPackages ii - , bpOptionalCore = iiOptionalCore ii - , bpCore = iiCore ii - } - - writeBuildPlan "build-plan.txt" bp -- FIXME - readBuildPlan "build-plan.txt" - --return bp + return BuildPlan + { bpTools = iiBuildTools ii + , bpPackages = iiPackages ii + , bpOptionalCore = iiOptionalCore ii + , bpCore = iiCore ii + } -- | Get all of the build tools required. iiBuildTools :: InstallInfo -> [String] diff --git a/Stackage/Tarballs.hs b/Stackage/Tarballs.hs index 4a0f8346..caf48471 100644 --- a/Stackage/Tarballs.hs +++ b/Stackage/Tarballs.hs @@ -13,6 +13,7 @@ import System.FilePath (takeDirectory) makeTarballs :: BuildPlan -> IO () makeTarballs bp = do + putStrLn "Building tarballs" tarName <- getTarballName origEntries <- fmap Tar.read $ L.readFile tarName (stableEntries, extraEntries) <- loop id id origEntries diff --git a/Stackage/Test.hs b/Stackage/Test.hs index 9df7061a..0eb58346 100644 --- a/Stackage/Test.hs +++ b/Stackage/Test.hs @@ -19,8 +19,10 @@ import System.IO (IOMode (WriteMode, AppendMode), withBinaryFile) import System.Process (runProcess, waitForProcess) -runTestSuites :: BuildSettings -> Map PackageName SelectedPackageInfo -> IO () -runTestSuites settings selected = do +runTestSuites :: BuildSettings -> BuildPlan -> IO () +runTestSuites settings bp = do + let selected = bpPackages bp + putStrLn "Running test suites" let testdir = "runtests" rm_r testdir createDirectory testdir @@ -99,7 +101,7 @@ runTestSuite settings testdir (packageName, SelectedPackageInfo {..}) = do getHandle AppendMode $ runGhcPackagePath "cabal" ["test"] dir getHandle AppendMode $ run "cabal" ["haddock"] dir return True - let expectedFailure = packageName `Set.member` expectedFailures settings + let expectedFailure = packageName `Set.member` expectedFailuresBuild settings if passed then do removeFile logfile diff --git a/Stackage/Types.hs b/Stackage/Types.hs index 42a3c4bd..42bb1d51 100644 --- a/Stackage/Types.hs +++ b/Stackage/Types.hs @@ -89,23 +89,12 @@ data BuildPlan = BuildPlan newtype Maintainer = Maintainer { unMaintainer :: String } deriving (Show, Eq, Ord, Read) -data BuildSettings = BuildSettings - { sandboxRoot :: FilePath - , extraBuildArgs :: [String] - , extraCore :: Set PackageName - , expectedFailures :: Set PackageName - , stablePackages :: Map PackageName (VersionRange, Maintainer) - , extraArgs :: [String] - , haskellPlatformCabal :: FilePath - , requireHaskellPlatform :: Bool - , excludedPackages :: Set PackageName - -- ^ Packages which should be dropped from the list of stable packages, - -- even if present via the Haskell Platform or @stablePackages@. If these - -- packages are dependencies of others, they will still be included. - , testWorkerThreads :: Int - -- ^ How many threads to spawn for running test suites. +data SelectSettings = SelectSettings + { haskellPlatformCabal :: FilePath , flags :: Set String -- ^ Compile flags which should be turned on. + , extraCore :: Set PackageName + , requireHaskellPlatform :: Bool , allowedPackage :: GenericPackageDescription -> Either String () -- ^ Checks if a package is allowed into the distribution. By default, we -- allow all packages in, though this could be used to filter out certain @@ -113,6 +102,20 @@ data BuildSettings = BuildSettings -- -- Returns a reason for stripping in Left, or Right if the package is -- allowed. + , expectedFailuresSelect :: Set PackageName + , excludedPackages :: Set PackageName + -- ^ Packages which should be dropped from the list of stable packages, + -- even if present via the Haskell Platform or @stablePackages@. If these + -- packages are dependencies of others, they will still be included. + , stablePackages :: Map PackageName (VersionRange, Maintainer) + } + +data BuildSettings = BuildSettings + { sandboxRoot :: FilePath + , extraArgs :: [String] + , expectedFailuresBuild :: Set PackageName + , testWorkerThreads :: Int + -- ^ How many threads to spawn for running test suites. } -- | A wrapper around a @Map@ providing a better @Monoid@ instance. diff --git a/app/stackage.hs b/app/stackage.hs index dfdee4f7..c208a7c1 100644 --- a/app/stackage.hs +++ b/app/stackage.hs @@ -3,24 +3,31 @@ import Stackage.Types import Stackage.Build (build, defaultBuildSettings) import Stackage.Init (stackageInit) import Stackage.Util (allowPermissive) +import Stackage.Select (defaultSelectSettings, select) +import Stackage.CheckPlan (checkPlan) import System.Environment (getArgs, getProgName) import Data.Set (fromList) import System.IO (hFlush, stdout) +import Stackage.BuildPlan (readBuildPlan, writeBuildPlan) +import Stackage.Test (runTestSuites) +import Stackage.Tarballs (makeTarballs) -data BuildArgs = BuildArgs +data SelectArgs = SelectArgs { excluded :: [String] , noPlatform :: Bool , onlyPermissive :: Bool , allowed :: [String] + , buildPlanDest :: FilePath } -parseBuildArgs :: [String] -> IO BuildArgs -parseBuildArgs = - loop BuildArgs +parseSelectArgs :: [String] -> IO SelectArgs +parseSelectArgs = + loop SelectArgs { excluded = [] , noPlatform = False , onlyPermissive = False , allowed = [] + , buildPlanDest = defaultBuildPlan } where loop x [] = return x @@ -28,22 +35,35 @@ parseBuildArgs = loop x ("--no-platform":rest) = loop x { noPlatform = True } rest loop x ("--only-permissive":rest) = loop x { onlyPermissive = True } rest loop x ("--allow":y:rest) = loop x { allowed = y : allowed x } rest + loop x ("--build-plan":y:rest) = loop x { buildPlanDest = y } rest loop _ (y:_) = error $ "Did not understand argument: " ++ y +defaultBuildPlan :: FilePath +defaultBuildPlan = "build-plan.txt" + main :: IO () main = do args <- getArgs case args of - "build":rest -> do - BuildArgs {..} <- parseBuildArgs rest - build defaultBuildSettings - { excludedPackages = fromList $ map PackageName excluded - , requireHaskellPlatform = not noPlatform - , allowedPackage = - if onlyPermissive - then allowPermissive allowed - else const $ Right () - } + "select":rest -> do + SelectArgs {..} <- parseSelectArgs rest + bp <- select + defaultSelectSettings + { excludedPackages = fromList $ map PackageName excluded + , requireHaskellPlatform = not noPlatform + , allowedPackage = + if onlyPermissive + then allowPermissive allowed + else const $ Right () + } + writeBuildPlan buildPlanDest bp + ["check"] -> checkHelper defaultBuildPlan + ["check", fp] -> checkHelper fp + ["build"] -> buildHelper defaultBuildPlan + ["build", fp] -> buildHelper fp + ["test"] -> testHelper defaultBuildPlan + ["test", fp] -> testHelper fp + ["tarballs"] -> tbHelper defaultBuildPlan ["init"] -> do putStrLn "Note: init isn't really ready for prime time use." putStrLn "Using it may make it impossible to build stackage." @@ -58,7 +78,14 @@ main = do pn <- getProgName putStrLn $ "Usage: " ++ pn ++ " " putStrLn "Available commands:" - putStrLn " update Download updated Stackage databases. Automatically calls init." - putStrLn " init Initialize your cabal file to use Stackage" - putStrLn " build [--no-clean] [--no-platform] [--exclude package...] [--only-permissive] [--allow package]" - putStrLn " Build the package databases (maintainers only)" + --putStrLn " update Download updated Stackage databases. Automatically calls init." + --putStrLn " init Initialize your cabal file to use Stackage" + putStrLn " select [--no-clean] [--no-platform] [--exclude package...] [--only-permissive] [--allow package] [--build-plan file]" + putStrLn " check [build plan file]" + putStrLn " build [build plan file]" + putStrLn " test [build plan file]" + where + checkHelper fp = readBuildPlan fp >>= checkPlan + buildHelper fp = readBuildPlan fp >>= build defaultBuildSettings + testHelper fp = readBuildPlan fp >>= runTestSuites defaultBuildSettings + tbHelper fp = readBuildPlan fp >>= makeTarballs