haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-02-08 12:27:27 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Better flags serialization

Browse Source
This commit is contained in:
Michael Snoyman 2014-12-07 12:45:49 +02:00
parent 69f3a1b8e7
commit 78e48025c4
2 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Stackage2/BuildPlan.hs
View File

@ -260,6 +260,7 @@ mkPackageBuild gpd = do
let overrides = packageFlags name ++ defaultGlobalFlags let overrides = packageFlags name ++ defaultGlobalFlags
getFlag MkFlag {..} = getFlag MkFlag {..} =
(flagName, fromMaybe flagDefault $ lookup flagName overrides) (flagName, fromMaybe flagDefault $ lookup flagName overrides)
flags = mapFromList $ map getFlag $ genPackageFlags gpd
desc <- getFlattenedComponent desc <- getFlattenedComponent
CheckCond CheckCond
{ ccPackageName = name { ccPackageName = name
@ -267,7 +268,7 @@ mkPackageBuild gpd = do
, ccArch = Distribution.System.X86_64 , ccArch = Distribution.System.X86_64
, ccCompilerFlavor = Distribution.Compiler.GHC , ccCompilerFlavor = Distribution.Compiler.GHC
, ccCompilerVersion = ghcVerCabal , ccCompilerVersion = ghcVerCabal
, ccFlags = mapFromList $ map getFlag $ genPackageFlags gpd , ccFlags = flags
} }
(tryBuildTest name) (tryBuildTest name)
(tryBuildBenchmark name) (tryBuildBenchmark name)
@ -277,7 +278,7 @@ mkPackageBuild gpd = do
, pbMaintainer = fmap snd $ lookup name $ pcPackages defaultPackageConstraints , pbMaintainer = fmap snd $ lookup name $ pcPackages defaultPackageConstraints
, pbGithubPings = getGithubPings gpd , pbGithubPings = getGithubPings gpd
, pbUsers = mempty -- must be filled in later , pbUsers = mempty -- must be filled in later
, pbFlags = packageFlags name , pbFlags = flags
, pbTestState = , pbTestState =
case () of case () of
() ()

11
Stackage2/CheckBuildPlan.hs
View File

@ -38,9 +38,10 @@ checkDeps allPackages (user, pb) =
(dep, Just version) (dep, Just version)
errMap errMap
where where
errMap = singletonMap user range errMap = singletonMap (user, pbVersion pb) range
newtype BadBuildPlan = BadBuildPlan (Map (PackageName, Maybe Version) (Map PackageName VersionRange)) -- FIXME add maintainer and Github ping info newtype BadBuildPlan =
BadBuildPlan (Map (PackageName, Maybe Version) (Map (PackageName, Version) VersionRange)) -- FIXME add maintainer and Github ping info
deriving Typeable deriving Typeable
instance Exception BadBuildPlan instance Exception BadBuildPlan
instance Show BadBuildPlan where instance Show BadBuildPlan where
@ -60,10 +61,12 @@ instance Show BadBuildPlan where
, " depended on by:" , " depended on by:"
] ]
showUser :: (PackageName, VersionRange) -> String showUser :: ((PackageName, Version), VersionRange) -> String
showUser (user, range) = concat showUser ((user, version), range) = concat
[ "- " [ "- "
, display user , display user
, "-"
, display version
, " (" , " ("
, display range , display range
, ")" , ")"