Track multiple haskell-platform versions and determine GHC version

This commit is contained in:
Michael Snoyman 2013-06-30 08:59:00 +03:00
parent a428d0e41b
commit f90bccf74a
10 changed files with 86 additions and 55 deletions

3
.gitmodules vendored
View File

@ -1,3 +0,0 @@
[submodule "haskell-platform"]
path = haskell-platform
url = https://github.com/haskell/haskell-platform.git

View File

@ -18,10 +18,10 @@ import System.IO (BufferMode (NoBuffering),
import System.Process (rawSystem, runProcess, import System.Process (rawSystem, runProcess,
waitForProcess) waitForProcess)
defaultBuildSettings :: BuildSettings defaultBuildSettings :: GhcMajorVersion -> BuildSettings
defaultBuildSettings = BuildSettings defaultBuildSettings version = BuildSettings
{ sandboxRoot = "sandbox" { sandboxRoot = "sandbox"
, expectedFailuresBuild = defaultExpectedFailures , expectedFailuresBuild = defaultExpectedFailures version
, extraArgs = const ["-fnetwork23"] , extraArgs = const ["-fnetwork23"]
, testWorkerThreads = 4 , testWorkerThreads = 4
, buildDocs = True , buildDocs = True

View File

@ -7,23 +7,18 @@ import Data.Set (fromList)
import Distribution.Text (simpleParse) import Distribution.Text (simpleParse)
import Stackage.Types import Stackage.Types
targetCompilerVersion :: Version
targetCompilerVersion =
case simpleParse "7.4.2" of
Nothing -> error "Invalid targetCompilerVersion"
Just v -> v
-- | Packages which are shipped with GHC but are not included in the -- | Packages which are shipped with GHC but are not included in the
-- Haskell Platform list of core packages. -- Haskell Platform list of core packages.
defaultExtraCore :: Set PackageName defaultExtraCore :: GhcMajorVersion -> Set PackageName
defaultExtraCore = fromList $ map PackageName $ words defaultExtraCore _ = fromList $ map PackageName $ words
"binary Win32" "binary Win32"
-- | Test suites which are expected to fail for some reason. The test suite -- | Test suites which are expected to fail for some reason. The test suite
-- will still be run and logs kept, but a failure will not indicate an -- will still be run and logs kept, but a failure will not indicate an
-- error in our package combination. -- error in our package combination.
defaultExpectedFailures :: Set PackageName defaultExpectedFailures :: GhcMajorVersion
defaultExpectedFailures = fromList $ map PackageName -> Set PackageName
defaultExpectedFailures _ = fromList $ map PackageName
[ -- Requires an old version of WAI and Warp for tests [ -- Requires an old version of WAI and Warp for tests
"HTTP" "HTTP"
@ -93,8 +88,8 @@ defaultExpectedFailures = fromList $ map PackageName
-- | List of packages for our stable Hackage. All dependencies will be -- | List of packages for our stable Hackage. All dependencies will be
-- included as well. Please indicate who will be maintaining the package -- included as well. Please indicate who will be maintaining the package
-- via comments. -- via comments.
defaultStablePackages :: Map PackageName (VersionRange, Maintainer) defaultStablePackages :: GhcMajorVersion -> Map PackageName (VersionRange, Maintainer)
defaultStablePackages = unPackageMap $ execWriter $ do defaultStablePackages _ = unPackageMap $ execWriter $ do
mapM_ (add "michael@snoyman.com") $ words =<< mapM_ (add "michael@snoyman.com") $ words =<<
[ "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test yesod-bin" [ "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test yesod-bin"
, "markdown filesystem-conduit mime-mail-ses" , "markdown filesystem-conduit mime-mail-ses"

View File

@ -3,24 +3,21 @@ module Stackage.GhcPkg where
import Stackage.Types import Stackage.Types
import System.Process import System.Process
import Distribution.Text (simpleParse) import Distribution.Text (simpleParse)
import Distribution.Version (Version (Version))
import Data.Char (isSpace) import Data.Char (isSpace)
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Control.Monad (guard) import Control.Monad (guard)
getGlobalPackages :: IO (Set PackageIdentifier) getGlobalPackages :: GhcMajorVersion -> IO (Set PackageIdentifier)
getGlobalPackages = do getGlobalPackages version = do
-- Account for a change in command line option name
versionOutput <- readProcess "ghc-pkg" ["--version"] ""
let arg = fromMaybe "--no-user-package-db" $ do
verS:_ <- Just $ reverse $ words versionOutput
v76 <- simpleParse "7.6"
ver <- simpleParse verS
guard $ ver < (v76 :: Version)
return "--no-user-package-conf"
output <- readProcess "ghc-pkg" [arg, "list"] "" output <- readProcess "ghc-pkg" [arg, "list"] ""
fmap Set.unions $ mapM parse $ drop 1 $ lines output fmap Set.unions $ mapM parse $ drop 1 $ lines output
where where
-- Account for a change in command line option name
arg
| version >= GhcMajorVersion 7 6 = "--no-user-package-db"
| otherwise = "--no-user-package-conf"
parse s = parse s =
case clean s of case clean s of
"" -> return Set.empty "" -> return Set.empty
@ -32,3 +29,11 @@ getGlobalPackages = do
stripParens x@('(':_:_) stripParens x@('(':_:_)
| last x == ')' = tail $ init $ x | last x == ')' = tail $ init $ x
stripParens x = x stripParens x = x
getGhcVersion :: IO GhcMajorVersion
getGhcVersion = do
versionOutput <- readProcess "ghc-pkg" ["--version"] ""
maybe (error $ "Invalid version output: " ++ show versionOutput) return $ do
verS:_ <- Just $ reverse $ words versionOutput
Version (x:y:_) _ <- simpleParse verS
return $ GhcMajorVersion x y

View File

@ -10,9 +10,25 @@ import Data.Monoid (Monoid (..))
import Data.Set (singleton) import Data.Set (singleton)
import Distribution.Text (simpleParse) import Distribution.Text (simpleParse)
import Stackage.Types import Stackage.Types
import System.Directory (doesFileExist)
import System.FilePath ((</>))
loadHaskellPlatform :: SelectSettings -> IO HaskellPlatform loadHaskellPlatform :: SelectSettings -> IO (Maybe HaskellPlatform)
loadHaskellPlatform = fmap parseHP . readFile . haskellPlatformCabal loadHaskellPlatform ss = do
e <- doesFileExist fp
if e
then fmap (Just . parseHP) $ readFile fp
else return Nothing
where
GhcMajorVersion x y = selectGhcVersion ss
fp = haskellPlatformDir ss </> (concat
[ "haskell-platform-"
, show x
, "."
, show y
, ".cabal"
])
data HPLine = HPLPackage PackageIdentifier data HPLine = HPLPackage PackageIdentifier
| HPLBeginCore | HPLBeginCore

View File

@ -27,21 +27,23 @@ dropExcluded bs m0 =
getInstallInfo :: SelectSettings -> IO InstallInfo getInstallInfo :: SelectSettings -> IO InstallInfo
getInstallInfo settings = do getInstallInfo settings = do
putStrLn "Loading Haskell Platform" putStrLn "Loading Haskell Platform"
hp <- loadHaskellPlatform settings mhp <- loadHaskellPlatform settings
core <- core <-
if useGlobalDatabase settings case mhp of
then do Just hp | not (useGlobalDatabase settings) -> return $ hpcore hp
_ -> do
putStrLn "Loading core packages from global database" putStrLn "Loading core packages from global database"
getGlobalPackages getGlobalPackages $ selectGhcVersion settings
else return $ hpcore hp
let coreMap = Map.unions let coreMap = Map.unions
$ map (\(PackageIdentifier k v) -> Map.singleton k v) $ map (\(PackageIdentifier k v) -> Map.singleton k v)
$ Set.toList core $ Set.toList core
let allPackages' let allPackages' =
| requireHaskellPlatform settings = Map.union (stablePackages settings) $ identsToRanges (hplibs hp) case mhp of
| otherwise = stablePackages settings Just hp | requireHaskellPlatform settings ->
Map.union (stablePackages settings) $ identsToRanges (hplibs hp)
_ -> stablePackages settings
allPackages = dropExcluded settings allPackages' allPackages = dropExcluded settings allPackages'
let totalCore = extraCore settings `Set.union` Set.map (\(PackageIdentifier p _) -> p) core let totalCore = extraCore settings `Set.union` Set.map (\(PackageIdentifier p _) -> p) core
@ -80,7 +82,10 @@ getInstallInfo settings = do
return InstallInfo return InstallInfo
{ iiCore = totalCore { iiCore = totalCore
, iiPackages = Map.map biToSPI final , iiPackages = Map.map biToSPI final
, iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp , iiOptionalCore = maybe
Map.empty
(Map.fromList . map (\(PackageIdentifier p v) -> (p, v)) . Set.toList . hplibs)
mhp
, iiPackageDB = pdb , iiPackageDB = pdb
} }

View File

@ -37,7 +37,7 @@ import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
parsePackageDescription) parsePackageDescription)
import Distribution.System (buildArch, buildOS) import Distribution.System (buildArch, buildOS)
import Distribution.Version (unionVersionRanges, import Distribution.Version (unionVersionRanges,
withinRange) withinRange, Version (Version))
import Stackage.Config import Stackage.Config
import Stackage.Types import Stackage.Types
import Stackage.Util import Stackage.Util
@ -67,6 +67,10 @@ loadPackageDB settings coreMap core deps = do
addEntries db Tar.Done = return db addEntries db Tar.Done = return db
addEntries db (Tar.Next e es) = addEntry db e >>= flip addEntries es addEntries db (Tar.Next e es) = addEntry db e >>= flip addEntries es
ghcVersion' =
let GhcMajorVersion x y = selectGhcVersion settings
in Version [x, y, 2] []
addEntry :: PackageDB -> Tar.Entry -> IO PackageDB addEntry :: PackageDB -> Tar.Entry -> IO PackageDB
addEntry pdb e = addEntry pdb e =
case getPackageVersion e of case getPackageVersion e of
@ -144,7 +148,7 @@ loadPackageDB settings coreMap core deps = do
flag' `Set.notMember` disabledFlags settings && flag' `Set.notMember` disabledFlags settings &&
flag `elem` flags' flag `elem` flags'
checkCond' (Var (Impl compiler range)) = checkCond' (Var (Impl compiler range)) =
compiler == GHC && withinRange targetCompilerVersion range compiler == GHC && withinRange ghcVersion' range
checkCond' (Lit b) = b checkCond' (Lit b) = b
checkCond' (CNot c) = not $ checkCond' c checkCond' (CNot c) = not $ checkCond' c
checkCond' (COr c1 c2) = checkCond' c1 || checkCond' c2 checkCond' (COr c1 c2) = checkCond' c1 || checkCond' c2

View File

@ -18,12 +18,12 @@ import Stackage.InstallInfo
import Stackage.Types import Stackage.Types
import Stackage.Util import Stackage.Util
defaultSelectSettings :: SelectSettings defaultSelectSettings :: GhcMajorVersion -> SelectSettings
defaultSelectSettings = SelectSettings defaultSelectSettings version = SelectSettings
{ extraCore = defaultExtraCore { extraCore = defaultExtraCore version
, expectedFailuresSelect = defaultExpectedFailures , expectedFailuresSelect = defaultExpectedFailures version
, stablePackages = defaultStablePackages , stablePackages = defaultStablePackages version
, haskellPlatformCabal = "haskell-platform/haskell-platform.cabal" , haskellPlatformDir = "haskell-platform"
, requireHaskellPlatform = True , requireHaskellPlatform = True
, excludedPackages = empty , excludedPackages = empty
, flags = \coreMap -> , flags = \coreMap ->
@ -42,6 +42,7 @@ defaultSelectSettings = SelectSettings
, allowedPackage = const $ Right () , allowedPackage = const $ Right ()
, useGlobalDatabase = False , useGlobalDatabase = False
, skippedTests = empty , skippedTests = empty
, selectGhcVersion = version
} }
select :: SelectSettings -> IO BuildPlan select :: SelectSettings -> IO BuildPlan

View File

@ -91,7 +91,7 @@ newtype Maintainer = Maintainer { unMaintainer :: String }
deriving (Show, Eq, Ord, Read) deriving (Show, Eq, Ord, Read)
data SelectSettings = SelectSettings data SelectSettings = SelectSettings
{ haskellPlatformCabal :: FilePath { haskellPlatformDir :: FilePath
, flags :: Map PackageName Version -> Set String , flags :: Map PackageName Version -> Set String
-- ^ Compile flags which should be turned on. Takes a Map providing the -- ^ Compile flags which should be turned on. Takes a Map providing the
-- core packages so that flags can be set appropriately. -- core packages so that flags can be set appropriately.
@ -119,6 +119,7 @@ data SelectSettings = SelectSettings
, skippedTests :: Set PackageName , skippedTests :: Set PackageName
-- ^ Do not build or run test suites, usually in order to avoid a -- ^ Do not build or run test suites, usually in order to avoid a
-- dependency. -- dependency.
, selectGhcVersion :: GhcMajorVersion
} }
data BuildStage = BSBuild | BSTest data BuildStage = BSBuild | BSTest
@ -142,3 +143,7 @@ instance Monoid PackageMap where
PackageMap $ unionWith go x y PackageMap $ unionWith go x y
where where
go (r1, m1) (r2, _) = (intersectVersionRanges r1 r2, m1) go (r1, m1) (r2, _) = (intersectVersionRanges r1 r2, m1)
-- | GHC major version. For example, for GHC 7.4.2, this would be 7 4.
data GhcMajorVersion = GhcMajorVersion Int Int
deriving (Show, Ord, Eq)

View File

@ -3,6 +3,7 @@ import Data.Set (fromList)
import Stackage.Build (build, defaultBuildSettings) import Stackage.Build (build, defaultBuildSettings)
import Stackage.BuildPlan (readBuildPlan, writeBuildPlan) import Stackage.BuildPlan (readBuildPlan, writeBuildPlan)
import Stackage.CheckPlan (checkPlan) import Stackage.CheckPlan (checkPlan)
import Stackage.GhcPkg (getGhcVersion)
import Stackage.Init (stackageInit) import Stackage.Init (stackageInit)
import Stackage.Select (defaultSelectSettings, select) import Stackage.Select (defaultSelectSettings, select)
import Stackage.Tarballs (makeTarballs) import Stackage.Tarballs (makeTarballs)
@ -49,10 +50,10 @@ data BuildArgs = BuildArgs
, noDocs :: Bool , noDocs :: Bool
} }
parseBuildArgs :: [String] -> IO BuildArgs parseBuildArgs :: GhcMajorVersion -> [String] -> IO BuildArgs
parseBuildArgs = parseBuildArgs version =
loop BuildArgs loop BuildArgs
{ sandbox = sandboxRoot defaultBuildSettings { sandbox = sandboxRoot $ defaultBuildSettings version
, buildPlanSrc = defaultBuildPlan , buildPlanSrc = defaultBuildPlan
, extraArgs' = id , extraArgs' = id
, noDocs = False , noDocs = False
@ -70,11 +71,12 @@ defaultBuildPlan = "build-plan.txt"
withBuildSettings :: [String] -> (BuildSettings -> BuildPlan -> IO a) -> IO a withBuildSettings :: [String] -> (BuildSettings -> BuildPlan -> IO a) -> IO a
withBuildSettings args f = do withBuildSettings args f = do
BuildArgs {..} <- parseBuildArgs args version <- getGhcVersion
BuildArgs {..} <- parseBuildArgs version args
bp <- readBuildPlan buildPlanSrc bp <- readBuildPlan buildPlanSrc
let settings = defaultBuildSettings let settings = (defaultBuildSettings version)
{ sandboxRoot = sandbox { sandboxRoot = sandbox
, extraArgs = extraArgs' . extraArgs defaultBuildSettings , extraArgs = extraArgs' . extraArgs (defaultBuildSettings version)
, buildDocs = not noDocs , buildDocs = not noDocs
} }
f settings bp f settings bp
@ -86,8 +88,9 @@ main = do
["uploads"] -> checkUploads "allowed.txt" "new-allowed.txt" ["uploads"] -> checkUploads "allowed.txt" "new-allowed.txt"
"select":rest -> do "select":rest -> do
SelectArgs {..} <- parseSelectArgs rest SelectArgs {..} <- parseSelectArgs rest
ghcVersion <- getGhcVersion
bp <- select bp <- select
defaultSelectSettings (defaultSelectSettings ghcVersion)
{ excludedPackages = fromList $ map PackageName excluded { excludedPackages = fromList $ map PackageName excluded
, requireHaskellPlatform = not noPlatform , requireHaskellPlatform = not noPlatform
, allowedPackage = , allowedPackage =