Browse Source

Separate version selection and building #25

fpco
Michael Snoyman 9 years ago
parent
commit
3682ad5612
  1. 1
      .gitignore
  2. 32
      Stackage/Build.hs
  3. 2
      Stackage/CheckPlan.hs
  4. 2
      Stackage/HaskellPlatform.hs
  5. 8
      Stackage/InstallInfo.hs
  6. 2
      Stackage/LoadDatabase.hs
  7. 2
      Stackage/NarrowDatabase.hs
  8. 31
      Stackage/Select.hs
  9. 1
      Stackage/Tarballs.hs
  10. 8
      Stackage/Test.hs
  11. 33
      Stackage/Types.hs
  12. 63
      app/stackage.hs

1
.gitignore

@ -13,3 +13,4 @@ cabal-dev
/sandbox/
/build-tools.log
/logs-tools/
build-plan.txt

32
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 } =

2
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

2
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

8
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)

2
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

2
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)

31
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]

1
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

8
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

33
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.

63
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 ++ " <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…
Cancel
Save