From 47ffcdb741f9b67fcfd6c6607c0df853878c8e63 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Tue, 11 Apr 2023 10:57:57 +0100 Subject: [PATCH] Add --promised-dependency flag to Cabal ./Setup configure interface It is necessary to modify `./Setup configure` to allow users to configure a package *without* having previously built the dependency. Instead, we promise to the configure phase that we will have built it by the time we build the package. This allows us to configure all the packages we intend to load into the repl without building any dependenices which we will load in the same session, because the promise is satisifed due to loading the package and it's dependency into one multi-session which ensures the dependency is built before it is needed. A user of ./Setup configure specifies a promised dependency by using the "--promised-dependency" flag with a normal dependency specification. For example: ``` '--promised-dependency=cabal-install-solver=cabal-install-solver-3.9.0.0-inplace' ``` --- Cabal/src/Distribution/Backpack/Configure.hs | 30 ++++++++-- .../Backpack/ConfiguredComponent.hs | 24 ++++---- .../Distribution/Backpack/LinkedComponent.hs | 41 ++++++++++--- .../Backpack/PreExistingComponent.hs | 16 +++++ Cabal/src/Distribution/Simple/Configure.hs | 58 +++++++++++++++---- Cabal/src/Distribution/Simple/GHC.hs | 4 +- Cabal/src/Distribution/Simple/GHC/Internal.hs | 27 ++++++--- Cabal/src/Distribution/Simple/GHCJS.hs | 4 +- Cabal/src/Distribution/Simple/Setup/Config.hs | 30 ++++++++-- .../src/Distribution/Types/LocalBuildInfo.hs | 3 + .../src/Distribution/Client/Config.hs | 1 + .../Client/ProjectConfig/Legacy.hs | 2 + .../Distribution/Client/ProjectPlanning.hs | 5 +- .../src/Distribution/Client/Setup.hs | 19 ++++-- changelog.d/pr-8726-2 | 24 ++++++++ doc/setup-commands.rst | 10 ++++ 16 files changed, 239 insertions(+), 59 deletions(-) create mode 100644 changelog.d/pr-8726-2 diff --git a/Cabal/src/Distribution/Backpack/Configure.hs b/Cabal/src/Distribution/Backpack/Configure.hs index 60764fdf32d..cfa96285407 100644 --- a/Cabal/src/Distribution/Backpack/Configure.hs +++ b/Cabal/src/Distribution/Backpack/Configure.hs @@ -46,6 +46,7 @@ import Distribution.Verbosity import qualified Distribution.Compat.Graph as Graph import Distribution.Compat.Graph (Graph, IsNode(..)) import Distribution.Utils.LogProgress +import Distribution.Backpack.ModuleShape import Data.Either ( lefts ) @@ -66,7 +67,7 @@ configureComponentLocalBuildInfos -> Flag String -- configIPID -> Flag ComponentId -- configCID -> PackageDescription - -> [PreExistingComponent] + -> ([PreExistingComponent], [PromisedComponent]) -> FlagAssignment -- configConfigurationsFlags -> [(ModuleName, Module)] -- configInstantiateWith -> InstalledPackageIndex @@ -74,7 +75,7 @@ configureComponentLocalBuildInfos -> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex) configureComponentLocalBuildInfos verbosity use_external_internal_deps enabled deterministic ipid_flag cid_flag pkg_descr - prePkgDeps flagAssignment instantiate_with installedPackageSet comp = do + (prePkgDeps, promisedPkgDeps) flagAssignment instantiate_with installedPackageSet comp = do -- NB: In single component mode, this returns a *single* component. -- In this graph, the graph is NOT closed. graph0 <- case mkComponentsGraph enabled pkg_descr of @@ -92,6 +93,10 @@ configureComponentLocalBuildInfos ann_cname = pc_compname pkg })) | pkg <- prePkgDeps] + `Map.union` + Map.fromListWith Map.union + [ (pkg, Map.singleton (ann_cname aid) aid) + | PromisedComponent pkg aid <- promisedPkgDeps] graph1 <- toConfiguredComponents use_external_internal_deps flagAssignment deterministic ipid_flag cid_flag pkg_descr @@ -102,13 +107,19 @@ configureComponentLocalBuildInfos let shape_pkg_map = Map.fromList [ (pc_cid pkg, (pc_open_uid pkg, pc_shape pkg)) | pkg <- prePkgDeps] + `Map.union` + Map.fromList + [ (ann_id aid, (DefiniteUnitId (unsafeMkDefUnitId + (mkUnitId (unComponentId (ann_id aid) ))) + , emptyModuleShape)) + | PromisedComponent _ aid <- promisedPkgDeps] uid_lookup def_uid | Just pkg <- PackageIndex.lookupUnitId installedPackageSet uid = FullUnitId (Installed.installedComponentId pkg) (Map.fromList (Installed.instantiatedWith pkg)) | otherwise = error ("uid_lookup: " ++ prettyShow uid) where uid = unDefUnitId def_uid - graph2 <- toLinkedComponents verbosity uid_lookup + graph2 <- toLinkedComponents verbosity (not (null promisedPkgDeps)) uid_lookup (package pkg_descr) shape_pkg_map graph1 infoProgress $ @@ -129,7 +140,7 @@ configureComponentLocalBuildInfos infoProgress $ hang (text "Ready component graph:") 4 (vcat (map dispReadyComponent graph4)) - toComponentLocalBuildInfos comp installedPackageSet pkg_descr prePkgDeps graph4 + toComponentLocalBuildInfos comp installedPackageSet promisedPkgDeps pkg_descr prePkgDeps graph4 ------------------------------------------------------------------------------ -- ComponentLocalBuildInfo @@ -138,13 +149,14 @@ configureComponentLocalBuildInfos toComponentLocalBuildInfos :: Compiler -> InstalledPackageIndex -- FULL set + -> [PromisedComponent] -> PackageDescription -> [PreExistingComponent] -- external package deps -> [ReadyComponent] -> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex) -- only relevant packages toComponentLocalBuildInfos - comp installedPackageSet pkg_descr externalPkgDeps graph = do + comp installedPackageSet promisedPkgDeps pkg_descr externalPkgDeps graph = do -- Check and make sure that every instantiated component exists. -- We have to do this now, because prior to linking/instantiating -- we don't actually know what the full set of 'UnitId's we need @@ -178,9 +190,15 @@ toComponentLocalBuildInfos -- packageDependsIndex = PackageIndex.fromList (lefts local_graph) fullIndex = Graph.fromDistinctList local_graph + case Graph.broken fullIndex of [] -> return () - broken -> + -- If there are promised dependencies, we don't know what the dependencies + -- of these are and that can easily lead to a broken graph. So assume that + -- any promised package is not broken (ie all its dependencies, transitively, + -- will be there). That's a promise. + broken | not (null promisedPkgDeps) -> return () + | otherwise -> -- TODO: ppr this dieProgress . text $ "The following packages are broken because other" diff --git a/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs b/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs index 5f40fc6085a..a061637b125 100644 --- a/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs +++ b/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs @@ -177,22 +177,22 @@ toConfiguredComponent pkg_descr this_cid lib_dep_map exe_dep_map component = do if newPackageDepsBehaviour pkg_descr then fmap concat $ forM (targetBuildDepends bi) $ \(Dependency name _ sublibs) -> do - pkg <- case Map.lookup name lib_dep_map of + case Map.lookup name lib_dep_map of Nothing -> dieProgress $ text "Dependency on unbuildable" <+> text "package" <+> pretty name - Just p -> return p - -- Return all library components - forM (NonEmptySet.toList sublibs) $ \lib -> - let comp = CLibName lib in - case Map.lookup comp pkg of - Nothing -> - dieProgress $ - text "Dependency on unbuildable" <+> - text (showLibraryName lib) <+> - text "from" <+> pretty name - Just v -> return v + Just pkg -> do + -- Return all library components + forM (NonEmptySet.toList sublibs) $ \lib -> + let comp = CLibName lib in + case Map.lookup comp pkg of + Nothing -> + dieProgress $ + text "Dependency on unbuildable" <+> + text (showLibraryName lib) <+> + text "from" <+> pretty name + Just v -> return v else return old_style_lib_deps mkConfiguredComponent pkg_descr this_cid diff --git a/Cabal/src/Distribution/Backpack/LinkedComponent.hs b/Cabal/src/Distribution/Backpack/LinkedComponent.hs index 797fef251ac..7317435035d 100644 --- a/Cabal/src/Distribution/Backpack/LinkedComponent.hs +++ b/Cabal/src/Distribution/Backpack/LinkedComponent.hs @@ -114,12 +114,13 @@ instance Package LinkedComponent where toLinkedComponent :: Verbosity + -> Bool -- ^ Whether there are any "promised" package dependencies which we won't find already installed. -> FullDb -> PackageId -> LinkedComponentMap -> ConfiguredComponent -> LogProgress LinkedComponent -toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent { +toLinkedComponent verbosity anyPromised db this_pid pkg_map ConfiguredComponent { cc_ann_id = aid@AnnotatedId { ann_id = this_cid }, cc_component = component, cc_exe_deps = exe_deps, @@ -276,9 +277,14 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent { case filter (\x' -> unWithSource x /= unWithSource x') xs of [] -> return () _ -> Left $ ambiguousReexportMsg reex x xs - return (to, unWithSource x) + return (to, Just (unWithSource x)) _ -> - Left (brokenReexportMsg reex) + -- Can't resolve it right now.. carry on with the assumption it will be resolved + -- dynamically later by an in-memory package which hasn't been installed yet. + if anyPromised + then return (to, Nothing) + -- But if nothing is promised, eagerly report an error, as we already know everything. + else Left (brokenReexportMsg reex) -- TODO: maybe check this earlier; it's syntactically obvious. let build_reexports m (k, v) @@ -289,8 +295,27 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent { provs <- foldM build_reexports Map.empty $ -- TODO: doublecheck we have checked for -- src_provs duplicates already! - [ (mod_name, OpenModule this_uid mod_name) | mod_name <- src_provs ] ++ - reexports_list + -- These are normal module exports. + [ (mod_name, (OpenModule this_uid mod_name)) | mod_name <- src_provs ] + ++ + -- These are reexports, which we managed to resolve to something in an external package. + [(mn_new, om) | (mn_new, Just om) <- reexports_list ] + ++ + -- These ones.. we didn't resolve but also we might not have to + -- resolve them because they could come from a promised unit, + -- which we don't know anything about yet. GHC will resolve + -- these itself when it is dealing with the multi-session. + -- These ones will not be built, registered and put + -- into a package database, we only need them to make it as far + -- as generating GHC options where the info will be used to + -- pass the reexported-module option to GHC. + + -- We also know that in the case there are promised units that + -- we will not be doing anything to do with backpack like + -- unification etc.. + [ (mod_name, OpenModule (DefiniteUnitId (unsafeMkDefUnitId + (mkUnitId "fake"))) mod_name) + | (mod_name, Nothing) <- reexports_list ] let final_linked_shape = ModuleShape provs (Map.keysSet (modScopeRequires linked_shape)) @@ -337,12 +362,14 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent { -- every ComponentId gets converted into a UnitId by way of SimpleUnitId. toLinkedComponents :: Verbosity + -> Bool -- ^ Whether there are any "promised" package dependencies which we won't + -- find already installed. -> FullDb -> PackageId -> LinkedComponentMap -> [ConfiguredComponent] -> LogProgress [LinkedComponent] -toLinkedComponents verbosity db this_pid lc_map0 comps +toLinkedComponents verbosity anyPromised db this_pid lc_map0 comps = fmap snd (mapAccumM go lc_map0 comps) where go :: Map ComponentId (OpenUnitId, ModuleShape) @@ -350,7 +377,7 @@ toLinkedComponents verbosity db this_pid lc_map0 comps -> LogProgress (Map ComponentId (OpenUnitId, ModuleShape), LinkedComponent) go lc_map cc = do lc <- addProgressCtx (text "In the stanza" <+> text (componentNameStanza (cc_name cc))) $ - toLinkedComponent verbosity db this_pid lc_map cc + toLinkedComponent verbosity anyPromised db this_pid lc_map cc return (extendLinkedComponentMap lc lc_map, lc) type LinkedComponentMap = Map ComponentId (OpenUnitId, ModuleShape) diff --git a/Cabal/src/Distribution/Backpack/PreExistingComponent.hs b/Cabal/src/Distribution/Backpack/PreExistingComponent.hs index 2fcfdf1cc83..31bda7862a7 100644 --- a/Cabal/src/Distribution/Backpack/PreExistingComponent.hs +++ b/Cabal/src/Distribution/Backpack/PreExistingComponent.hs @@ -1,6 +1,7 @@ -- | See module Distribution.Backpack.PreExistingComponent ( PreExistingComponent(..), + PromisedComponent(..), ipiToPreExistingComponent, ) where @@ -20,6 +21,21 @@ import Distribution.Package import qualified Data.Map as Map import qualified Distribution.InstalledPackageInfo as Installed import Distribution.InstalledPackageInfo (InstalledPackageInfo) +import Distribution.Types.AnnotatedId + +-- | A /promised/ component. +-- +-- These components are promised to @configure@ but are not yet built. +-- +-- In other words this is 'PreExistingComponent' which doesn't yet exist. +-- +data PromisedComponent = PromisedComponent + { pr_pkgname :: PackageName + , pr_cid :: AnnotatedId ComponentId + } + +instance Package PromisedComponent where + packageId = packageId . pr_cid -- | Stripped down version of 'LinkedComponent' for things -- we don't need to know how to build. diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index 03a1d45973d..14e984c7dd3 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -133,6 +133,7 @@ import Distribution.Compat.Environment ( lookupEnv ) import qualified Data.Maybe as M import qualified Data.Set as Set import qualified Distribution.Compat.NonEmptySet as NES +import Distribution.Types.AnnotatedId type UseExternalInternalDeps = Bool @@ -440,6 +441,8 @@ configure (pkg_descr0, pbi) cfg = do (configDependencies cfg) installedPackageSet + let promisedDepsSet = mkPromisedDepsSet (configPromisedDependencies cfg) + -- pkg_descr: The resolved package description, that does not contain any -- conditionals, because we have an assignment for -- every flag, either picking them ourselves using a @@ -466,6 +469,7 @@ configure (pkg_descr0, pbi) cfg = do (packageName pkg_descr0) installedPackageSet internalPackageSet + promisedDepsSet requiredDepsMap) comp compPlatform @@ -501,11 +505,12 @@ configure (pkg_descr0, pbi) cfg = do -- For one it's deterministic; for two, we need to associate -- them with renamings which would require a far more complicated -- input scheme than what we have today.) - externalPkgDeps :: [PreExistingComponent] + externalPkgDeps :: ([PreExistingComponent], [PromisedComponent]) <- configureDependencies verbosity use_external_internal_deps internalPackageSet + promisedDepsSet installedPackageSet requiredDepsMap pkg_descr @@ -761,6 +766,7 @@ configure (pkg_descr0, pbi) cfg = do componentGraph = Graph.fromDistinctList buildComponents, componentNameMap = buildComponentsMap, installedPkgs = packageDependsIndex, + promisedPkgs = promisedDepsSet, pkgDescrFile = Nothing, localPkgDescr = pkg_descr', withPrograms = programDb'', @@ -844,6 +850,9 @@ configure (pkg_descr0, pbi) cfg = do where verbosity = fromFlag (configVerbosity cfg) +mkPromisedDepsSet :: [GivenComponent] -> Map (PackageName, ComponentName) ComponentId +mkPromisedDepsSet comps = Map.fromList [ ((pn, CLibName ln), cid) | GivenComponent pn ln cid <- comps ] + mkProgramDb :: ConfigFlags -> ProgramDb -> ProgramDb mkProgramDb cfg initialProgramDb = programDb where @@ -915,6 +924,7 @@ dependencySatisfiable -> PackageName -> InstalledPackageIndex -- ^ installed set -> Set LibraryName -- ^ library components + -> Map (PackageName, ComponentName) ComponentId -> Map (PackageName, ComponentName) InstalledPackageInfo -- ^ required dependencies -> (Dependency -> Bool) @@ -922,7 +932,7 @@ dependencySatisfiable use_external_internal_deps exact_config allow_private_deps - pn installedPackageSet packageLibraries requiredDepsMap + pn installedPackageSet packageLibraries promisedDeps requiredDepsMap (Dependency depName vr sublibs) | exact_config -- When we're given '--exact-configuration', we assume that all @@ -988,7 +998,10 @@ dependencySatisfiable -- cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs || pkgName (IPI.sourcePackageId ipi) == pn) maybeIPI + -- Don't check if it's visible, we promise to build it before we need it. + || promised where maybeIPI = Map.lookup (depName, CLibName lib) requiredDepsMap + promised = isJust $ Map.lookup (depName, CLibName lib) promisedDeps -- | Finalize a generic package description. The workhorse is -- 'finalizePD' but there's a bit of other nattering @@ -1090,20 +1103,21 @@ configureDependencies :: Verbosity -> UseExternalInternalDeps -> Set LibraryName + -> Map (PackageName, ComponentName) ComponentId -> InstalledPackageIndex -- ^ installed packages -> Map (PackageName, ComponentName) InstalledPackageInfo -- ^ required deps -> PackageDescription -> ComponentRequestedSpec - -> IO [PreExistingComponent] + -> IO ([PreExistingComponent], [PromisedComponent]) configureDependencies verbosity use_external_internal_deps - packageLibraries installedPackageSet requiredDepsMap pkg_descr enableSpec = do + packageLibraries promisedDeps installedPackageSet requiredDepsMap pkg_descr enableSpec = do let failedDeps :: [FailedDependency] allPkgDeps :: [ResolvedDependency] (failedDeps, allPkgDeps) = partitionEithers $ concat [ fmap (\s -> (dep, s)) <$> status | dep <- enabledBuildDepends pkg_descr enableSpec , let status = selectDependency (package pkg_descr) - packageLibraries installedPackageSet + packageLibraries promisedDeps installedPackageSet requiredDepsMap use_external_internal_deps dep ] internalPkgDeps = [ pkgid @@ -1114,6 +1128,9 @@ configureDependencies verbosity use_external_internal_deps externalPkgDeps = [ pec | (_, ExternalDependency pec) <- allPkgDeps ] + promisedPkgDeps = [ fpec + | (_, PromisedDependency fpec) <- allPkgDeps ] + when (not (null internalPkgDeps) && not (newPackageDepsBehaviour pkg_descr)) $ die' verbosity $ "The field 'build-depends: " @@ -1125,7 +1142,7 @@ configureDependencies verbosity use_external_internal_deps reportFailedDependencies verbosity failedDeps reportSelectedDependencies verbosity allPkgDeps - return externalPkgDeps + return (externalPkgDeps, promisedPkgDeps) -- | Select and apply coverage settings for the build based on the -- 'ConfigFlags' and 'Compiler'. @@ -1251,6 +1268,18 @@ data DependencyResolution -- internal dependency which we are getting from the package -- database. = ExternalDependency PreExistingComponent + + -- | A promised dependency, which doesn't yet exist, but should be provided + -- at the build time. + -- + -- We have these such that we can configure components without actually + -- building its dependencies, if these dependencies need to be built later + -- again. For example, when launching a multi-repl, + -- we need to build packages in the interactive ghci session, no matter + -- whether they have been built before. + -- Building them in the configure phase is then redundant and costs time. + | PromisedDependency PromisedComponent + -- | An internal dependency ('PackageId' should be a library name) -- which we are going to have to build. (The -- 'PackageId' here is a hack to get a modest amount of @@ -1264,6 +1293,7 @@ data FailedDependency = DependencyNotExists PackageName -- | Test for a package dependency and record the version we have installed. selectDependency :: PackageId -- ^ Package id of current package -> Set LibraryName -- ^ package libraries + -> Map (PackageName, ComponentName) ComponentId -- ^ Set of components that are promised, i.e. are not installed already. See 'PromisedDependency' for more details. -> InstalledPackageIndex -- ^ Installed packages -> Map (PackageName, ComponentName) InstalledPackageInfo -- ^ Packages for which we have been given specific deps to @@ -1272,7 +1302,7 @@ selectDependency :: PackageId -- ^ Package id of current package -- single component? -> Dependency -> [Either FailedDependency DependencyResolution] -selectDependency pkgid internalIndex installedIndex requiredDepsMap +selectDependency pkgid internalIndex promisedIndex installedIndex requiredDepsMap use_external_internal_deps (Dependency dep_pkgname vr libs) = -- If the dependency specification matches anything in the internal package @@ -1303,11 +1333,14 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap | Set.member lib internalIndex = Right $ InternalDependency $ PackageIdentifier dep_pkgname $ packageVersion pkgid + | otherwise = Left $ DependencyMissingInternal dep_pkgname lib -- We have to look it up externally do_external_external :: LibraryName -> Either FailedDependency DependencyResolution + do_external_external lib | Just cid <- Map.lookup (dep_pkgname, CLibName lib) promisedIndex = + return $ PromisedDependency (PromisedComponent dep_pkgname (AnnotatedId currentCabalId (CLibName lib) cid )) do_external_external lib = do ipi <- case Map.lookup (dep_pkgname, CLibName lib) requiredDepsMap of -- If we know the exact pkg to use, then use it. @@ -1319,6 +1352,8 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap return $ ExternalDependency $ ipiToPreExistingComponent ipi do_external_internal :: LibraryName -> Either FailedDependency DependencyResolution + do_external_internal lib | Just cid <- Map.lookup (dep_pkgname, CLibName lib) promisedIndex = + return $ PromisedDependency (PromisedComponent dep_pkgname (AnnotatedId currentCabalId (CLibName lib) cid )) do_external_internal lib = do ipi <- case Map.lookup (dep_pkgname, CLibName lib) requiredDepsMap of -- If we know the exact pkg to use, then use it. @@ -1341,7 +1376,9 @@ reportSelectedDependencies verbosity deps = | (dep, resolution) <- deps , let pkgid = case resolution of ExternalDependency pkg' -> packageId pkg' - InternalDependency pkgid' -> pkgid' ] + InternalDependency pkgid' -> pkgid' + PromisedDependency promisedComp -> packageId promisedComp + ] reportFailedDependencies :: Verbosity -> [FailedDependency] -> IO () reportFailedDependencies _ [] = return () @@ -1461,7 +1498,7 @@ interpretPackageDbFlags userInstall specificDBs = -- pick. combinedConstraints :: [PackageVersionConstraint] - -> [GivenComponent] + -> [GivenComponent] -- ^ installed dependencies -> InstalledPackageIndex -> Either String ([PackageVersionConstraint], Map (PackageName, ComponentName) InstalledPackageInfo) @@ -1490,8 +1527,7 @@ combinedConstraints constraints dependencies installedPackages = do | (pn, cname, _, Just pkg) <- dependenciesPkgInfo ] -- The dependencies along with the installed package info, if it exists - dependenciesPkgInfo :: [(PackageName, ComponentName, ComponentId, - Maybe InstalledPackageInfo)] + dependenciesPkgInfo :: [(PackageName, ComponentName, ComponentId, Maybe InstalledPackageInfo)] dependenciesPkgInfo = [ (pkgname, CLibName lname, cid, mpkg) | GivenComponent pkgname lname cid <- dependencies diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 235aff66565..46dc54fdc72 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -930,7 +930,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do -> insts _ -> [], ghcOptPackages = toNubListR $ - Internal.mkGhcOptPackages clbi , + Internal.mkGhcOptPackages mempty clbi , ghcOptLinkLibs = extraLibs libBi, ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs, ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi, @@ -964,7 +964,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do -> insts _ -> [], ghcOptPackages = toNubListR $ - Internal.mkGhcOptPackages clbi , + Internal.mkGhcOptPackages mempty clbi , ghcOptLinkLibs = extraLibs libBi, ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs } diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs index 3c348547144..87fe9cbfc39 100644 --- a/Cabal/src/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs @@ -77,12 +77,14 @@ import Distribution.Utils.Path import Language.Haskell.Extension import qualified Data.Map as Map +import qualified Data.Set as Set import qualified Data.ByteString.Lazy.Char8 as BS import System.Directory ( getDirectoryContents, getTemporaryDirectory ) import System.Environment ( getEnv ) import System.FilePath ( (), (<.>), takeExtension , takeDirectory, takeFileName) import System.IO ( hClose, hPutStrLn ) +import Distribution.Types.ComponentId (ComponentId) targetPlatform :: [(String, String)] -> Maybe Platform targetPlatform ghcInfo = platformFromTriple =<< lookup "Target platform" ghcInfo @@ -292,7 +294,7 @@ componentCcGhcOptions verbosity _implInfo lbi bi clbi odir filename = ++ [buildDir lbi dir | dir <- includeDirs bi], ghcOptHideAllPackages= toFlag True, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi, ghcOptCcOptions = (case withOptimization lbi of NoOptimisation -> [] _ -> ["-O2"]) ++ @@ -331,7 +333,7 @@ componentCxxGhcOptions verbosity _implInfo lbi bi clbi odir filename = ++ [buildDir lbi dir | dir <- includeDirs bi], ghcOptHideAllPackages= toFlag True, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi, ghcOptCxxOptions = (case withOptimization lbi of NoOptimisation -> [] _ -> ["-O2"]) ++ @@ -370,7 +372,7 @@ componentAsmGhcOptions verbosity _implInfo lbi bi clbi odir filename = ++ [buildDir lbi dir | dir <- includeDirs bi], ghcOptHideAllPackages= toFlag True, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi, ghcOptAsmOptions = (case withOptimization lbi of NoOptimisation -> [] _ -> ["-O2"]) ++ @@ -405,7 +407,7 @@ componentJsGhcOptions verbosity _implInfo lbi bi clbi odir filename = ++ [buildDir lbi dir | dir <- includeDirs bi], ghcOptHideAllPackages= toFlag True, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi, ghcOptObjDir = toFlag odir } @@ -448,7 +450,7 @@ componentGhcOptions verbosity implInfo lbi bi clbi odir = ghcOptHideAllPackages = toFlag True, ghcOptWarnMissingHomeModules = toFlag $ flagWarnMissingHomeModules implInfo, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages mempty clbi, ghcOptSplitSections = toFlag (splitSections lbi), ghcOptSplitObjs = toFlag (splitObjs lbi), ghcOptSourcePathClear = toFlag True, @@ -518,7 +520,7 @@ componentCmmGhcOptions verbosity _implInfo lbi bi clbi odir filename = [autogenComponentModulesDir lbi clbi cppHeaderName], ghcOptHideAllPackages= toFlag True, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi, ghcOptOptimisation = toGhcOptimisation (withOptimization lbi), ghcOptDebugInfo = toFlag (withDebugInfo lbi), ghcOptExtra = cmmOptions bi, @@ -571,9 +573,18 @@ getHaskellObjects _implInfo lib lbi clbi pref wanted_obj_ext allow_split_objs return [ pref ModuleName.toFilePath x <.> wanted_obj_ext | x <- allLibModules lib clbi ] -mkGhcOptPackages :: ComponentLocalBuildInfo +-- | Create the required packaged arguments, but filtering out package arguments which +-- aren't yet built, but promised. This filtering is used when compiling C/Cxx/Asm files, +-- and is a hack to avoid passing bogus `-package` arguments to GHC. The assumption being that +-- in 99% of cases we will include the right `-package` so that the C file finds the right headers. +mkGhcOptPackages :: Map (PackageName, ComponentName) ComponentId + -> ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)] -mkGhcOptPackages = componentIncludes +mkGhcOptPackages promisedPkgsMap clbi = [ i | i@(uid, _) <- componentIncludes clbi + , abstractUnitId uid `Set.notMember` promised_cids ] + where + -- Promised deps are going to be simple UnitIds + promised_cids = Set.fromList (map newSimpleUnitId (Map.elems promisedPkgsMap)) substTopDir :: FilePath -> IPI.InstalledPackageInfo -> IPI.InstalledPackageInfo substTopDir topDir ipo diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index 775948c74ac..9d824c326b5 100644 --- a/Cabal/src/Distribution/Simple/GHCJS.hs +++ b/Cabal/src/Distribution/Simple/GHCJS.hs @@ -663,7 +663,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do -> insts _ -> [], ghcOptPackages = toNubListR $ - Internal.mkGhcOptPackages clbi , + Internal.mkGhcOptPackages mempty clbi , ghcOptLinkLibs = extraLibs libBi, ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi, @@ -695,7 +695,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do -> insts _ -> [], ghcOptPackages = toNubListR $ - Internal.mkGhcOptPackages clbi , + Internal.mkGhcOptPackages mempty clbi , ghcOptLinkLibs = extraLibs libBi, ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi } diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index 1de98c0c88f..1e5db8cdb83 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -130,7 +130,14 @@ data ConfigFlags = ConfigFlags { configConstraints :: [PackageVersionConstraint], -- ^Additional constraints for -- dependencies. configDependencies :: [GivenComponent], - -- ^The packages depended on. + -- ^The packages depended on which already exist + configPromisedDependencies :: [GivenComponent], + -- ^The packages depended on which doesn't yet exist (i.e. promised). + -- Promising dependencies enables us to configure components in parallel, + -- and avoids expensive builds if they are not necessary. + -- For example, in multi-repl mode, we don't want to build dependencies that + -- are loaded into the interactive session, since we have to build them again. + configInstantiateWith :: [(ModuleName, Module)], -- ^ The requested Backpack instantiation. If empty, either this -- package does not use Backpack, or we just want to typecheck @@ -212,6 +219,7 @@ instance Eq ConfigFlags where && equal configStripLibs && equal configConstraints && equal configDependencies + && equal configPromisedDependencies && equal configConfigurationsFlags && equal configTests && equal configBenchmarks @@ -557,11 +565,14 @@ configureOptions showOrParseArgs = configDependencies (\v flags -> flags { configDependencies = v}) (reqArg "NAME[:COMPONENT_NAME]=CID" (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsecGivenComponent)) - (map (\(GivenComponent pn cn cid) -> - prettyShow pn - ++ case cn of LMainLibName -> "" - LSubLibName n -> ":" ++ prettyShow n - ++ "=" ++ prettyShow cid))) + (map prettyGivenComponent)) + + ,option "" ["promised-dependency"] + "A list of promised dependencies. E.g., --promised-dependency=\"void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\"" + configPromisedDependencies (\v flags -> flags { configPromisedDependencies = v}) + (reqArg "NAME[:COMPONENT_NAME]=CID" + (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsecGivenComponent)) + (map prettyGivenComponent)) ,option "" ["instantiate-with"] "A mapping of signature names to concrete module instantiations." @@ -663,6 +674,13 @@ parsecGivenComponent = do cid <- parsec return $ GivenComponent pn ln cid +prettyGivenComponent :: GivenComponent -> String +prettyGivenComponent (GivenComponent pn cn cid) = + prettyShow pn + ++ case cn of LMainLibName -> "" + LSubLibName n -> ":" ++ prettyShow n + ++ "=" ++ prettyShow cid + installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))] installDirsOptions = [ option "" ["prefix"] diff --git a/Cabal/src/Distribution/Types/LocalBuildInfo.hs b/Cabal/src/Distribution/Types/LocalBuildInfo.hs index c8753d68200..f9ed5cda3ff 100644 --- a/Cabal/src/Distribution/Types/LocalBuildInfo.hs +++ b/Cabal/src/Distribution/Types/LocalBuildInfo.hs @@ -109,6 +109,9 @@ data LocalBuildInfo = LocalBuildInfo { componentNameMap :: Map ComponentName [ComponentLocalBuildInfo], -- ^ A map from component name to all matching -- components. These coincide with 'componentGraph' + promisedPkgs :: Map (PackageName, ComponentName) ComponentId, + -- ^ The packages we were promised, but aren't already installed. + -- MP: Perhaps this just needs to be a Set UnitId at this stage. installedPkgs :: InstalledPackageIndex, -- ^ All the info about the installed packages that the -- current package depends on (directly or indirectly). diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index 5e8ddc85c91..9143abb9848 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -401,6 +401,7 @@ instance Semigroup SavedConfig where configConstraints = lastNonEmpty configConstraints, -- TODO: NubListify configDependencies = lastNonEmpty configDependencies, + configPromisedDependencies = lastNonEmpty configPromisedDependencies, -- TODO: NubListify configConfigurationsFlags = lastNonMempty configConfigurationsFlags, configTests = combine configTests, diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index d86998f1fad..40c0e5293e5 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -865,6 +865,7 @@ convertToLegacyAllPackageConfig configExtraFrameworkDirs = mempty, configConstraints = mempty, configDependencies = mempty, + configPromisedDependencies = mempty, configExtraIncludeDirs = mempty, configDeterministic = mempty, configIPID = mempty, @@ -939,6 +940,7 @@ convertToLegacyPerPackageConfig PackageConfig {..} = configExtraFrameworkDirs = packageConfigExtraFrameworkDirs, configConstraints = mempty, configDependencies = mempty, + configPromisedDependencies = mempty, configExtraIncludeDirs = packageConfigExtraIncludeDirs, configIPID = mempty, configCID = mempty, diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 06669fb5643..7a924de3f80 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -1609,7 +1609,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB case Map.lookup (unDefUnitId def_uid) preexistingInstantiatedPkgs of Just full -> full Nothing -> error ("lookup_uid: " ++ prettyShow def_uid) - lc <- toLinkedComponent verbosity lookup_uid (elabPkgSourceId elab0) + lc <- toLinkedComponent verbosity False lookup_uid (elabPkgSourceId elab0) (Map.union external_lc_map lc_map) cc infoProgress $ dispLinkedComponent lc -- NB: elab is setup to be the correct form for an @@ -3602,6 +3602,9 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..}) Just _ -> error "non-library dependency" Nothing -> LMainLibName ] + + configPromisedDependencies = [] + configConstraints = case elabPkgOrComp of ElabPackage _ -> diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index f8e9f43b901..1044cd3cb8c 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -134,6 +134,8 @@ import Data.List ( deleteFirstsBy ) import System.FilePath ( () ) +import Control.Exception + ( assert ) globalCommand :: [Command action] -> CommandUI GlobalFlags globalCommand commands = CommandUI { @@ -465,7 +467,7 @@ filterConfigureFlags :: ConfigFlags -> Version -> ConfigFlags filterConfigureFlags flags cabalLibVersion -- NB: we expect the latest version to be the most common case, -- so test it first. - | cabalLibVersion >= mkVersion [3,7,0] = flags_latest + | cabalLibVersion >= mkVersion [3,11,0] = flags_latest -- The naming convention is that flags_version gives flags with -- all flags *introduced* in version eliminated. -- It is NOT the latest version of Cabal library that @@ -486,17 +488,26 @@ filterConfigureFlags flags cabalLibVersion | cabalLibVersion < mkVersion [2,1,0] = flags_2_1_0 | cabalLibVersion < mkVersion [2,5,0] = flags_2_5_0 | cabalLibVersion < mkVersion [3,7,0] = flags_3_7_0 + | cabalLibVersion < mkVersion [3,11,0] = flags_3_11_0 | otherwise = error "the impossible just happened" -- see first guard where - flags_latest = flags { + flags_latest = flags { -- Cabal >= 1.19.1 uses '--dependency' and does not need '--constraint'. -- Note: this is not in the wrong place. configConstraints gets -- repopulated in flags_1_19_1 but it needs to be set to empty for -- newer versions first. configConstraints = [] - } + } + + flags_3_11_0 = flags_latest { + -- It's too late to convert configPromisedDependencies to anything + -- meaningful, so we just assert that it's empty. + -- We add a Cabal>=3.11 constraint before solving when multi-repl is + -- enabled, so this should never trigger. + configPromisedDependencies = assert (null $ configPromisedDependencies flags) [] + } - flags_3_7_0 = flags_latest { + flags_3_7_0 = flags_3_11_0 { -- Cabal < 3.7 does not know about --extra-lib-dirs-static configExtraLibDirsStatic = [], diff --git a/changelog.d/pr-8726-2 b/changelog.d/pr-8726-2 new file mode 100644 index 00000000000..d59a8ac4dc2 --- /dev/null +++ b/changelog.d/pr-8726-2 @@ -0,0 +1,24 @@ +synopsis: Add --promised-dependency flag to ./Setup configure interface +packages: Cabal +prs: #8726 + +description: { + +There is a new flag `--promised-dependency` to allow users to +configure a package *without* having previously built the dependency. +Instead, we promise to the configure phase that we will have built it +by the time we build the package. This allows us to configure all the +packages we intend to load into the repl without building any +dependenices which we will load in the same session, because the +promise is satisifed due to loading the package and it's dependency +into one multi-session which ensures the dependency is built before +it is needed. + +A user of ./Setup configure specifies a promised dependency by +using the "--promised-dependency" flag with a normal dependency specification. For example: + +``` + '--promised-dependency=cabal-install-solver=cabal-install-solver-3.9.0.0-inplace' +``` + +} diff --git a/doc/setup-commands.rst b/doc/setup-commands.rst index 8cbc12e4680..24016c2c267 100644 --- a/doc/setup-commands.rst +++ b/doc/setup-commands.rst @@ -870,6 +870,16 @@ Miscellaneous options *pkgname* in a :pkg-field:`build-depends` should be resolved to *ipid*. +.. option:: --promised-dependency[=pkgname=ipid] + + Very much like ``--dependency`` but the package doesn't need to already + be installed. This is useful when attempting to start multiple component + sessions with cabal's multi-repl or projects such as Haskell Language Server. + + Several checks which are enabled for ``--dependency``s are disabled for promised + dependencies, so prefer to use ``--dependency`` if you know that the dependency + is already installed. + .. option:: --exact-configuration This changes Cabal to require every dependency be explicitly