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

@@ -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,15 +67,15 @@ configureComponentLocalBuildInfos
     -> Flag String            -- configIPID
     -> Flag ComponentId       -- configCID
     -> PackageDescription
-    -> [PreExistingComponent]
+    -> ([PreExistingComponent], [PromisedComponent])
     -> FlagAssignment         -- configConfigurationsFlags
     -> [(ModuleName, Module)] -- configInstantiateWith
     -> InstalledPackageIndex
     -> Compiler
     -> 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"

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

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,20 +362,22 @@ 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)
      -> ConfiguredComponent
      -> 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)

Cabal/src/Distribution/Backpack/PreExistingComponent.hs

@@ -1,6 +1,7 @@
 -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
 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.