From 63cf1c27b75f3e9b99f58fd159f508e9191f8c94 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Tue, 9 Jun 2026 16:24:06 +0800 Subject: [PATCH 1/5] cabal-install: stage-qualified package configuration (package build:*) Add `package :*` project-file stanzas (e.g. `package build:*`, `package host:*`) so per-package configuration can target a single build stage. The same package can be built in both the build and host stages, so `package *`, top-level fields and `package ` cannot distinguish them; a stage qualifier can. - ProjectConfig gains projectConfigStagePackages :: MapMappend Stage PackageConfig (+ lens, parsec parser and field grammar). The legacy parser does not support the new syntax. - Per-package option lookup and the shared/profiling-lib downward-closed property in ProjectPlanning are made stage-aware, so e.g. `package build:* shared: False` keeps the build stage static even when the host stage is built dynamic. - Add a parser test (project-config-stage-packages). Co-Authored-By: Claude Opus 4.8 (1M context) --- .../parser-tests/Tests/ParserTests.hs | 38 +++++ .../cabal.project | 6 + .../Client/ProjectConfig/FieldGrammar.hs | 4 +- .../Client/ProjectConfig/Legacy.hs | 2 + .../Distribution/Client/ProjectConfig/Lens.hs | 5 + .../Client/ProjectConfig/Parsec.hs | 18 ++- .../Client/ProjectConfig/Types.hs | 7 + .../Distribution/Client/ProjectPlanning.hs | 137 ++++++++++++------ .../Distribution/Client/ProjectConfig.hs | 2 + 9 files changed, 168 insertions(+), 51 deletions(-) create mode 100644 cabal-install/parser-tests/Tests/files/project-config-stage-packages/cabal.project diff --git a/cabal-install/parser-tests/Tests/ParserTests.hs b/cabal-install/parser-tests/Tests/ParserTests.hs index 63a73c9bfea..11265787340 100644 --- a/cabal-install/parser-tests/Tests/ParserTests.hs +++ b/cabal-install/parser-tests/Tests/ParserTests.hs @@ -37,6 +37,7 @@ import Distribution.Simple.InstallDirs (InstallDirs (..), toPathTemplate) import Distribution.Simple.Setup (DumpBuildInfo (..), HaddockTarget (..), TestShowDetails (..)) import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..)) import Distribution.Solver.Types.ProjectConfigPath (ProjectConfigPath (..)) +import Distribution.Solver.Types.Stage (Stage (..)) import Distribution.Solver.Types.Settings ( AllowBootLibInstalls (..) , CountConflicts (..) @@ -84,6 +85,7 @@ parserTests = , testCase "read project-config-local-packages" testProjectConfigLocalPackages , testCase "read project-config-all-packages" testProjectConfigAllPackages , testCase "read project-config-specific-packages" testProjectConfigSpecificPackages + , testCase "read project-config-stage-packages" testProjectConfigStagePackages , testCase "test projectConfigAllPackages concatenation" testAllPackagesConcat , testCase "test projectConfigSpecificPackages concatenation" testSpecificPackagesConcat , testCase "test program-locations concatenation" testProgramLocationsConcat @@ -438,6 +440,30 @@ testProjectConfigSpecificPackages = do { packageConfigSharedLib = Flag True } +testProjectConfigStagePackages :: Assertion +testProjectConfigStagePackages = do + -- The legacy parser does not support stage-qualified package stanzas (it + -- would reject the @build:*@ argument), so we read with the parsec parser + -- only rather than 'readConfigDefault', which also runs the legacy parser. + config <- readConfigParsec "project-config-stage-packages" + assertEqual + "Parsed Config does not match expected" + expected + (projectConfigStagePackages (snd (condTreeData config))) + where + expected = MapMappend $ Map.fromList [(Build, expectedBuild), (Host, expectedHost)] + expectedBuild :: PackageConfig + expectedBuild = + mempty + { packageConfigSharedLib = Flag False + , packageConfigDynExe = Flag False + } + expectedHost :: PackageConfig + expectedHost = + mempty + { packageConfigSharedLib = Flag True + } + testAllPackagesConcat :: Assertion testAllPackagesConcat = do (config, legacy) <- readConfigDefault "all-packages-concat" @@ -566,6 +592,18 @@ verbosity = mkVerbosity defaultVerbosityHandles normal readConfigDefault :: FilePath -> IO (ProjectConfigSkeleton, ProjectConfigSkeleton) readConfigDefault testSubDir = readConfig testSubDir "cabal.project" +-- | Read a project config using the parsec parser only. Useful for syntax the +-- legacy parser does not support (e.g. stage-qualified package stanzas). +readConfigParsec :: FilePath -> IO ProjectConfigSkeleton +readConfigParsec testSubDir = do + (TestDir testRootFp projectConfigFp distDirLayout) <- testDirInfo testSubDir "cabal.project" + exists <- liftIO $ doesFileExist projectConfigFp + assertBool ("projectConfig does not exist: " <> projectConfigFp) exists + httpTransport <- liftIO $ configureTransport verbosity [] Nothing + liftIO $ + runRebuild testRootFp $ + readProjectFileSkeletonParsec verbosity httpTransport distDirLayout "" "" + readConfig :: FilePath -> FilePath -> IO (ProjectConfigSkeleton, ProjectConfigSkeleton) readConfig testSubDir projectFileName = do (TestDir testRootFp projectConfigFp distDirLayout) <- testDirInfo testSubDir projectFileName diff --git a/cabal-install/parser-tests/Tests/files/project-config-stage-packages/cabal.project b/cabal-install/parser-tests/Tests/files/project-config-stage-packages/cabal.project new file mode 100644 index 00000000000..2bf82caa5c5 --- /dev/null +++ b/cabal-install/parser-tests/Tests/files/project-config-stage-packages/cabal.project @@ -0,0 +1,6 @@ +package build:* + shared: False + executable-dynamic: False + +package host:* + shared: True diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs b/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs index 1422900fdd0..de5124c19ab 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs @@ -44,8 +44,10 @@ projectConfigFieldGrammar source knownPrograms = <*> blurFieldGrammar L.projectConfigLocalPackages (packageConfigFieldGrammar knownPrograms) -- \^ PackageConfig to be applied to locally built packages, specified not inside a stanza <*> pure mempty - where -- \^ PackageConfig applied to explicitly named packages + <*> pure mempty + -- \^ PackageConfig applied to all packages of a given stage ('package build:*' etc.) + where provenance = Set.singleton (Explicit source) formatPackageVersionConstraints :: [PackageVersionConstraint] -> List CommaVCat (Identity PackageVersionConstraint) PackageVersionConstraint diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 692fd8ff982..dc98620cd08 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -644,6 +644,8 @@ convertLegacyProjectConfig , projectConfigAllPackages = configAllPackages , projectConfigLocalPackages = configLocalPackages , projectConfigSpecificPackage = fmap perPackage legacySpecificConfig + , -- The legacy parser does not support stage-qualified package stanzas. + projectConfigStagePackages = mempty } where configAllPackages = convertLegacyPerPackageFlags g i h t b diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs index fcbdbcbae88..111593695b6 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs @@ -60,6 +60,7 @@ import Distribution.Solver.Types.Settings , ReorderGoals (..) , StrongFlags (..) ) +import Distribution.Solver.Types.Stage (Stage) import Distribution.Types.PackageVersionConstraint ( PackageVersionConstraint ) @@ -109,6 +110,10 @@ projectConfigSpecificPackage :: Lens' ProjectConfig (MapMappend PackageName Pack projectConfigSpecificPackage f s = fmap (\x -> s{T.projectConfigSpecificPackage = x}) (f (T.projectConfigSpecificPackage s)) {-# INLINEABLE projectConfigSpecificPackage #-} +projectConfigStagePackages :: Lens' ProjectConfig (MapMappend Stage PackageConfig) +projectConfigStagePackages f s = fmap (\x -> s{T.projectConfigStagePackages = x}) (f (T.projectConfigStagePackages s)) +{-# INLINEABLE projectConfigStagePackages #-} + projectConfigVerbosity :: Lens' ProjectConfigBuildOnly (Flag VerbosityFlags) projectConfigVerbosity f s = fmap (\x -> s{T.projectConfigVerbosity = x}) (f (T.projectConfigVerbosity s)) {-# INLINEABLE projectConfigVerbosity #-} diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs index 0576186de29..d0b68a7dd56 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs @@ -42,6 +42,7 @@ import Distribution.Simple.Program.Types (programName) import Distribution.Simple.Setup import Distribution.Simple.Utils (debug, noticeDoc) import Distribution.Solver.Types.ProjectConfigPath +import Distribution.Solver.Types.Stage (Stage) import Distribution.System (buildOS) import Distribution.Types.CondTree (CondBranch (..), CondTree (..)) import Distribution.Types.ConfVar (ConfVar (..)) @@ -284,8 +285,11 @@ parseSection programDb (MkSection (Name pos name) args secFields) Just (SpecificPackage packageName) -> do packageCfg <- parsePackageConfig stateConfig . L.projectConfigSpecificPackage %= (<> MapMappend (Map.singleton packageName packageCfg)) + Just (AllStagePackages stage) -> do + packageCfg <- parsePackageConfig + stateConfig . L.projectConfigStagePackages %= (<> MapMappend (Map.singleton stage packageCfg)) Nothing -> do - lift $ parseWarning pos PWTUnknownSection "target package name or * required" + lift $ parseWarning pos PWTUnknownSection "target package name, '*', or ':*' required" return () | otherwise = do warnInvalidSubsection pos name @@ -345,7 +349,7 @@ parseRepoName pos args = case args of return Nothing Right name -> return $ Just name -data PackageConfigTarget = AllPackages | SpecificPackage !PackageName +data PackageConfigTarget = AllPackages | AllStagePackages !Stage | SpecificPackage !PackageName parsePackageName :: Position -> [SectionArg Position] -> ParseResult src (Maybe PackageConfigTarget) parsePackageName pos args = case args of @@ -356,12 +360,18 @@ parsePackageName pos args = case args of where parseName secName = case runParsecParser parser "" (fieldLineStreamFromBS secName) of Left _ -> do - parseFailure pos ("Invalid package name" ++ fromUTF8BS secName) + parseFailure pos ("Invalid 'package' target (expected a package name, '*', or ':*'): " ++ fromUTF8BS secName) return Nothing Right cfgTarget -> return $ pure cfgTarget parser :: ParsecParser PackageConfigTarget parser = - P.choice [P.try (P.char '*' >> return AllPackages), SpecificPackage <$> parsec] + P.choice + [ P.try (P.char '*' >> return AllPackages) + , -- A stage qualifier, e.g. @build:*@ or @host:*@, applies the + -- package configuration to all packages built for that stage. + P.try (AllStagePackages <$> parsec <* P.char ':' <* P.char '*') + , SpecificPackage <$> parsec + ] -- | Parse fields of a program-options stanza. parseProgramArgs :: ProgramDb -> Fields Position -> ParseResult src (MapMappend String [String]) diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs index e2c36da813f..0a519755be2 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs @@ -57,6 +57,7 @@ import Distribution.Client.CmdInstall.ClientInstallFlags ) import Distribution.Solver.Types.ConstraintSource +import Distribution.Solver.Types.Stage (Stage) import Distribution.Solver.Types.Settings import Distribution.Package @@ -155,6 +156,12 @@ data ProjectConfig = ProjectConfig -- ^ Configuration to be applied to *local* packages; i.e., -- any packages which are explicitly named in `cabal.project`. , projectConfigSpecificPackage :: MapMappend PackageName PackageConfig + , projectConfigStagePackages :: MapMappend Stage PackageConfig + -- ^ Configuration to be applied to all packages built for a particular + -- stage (e.g. @package build:*@ or @package host:*@). Lets a staged build + -- target the build-stage and host-stage packages independently, which + -- plain @package *@ cannot since the same package can be built in both + -- stages. } deriving (Eq, Show, Generic) diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index d1b08da787a..b84c79d42f9 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -883,6 +883,7 @@ rebuildInstallPlan , projectConfigAllPackages , projectConfigLocalPackages , projectConfigSpecificPackage + , projectConfigStagePackages , projectConfigBuildOnly } toolchains @@ -912,6 +913,7 @@ rebuildInstallPlan projectConfigAllPackages projectConfigLocalPackages (getMapMappend projectConfigSpecificPackage) + (getMapMappend projectConfigStagePackages) instantiatedPlan <- instantiateInstallPlan @@ -1512,6 +1514,7 @@ elaborateInstallPlan -> PackageConfig -> PackageConfig -> Map PackageName PackageConfig + -> Map Stage PackageConfig -> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig) elaborateInstallPlan verbosity @@ -1524,7 +1527,8 @@ elaborateInstallPlan sharedPackageConfig allPackagesConfig localPackagesConfig - perPackageConfig = do + perPackageConfig + stagePackagesConfig = do x <- elaboratedInstallPlan return (x, elaboratedSharedConfig) where @@ -2120,6 +2124,28 @@ elaborateInstallPlan elabPkgSourceId = srcpkgPackageId elabStage = solverPkgStage + + -- Per-package option lookups for this package, specialised to its + -- stage so that stage-qualified config (@package build:*@ etc.) is + -- applied. These need explicit (polymorphic) type signatures: they + -- close over 'elabStage', and with MonoLocalBinds (implied by the + -- extensions this module uses) such local bindings would not + -- otherwise generalise over their result type. + perPkgOptionFlag :: PackageId -> a -> (PackageConfig -> Flag a) -> a + perPkgOptionFlag pkgid = perPkgOptionFlagStaged elabStage pkgid + perPkgOptionMaybe :: PackageId -> (PackageConfig -> Flag a) -> Maybe a + perPkgOptionMaybe pkgid = perPkgOptionMaybeStaged elabStage pkgid + perPkgOptionList :: PackageId -> (PackageConfig -> [a]) -> [a] + perPkgOptionList pkgid = perPkgOptionListStaged elabStage pkgid + perPkgOptionNubList :: Ord a => PackageId -> (PackageConfig -> NubList a) -> [a] + perPkgOptionNubList pkgid = perPkgOptionNubListStaged elabStage pkgid + perPkgOptionMapLast :: Ord k => PackageId -> (PackageConfig -> MapLast k v) -> Map k v + perPkgOptionMapLast pkgid = perPkgOptionMapLastStaged elabStage pkgid + perPkgOptionMapMappend :: (Ord k, Semigroup v) => PackageId -> (PackageConfig -> MapMappend k v) -> Map k v + perPkgOptionMapMappend pkgid = perPkgOptionMapMappendStaged elabStage pkgid + perPkgOptionLibExeFlag :: PackageId -> a -> (PackageConfig -> Flag a) -> (PackageConfig -> Flag a) -> (a, a) + perPkgOptionLibExeFlag pkgid = perPkgOptionLibExeFlagStaged elabStage pkgid + elabToolchain = getStage toolchains elabStage elabCompiler = toolchainCompiler elabToolchain elabPlatform = toolchainPlatform elabToolchain @@ -2229,7 +2255,7 @@ elaborateInstallPlan elabBuildOptionsRaw = LBC.BuildOptions { withVanillaLib = perPkgOptionFlag srcpkgPackageId True packageConfigVanillaLib -- TODO: [required feature]: also needs to be handled recursively - , withSharedLib = srcpkgPackageId `Set.member` pkgsUseSharedLibrary elabCompiler + , withSharedLib = srcpkgPackageId `Set.member` pkgsUseSharedLibrary elabStage elabCompiler , withStaticLib = perPkgOptionFlag srcpkgPackageId False packageConfigStaticLib , withBytecodeLib = perPkgOptionFlag srcpkgPackageId False packageConfigBytecodeLib , withDynExe = @@ -2241,8 +2267,8 @@ elaborateInstallPlan , withFullyStaticExe = perPkgOptionFlag srcpkgPackageId False packageConfigFullyStaticExe , withGHCiLib = perPkgOptionFlag srcpkgPackageId False packageConfigGHCiLib -- TODO: [required feature] needs to default to enabled on windows still , withProfExe = perPkgOptionFlag srcpkgPackageId False packageConfigProf - , withProfLib = srcpkgPackageId `Set.member` pkgsUseProfilingLibrary elabCompiler - , withProfLibShared = srcpkgPackageId `Set.member` pkgsUseProfilingLibraryShared elabCompiler + , withProfLib = srcpkgPackageId `Set.member` pkgsUseProfilingLibrary elabStage elabCompiler + , withProfLibShared = srcpkgPackageId `Set.member` pkgsUseProfilingLibraryShared elabStage elabCompiler , exeCoverage = perPkgOptionFlag srcpkgPackageId False packageConfigCoverage , libCoverage = perPkgOptionFlag srcpkgPackageId False packageConfigCoverage , withOptimization = perPkgOptionFlag srcpkgPackageId NormalOptimisation packageConfigOptimization @@ -2344,40 +2370,52 @@ elaborateInstallPlan -- localPackageConfig applies to all project source packages -- perPackageConfig applies to specific named packages - perPkgOptionFlag :: PackageId -> a -> (PackageConfig -> Flag a) -> a - perPkgOptionFlag pkgid def f = fromFlagOrDefault def (lookupPerPkgOption pkgid f) + -- These helpers take the 'Stage' of the package being elaborated so that + -- stage-qualified package configuration (e.g. @package build:*@) can be + -- applied. Within 'elaborateSolverToCommon' they are re-bound to the + -- current 'elabStage' (see the local definitions there), so the many call + -- sites can keep using the un-suffixed names. + perPkgOptionFlagStaged :: Stage -> PackageId -> a -> (PackageConfig -> Flag a) -> a + perPkgOptionFlagStaged stage pkgid def f = fromFlagOrDefault def (lookupPerPkgOptionStaged stage pkgid f) - perPkgOptionMaybe :: PackageId -> (PackageConfig -> Flag a) -> Maybe a - perPkgOptionMaybe pkgid f = flagToMaybe (lookupPerPkgOption pkgid f) + perPkgOptionMaybeStaged :: Stage -> PackageId -> (PackageConfig -> Flag a) -> Maybe a + perPkgOptionMaybeStaged stage pkgid f = flagToMaybe (lookupPerPkgOptionStaged stage pkgid f) - perPkgOptionList :: PackageId -> (PackageConfig -> [a]) -> [a] - perPkgOptionList pkgid f = lookupPerPkgOption pkgid f + perPkgOptionListStaged :: Stage -> PackageId -> (PackageConfig -> [a]) -> [a] + perPkgOptionListStaged stage pkgid f = lookupPerPkgOptionStaged stage pkgid f - perPkgOptionNubList pkgid f = fromNubList (lookupPerPkgOption pkgid f) + perPkgOptionNubListStaged :: Ord a => Stage -> PackageId -> (PackageConfig -> NubList a) -> [a] + perPkgOptionNubListStaged stage pkgid f = fromNubList (lookupPerPkgOptionStaged stage pkgid f) - perPkgOptionMapLast pkgid f = getMapLast (lookupPerPkgOption pkgid f) + perPkgOptionMapLastStaged :: Ord k => Stage -> PackageId -> (PackageConfig -> MapLast k v) -> Map k v + perPkgOptionMapLastStaged stage pkgid f = getMapLast (lookupPerPkgOptionStaged stage pkgid f) - perPkgOptionMapMappend pkgid f = getMapMappend (lookupPerPkgOption pkgid f) + perPkgOptionMapMappendStaged :: (Ord k, Semigroup v) => Stage -> PackageId -> (PackageConfig -> MapMappend k v) -> Map k v + perPkgOptionMapMappendStaged stage pkgid f = getMapMappend (lookupPerPkgOptionStaged stage pkgid f) - perPkgOptionLibExeFlag pkgid def fboth flib = (exe, lib) + perPkgOptionLibExeFlagStaged :: Stage -> PackageId -> a -> (PackageConfig -> Flag a) -> (PackageConfig -> Flag a) -> (a, a) + perPkgOptionLibExeFlagStaged stage pkgid def fboth flib = (exe, lib) where exe = fromFlagOrDefault def bothflag lib = fromFlagOrDefault def (bothflag <> libflag) - bothflag = lookupPerPkgOption pkgid fboth - libflag = lookupPerPkgOption pkgid flib + bothflag = lookupPerPkgOptionStaged stage pkgid fboth + libflag = lookupPerPkgOptionStaged stage pkgid flib - lookupPerPkgOption + lookupPerPkgOptionStaged :: (Package pkg, Monoid m) - => pkg + => Stage + -> pkg -> (PackageConfig -> m) -> m - lookupPerPkgOption pkg f = + lookupPerPkgOptionStaged stage pkg f = -- This is where we merge the options from the project config that - -- apply to all packages, all project local packages, and to specific - -- named packages - global `mappend` local `mappend` perpkg + -- apply to all packages, all project local packages, all packages of + -- a given stage, and to specific named packages. Later (more specific) + -- entries override earlier ones. + global `mappend` local `mappend` stagecfg `mappend` perpkg where global = f allPackagesConfig + stagecfg = foldMap f (Map.lookup stage stagePackagesConfig) local | isProjectSourcePackage pkg = f localPackagesConfig @@ -2424,11 +2462,16 @@ elaborateInstallPlan projectSourcePackages = Set.fromList (mapMaybe isLocalUnpackedPackage localPackages) - pkgsUseSharedLibrary :: Compiler -> Set PackageId - pkgsUseSharedLibrary compiler = - packagesWithLibDepsDownwardClosedProperty (needsSharedLib compiler) + -- These are parameterised by 'Stage' so that stage-qualified package + -- configuration (@package build:*@ etc.) is honoured and so the + -- downward-closed lib-dependency closure stays within a single stage. + -- Without this a host-stage dynamic executable would drag its (same + -- 'PackageId') build-stage dependencies into the shared-lib set. + pkgsUseSharedLibrary :: Stage -> Compiler -> Set PackageId + pkgsUseSharedLibrary stage compiler = + packagesWithLibDepsDownwardClosedProperty stage (needsSharedLib stage compiler) - needsSharedLib compiler pkgid = + needsSharedLib stage compiler pkgid = fromMaybe compilerShouldUseSharedLibByDefault -- Case 1: --enable-shared or --disable-shared is passed explicitly, honour that. @@ -2449,9 +2492,9 @@ elaborateInstallPlan _ -> Nothing ) where - pkgSharedLib = perPkgOptionMaybe pkgid packageConfigSharedLib - pkgDynExe = perPkgOptionMaybe pkgid packageConfigDynExe - pkgProf = perPkgOptionMaybe pkgid packageConfigProf + pkgSharedLib = perPkgOptionMaybeStaged stage pkgid packageConfigSharedLib + pkgDynExe = perPkgOptionMaybeStaged stage pkgid packageConfigDynExe + pkgProf = perPkgOptionMaybeStaged stage pkgid packageConfigProf compilerShouldUseSharedLibByDefault = case compilerFlavor compiler of @@ -2467,16 +2510,15 @@ elaborateInstallPlan canBuildSharedLibs = canBuildWayLibs dynamicSupported canBuildProfilingSharedLibs = canBuildWayLibs profilingDynamicSupported - pkgsUseProfilingLibrary :: Compiler -> Set PackageId - pkgsUseProfilingLibrary compiler = - packagesWithLibDepsDownwardClosedProperty (needsProfilingLib compiler) + pkgsUseProfilingLibrary :: Stage -> Compiler -> Set PackageId + pkgsUseProfilingLibrary stage compiler = + packagesWithLibDepsDownwardClosedProperty stage (needsProfilingLib stage compiler) - needsProfilingLib compiler pkg = + needsProfilingLib stage compiler pkgid = fromFlagOrDefault compilerShouldUseProfilingLibByDefault (profBothFlag <> profLibFlag) where - pkgid = packageId pkg - profBothFlag = lookupPerPkgOption pkgid packageConfigProf - profLibFlag = lookupPerPkgOption pkgid packageConfigProfLib + profBothFlag = lookupPerPkgOptionStaged stage pkgid packageConfigProf + profLibFlag = lookupPerPkgOptionStaged stage pkgid packageConfigProfLib compilerShouldUseProfilingLibByDefault = case compilerFlavor compiler of @@ -2487,11 +2529,11 @@ elaborateInstallPlan canBuildProfilingLibs = canBuildWayLibs profilingVanillaSupported - pkgsUseProfilingLibraryShared :: Compiler -> Set PackageId - pkgsUseProfilingLibraryShared compiler = - packagesWithLibDepsDownwardClosedProperty (needsProfilingLibShared compiler) + pkgsUseProfilingLibraryShared :: Stage -> Compiler -> Set PackageId + pkgsUseProfilingLibraryShared stage compiler = + packagesWithLibDepsDownwardClosedProperty stage (needsProfilingLibShared stage compiler) - needsProfilingLibShared compiler pkg = + needsProfilingLibShared stage compiler pkgid = fromMaybe compilerShouldUseProfilingSharedLibByDefault -- case 1: If --enable-profiling-shared is passed explicitly, honour that @@ -2510,10 +2552,9 @@ elaborateInstallPlan _ -> Nothing ) where - pkgid = packageId pkg - profLibSharedFlag = perPkgOptionMaybe pkgid packageConfigProfShared - pkgDynExe = perPkgOptionMaybe pkgid packageConfigDynExe - pkgProf = perPkgOptionMaybe pkgid packageConfigProf + profLibSharedFlag = perPkgOptionMaybeStaged stage pkgid packageConfigProfShared + pkgDynExe = perPkgOptionMaybeStaged stage pkgid packageConfigDynExe + pkgProf = perPkgOptionMaybeStaged stage pkgid packageConfigProf compilerShouldUseProfilingSharedLibByDefault = case compilerFlavor compiler of @@ -2532,14 +2573,18 @@ elaborateInstallPlan NonSetupLibDepSolverPlanPackage (SolverInstallPlan.toList solverPlan) - packagesWithLibDepsDownwardClosedProperty :: (PackageIdentifier -> Bool) -> Set PackageIdentifier - packagesWithLibDepsDownwardClosedProperty property = + -- Only packages built for the given 'stage' are considered as roots; the + -- lib-dependency closure (which never crosses stages) then keeps the + -- result within that stage. + packagesWithLibDepsDownwardClosedProperty :: Stage -> (PackageIdentifier -> Bool) -> Set PackageIdentifier + packagesWithLibDepsDownwardClosedProperty stage property = Set.fromList . maybe [] (map packageId) $ Graph.closure libDepGraph [ Graph.nodeKey pkg | pkg <- SolverInstallPlan.toList solverPlan + , solverStage (solverId pkg) == stage , property (packageId pkg) -- just the packages that satisfy the property -- TODO: [nice to have] this does not check the config consistency, -- e.g. a package explicitly turning off profiling, but something diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index 6a68d366507..6fca4cd3d6a 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -418,6 +418,7 @@ instance Arbitrary ProjectConfig where <*> ( MapMappend . fmap getNonMEmpty . Map.fromList <$> shortListOf 3 arbitrary ) + <*> pure mempty -- projectConfigStagePackages: no round-trip coverage yet -- package entries with no content are equivalent to -- the entry not existing at all, so exclude empty @@ -449,6 +450,7 @@ instance Arbitrary ProjectConfig where (fmap getNonMEmpty x8') ) , projectConfigAllPackages = x9' + , projectConfigStagePackages = mempty } | ((x0', x1', x2', x3'), (x4', x5', x6', x7', x8', x9')) <- shrink From dc184ee6b6056dcaaac72f23a9f990ee5d22bef0 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Tue, 9 Jun 2026 17:34:21 +0800 Subject: [PATCH 2/5] fix: cover QualBase and drop redundant import for -Werror (validate) These are latent warnings that -Wincomplete-patterns / -Wunused-imports promote to errors only under validate's -Werror; they predate and are unrelated to the stage-qualified package configuration work below. Co-Authored-By: Claude Opus 4.8 (1M context) --- Cabal-described/src/Distribution/Described.hs | 2 +- cabal-install-solver/src/Distribution/Solver/Modular.hs | 2 +- .../src/Distribution/Solver/Modular/Builder.hs | 2 +- .../src/Distribution/Solver/Modular/Linking.hs | 3 +-- .../src/Distribution/Solver/Modular/Validate.hs | 1 - .../src/Distribution/Solver/Types/PackageConstraint.hs | 4 ++++ .../src/Distribution/Solver/Types/PackagePath.hs | 2 ++ 7 files changed, 10 insertions(+), 6 deletions(-) diff --git a/Cabal-described/src/Distribution/Described.hs b/Cabal-described/src/Distribution/Described.hs index 160e50ef15f..35840a96a64 100644 --- a/Cabal-described/src/Distribution/Described.hs +++ b/Cabal-described/src/Distribution/Described.hs @@ -101,7 +101,7 @@ import Distribution.Types.TestType (TestType) import Distribution.Types.UnitId (UnitId) import Distribution.Types.UnqualComponentName (UnqualComponentName) import Distribution.Utils.Path (SymbolicPath, RelativePath, FileOrDir(..), Pkg, Build) -import Distribution.Verbosity (Verbosity, VerbosityFlags) +import Distribution.Verbosity (VerbosityFlags) import Distribution.Version (Version, VersionRange) import Language.Haskell.Extension (Extension, Language, knownLanguages) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular.hs b/cabal-install-solver/src/Distribution/Solver/Modular.hs index a2ac44fcf44..fae7f4e9def 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular.hs @@ -75,7 +75,7 @@ import Distribution.Simple.Setup ( BooleanFlag(..) ) import Distribution.Simple.Utils ( ordNubBy ) -import Distribution.Verbosity ( VerbosityLevel (..), normal, verbose ) +import Distribution.Verbosity ( VerbosityLevel (..) ) -- | Ties the two worlds together: classic cabal-install vs. the modular -- solver. Performs the necessary translations before and after. diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs index 63694b0b37c..c9f1ac521c7 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs @@ -261,7 +261,7 @@ alreadyLinked = error "addLinking called on tree that already contains linked no -- | Interface to the tree builder. Just takes an index and a list of package names, -- and computes the initial state and then the tree from there. buildTree :: Index -> IndependentGoals -> [PN] -> Tree () QGoalReason -buildTree idx (IndependentGoals ind) igs = +buildTree idx (IndependentGoals _ind) igs = build Linker { buildState = BS { index = idx diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs index 3ea4f5fd5a6..f99c34a64d1 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs @@ -274,8 +274,7 @@ linkDeps target = \deps -> do (Simple (LDep _ (Pkg _ _)) _, _) -> return () requalify :: FlaggedDeps QPN -> UpdateState (FlaggedDeps QPN) - requalify deps = do - vs <- get + requalify deps = return $ qualifyDeps target (unqualifyDeps deps) pickFlag :: QFN -> Bool -> UpdateState () diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs index 3623a11d5df..f0c0566d6a1 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs @@ -201,7 +201,6 @@ validate = go svd <- asks saved -- obtain saved dependencies aComps <- asks availableComponents rComps <- asks requiredComponents - qo <- asks qualifyOptions -- obtain dependencies and index-dictated exclusions introduced by the choice let I stage _vr _loc = i let (PInfo deps comps _ mfr) = idx ! pn ! i diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs b/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs index e7525d24f29..018d0befd9e 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs @@ -94,6 +94,10 @@ constraintQualifierMatches (ScopeAnySetupQualifier pn) (QualSetup _) pn' = pn == constraintQualifierMatches (ScopeAnyExeQualifier pn) (QualExe _ _) pn' = pn == pn' constraintQualifierMatches (ScopeAnyExeQualifier _) QualToplevel _ = False constraintQualifierMatches (ScopeAnyExeQualifier _) (QualSetup _) _compile = False +-- A base-qualified dependency is never matched by a toplevel/setup/exe scope. +constraintQualifierMatches (ScopeTarget _) (QualBase _) _ = False +constraintQualifierMatches (ScopeAnySetupQualifier _) (QualBase _) _ = False +constraintQualifierMatches (ScopeAnyExeQualifier _) (QualBase _) _ = False constraintQualifierMatches (ScopeAnyQualifier pn) _ pn' = pn == pn' instance Pretty ConstraintScope where diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs b/cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs index 069e45181e0..e752c0e6092 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/PackagePath.hs @@ -64,6 +64,7 @@ instance Structured Qualifier instance Pretty Qualifier where pretty QualToplevel = Disp.text "toplevel" + pretty (QualBase pn) = pretty pn <<>> Disp.text ":base" pretty (QualSetup pn) = pretty pn <<>> Disp.text ":setup" pretty (QualExe pn pn2) = pretty pn <<>> Disp.text ":" <<>> pretty pn2 <<>> Disp.text ":exe" @@ -78,6 +79,7 @@ instance Pretty Qualifier where -- 'Base' qualifier, will always be @base@). dispQualifier :: Qualifier -> Disp.Doc dispQualifier QualToplevel = mempty +dispQualifier (QualBase pn) = pretty pn <> Disp.text "." dispQualifier (QualSetup pn) = pretty pn <> Disp.text ":setup." dispQualifier (QualExe pn pn2) = pretty pn From 39bd62aaea242dee3bd3d379d877c6d80187c0b4 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 2 Jun 2026 13:21:55 +0900 Subject: [PATCH 3/5] GHC/Build/Link: relativize absolute rpaths when --enable-relocatable depLibraryPaths returns absolute library paths whenever the dep's libdir is not under the package's own install prefix (i.e. almost always, in a cabal-store layout where each package gets its own hash-suffixed subdir). The previous getRPaths only prefixed `@loader_path` / `$ORIGIN` to already-relative paths, so those absolute store paths were baked directly into LC_RPATH (Mach-O) and DT_RUNPATH (ELF). On macOS up to and including Sonoma (macOS 14) dyld silently falls through to subsequent rpath entries when an absolute rpath does not exist. Sequoia (macOS 15) dyld treats the same condition as fatal and aborts the binary on launch. This affected the stable-haskell GHC bindist: a `/Volumes/WorkSpace/_work/ghc/ghc/ _build/stage2/store/host/aarch64-apple-darwin/lib` rpath baked in by the build runner caused `ghc --numeric-version` to SIGABRT when the bindist was installed on any macos-15 host. When the user has opted into relocatable mode (`--enable-relocatable`, or `relocatable: True` in a cabal project), this commit replaces such absolute rpaths with a `shortRelativePath`-computed relative form against the artifact's install directory. The relative form is well-formed (no `/Volumes` prefix to abort dyld on), and harmless when the bindist layout no longer matches the build store (dyld treats it as a normal missing rpath and falls through to subsequent entries). Non-relocatable builds (the default) are unchanged: absolute paths still pass through to preserve the existing semantics for non-relocated installs. The PackageDescription, InstallDirs, and shortRelativePath utility this needs are all already in scope or come from already-imported modules; only `bindir` and `libdir` field accessors are pulled in freshly from `Distribution.Simple.InstallDirs`. Companion to commit 010b365582c in stable-haskell/ghc, which strips the same leaked rpaths post-build with `install_name_tool` while this Cabal-side fix propagates through bindist rebuilds. --- .../src/Distribution/Simple/GHC/Build/Link.hs | 42 ++++++++++++++++++- 1 file changed, 41 insertions(+), 1 deletion(-) diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs index ac1067764f8..86ab3a6178a 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs @@ -55,6 +55,8 @@ import System.FilePath , replaceExtension ) +import Distribution.Simple.InstallDirs (bindir, libdir) + -- | Links together the object files of the Haskell modules and extra sources -- using the context in which the component is being built. -- @@ -624,7 +626,45 @@ getRPaths pbci = do let hostPref = case hostOS of OSX -> "@loader_path" _ -> "$ORIGIN" - relPath p = if isRelative p then hostPref p else p + -- The artifact's eventual install directory; absolute rpaths are + -- expressed as `@loader_path`/`$ORIGIN`-relative to this when the + -- user has opted into relocatable mode (`relocatable: True` or + -- `--enable-relocatable`). + -- + -- Mirrors the executable/library split in + -- 'Distribution.Simple.LocalBuildInfo.depLibraryPaths'. + installDirs = absoluteComponentInstallDirs + (localPkgDescr lbi) lbi (componentUnitId clbi) NoCopyDest + isExe = case clbi of + ExeComponentLocalBuildInfo{} -> True + _ -> False + relDir + | isExe = bindir installDirs + | otherwise = libdir installDirs + -- Convert an rpath entry to its loader-relative form. + -- + -- * Already-relative paths get the `@loader_path` / `$ORIGIN` + -- prefix as before. + -- * Absolute paths normally pass through unchanged. In + -- `relocatable` mode we replace them with a relative-form + -- expression (`@loader_path/../../...`) computed against the + -- binary's install dir, so the resulting binary does not bake + -- a build-host absolute path into LC_RPATH / DT_RUNPATH. + -- + -- This matters on macOS 15 (Sequoia), whose dyld treats an + -- unresolvable absolute rpath as fatal — older dyld silently + -- falls through to subsequent rpath entries. Pre-fix, a + -- bindist produced under e.g. + -- `/Volumes/WorkSpace/_work/ghc/ghc/_build/stage2/store/...` + -- would abort-trap on launch when relocated off the build + -- host. Post-fix, the same entry becomes + -- `@loader_path/../..//lib`, which dyld treats + -- as a normal missing-directory rpath when the bindist + -- layout no longer matches the store layout. + relPath p + | isRelative p = hostPref p + | relocatable lbi = hostPref shortRelativePath relDir p + | otherwise = p rpaths = toNubListR (map relPath libraryPaths) <> toNubListR (map getSymbolicPath $ extraLibDirs bi) From e7941cdb7acf54e27f247023de1f9b496db0bda7 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 2 Jun 2026 14:02:48 +0900 Subject: [PATCH 4/5] GHC/Build/Link: drop the relocatable gate, always relativize abs rpaths MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Initial version of this fix gated the new relativization on `relocatable lbi` to keep non-relocatable builds byte-identical. The gate doesn't help in practice: * the stable-haskell GHC bindist build requires the new behavior (else the darwin host binaries abort-trap on macOS 15); * setting `relocatable: True` to flip the gate also triggers `checkRelocatable` (which refuses cabal-store layouts whose deps live in sibling prefixes) and changes how `library-dirs` are written into .conf files — neither change is desirable for the rpath fix, and the latter actively breaks the bindist post-stage2 .conf rewriting in our Makefile pipeline. The new always-on behavior is a strict improvement for every relocatable scenario (cabal-store relocation, bindist relocation, nix-style closure moves) and only a theoretical regression for the "copy a single executable to an unrelated host and expect the same absolute path to still resolve" case, which has never been part of cabal's documented contract. Companion to stable-haskell/ghc commit that drops the matching `relocatable: True` flag from configure.ac. --- .../src/Distribution/Simple/GHC/Build/Link.hs | 21 ++++++++++++------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs index 86ab3a6178a..feca1864502 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs @@ -645,11 +645,10 @@ getRPaths pbci = do -- -- * Already-relative paths get the `@loader_path` / `$ORIGIN` -- prefix as before. - -- * Absolute paths normally pass through unchanged. In - -- `relocatable` mode we replace them with a relative-form - -- expression (`@loader_path/../../...`) computed against the - -- binary's install dir, so the resulting binary does not bake - -- a build-host absolute path into LC_RPATH / DT_RUNPATH. + -- * Absolute paths are rewritten to a relative-form expression + -- (`@loader_path/../../...`) computed against the binary's + -- install dir, so the resulting binary does not bake a + -- build-host absolute path into LC_RPATH / DT_RUNPATH. -- -- This matters on macOS 15 (Sequoia), whose dyld treats an -- unresolvable absolute rpath as fatal — older dyld silently @@ -661,10 +660,16 @@ getRPaths pbci = do -- `@loader_path/../..//lib`, which dyld treats -- as a normal missing-directory rpath when the bindist -- layout no longer matches the store layout. + -- + -- Not gated on `relocatable lbi`: that flag also triggers + -- `checkRelocatable` (which refuses cabal-store layouts + -- where deps live in sibling prefixes) and changes how + -- library-dirs are emitted in .conf files. Both behaviors + -- are independent of rpath generation and incompatible with + -- the stable-haskell GHC bindist assembly pipeline. relPath p - | isRelative p = hostPref p - | relocatable lbi = hostPref shortRelativePath relDir p - | otherwise = p + | isRelative p = hostPref p + | otherwise = hostPref shortRelativePath relDir p rpaths = toNubListR (map relPath libraryPaths) <> toNubListR (map getSymbolicPath $ extraLibDirs bi) From 5c097860ce63094213d41d20bc13be409dc07b4d Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 14 Jun 2026 21:12:18 +0900 Subject: [PATCH 5/5] GHC/Build/Link: include $ORIGIN/@loader_path in rpaths (musl sibling deps) The rpath relativization (added for the darwin LC_RPATH-leak fix) never adds the artifact's own directory to the runpath. depLibraryPaths can return the parent directory for a dependency installed in the same directory as the artifact, so that entry relativizes to "$ORIGIN/.." and the dependency is left unfound. glibc papers over this because GHC sets LD_LIBRARY_PATH at runtime before dlopen and glibc re-reads it per dlopen; musl reads LD_LIBRARY_PATH only at process startup and ignores the runtime change, so the missing self-rpath is fatal there. Concretely, a Backpack signature implementation (libHSp) installed next to the instantiated unit (libHSindef) fails to load under musl (GHC testsuite backpack/cabal/T14304 on Alpine), though it passes on every glibc platform. Always prepend the loader-relative self directory ($ORIGIN, or @loader_path on macOS) to the rpaths so a same-directory sibling is found. This is a relative entry, so it does not reintroduce the absolute build-host path the relativization removed (no macOS regression). --- Cabal/src/Distribution/Simple/GHC/Build/Link.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs index feca1864502..12f7d8914f2 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs @@ -671,7 +671,18 @@ getRPaths pbci = do | isRelative p = hostPref p | otherwise = hostPref shortRelativePath relDir p rpaths = - toNubListR (map relPath libraryPaths) + -- Always search the artifact's own directory ($ORIGIN / + -- @loader_path) first, so a sibling library installed alongside it + -- is found by the dynamic loader. depLibraryPaths can yield the + -- parent directory for a same-directory dependency (relativized to + -- "$ORIGIN/.."), which leaves the dependency unfound. glibc papers + -- over this via the runtime LD_LIBRARY_PATH GHC sets before + -- dlopen, but musl reads LD_LIBRARY_PATH only at process startup, + -- so the missing self-rpath is fatal there: a Backpack signature + -- implementation (libHSp) installed next to the instantiated unit + -- (libHSindef) fails to load (testsuite T14304 on Alpine/musl). + toNubListR [hostPref] + <> toNubListR (map relPath libraryPaths) <> toNubListR (map getSymbolicPath $ extraLibDirs bi) return rpaths else return mempty