mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-11 23:08:30 +01:00
Separate version selection and building #25
This commit is contained in:
parent
fb2385dd9c
commit
3682ad5612
1
.gitignore
vendored
1
.gitignore
vendored
@ -13,3 +13,4 @@ cabal-dev
|
||||
/sandbox/
|
||||
/build-tools.log
|
||||
/logs-tools/
|
||||
build-plan.txt
|
||||
|
||||
@ -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 } =
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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 ++ " <command>"
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user