Add support for loading multiple components into one repl session

There are several parts to this patch which are logically distinct but
work together to support the overal goal of starting a GHCi session with
multiple packages loaded at once.

1. When a user writes "cabal repl <target>" then if the user is using a
   compiler > ghc-9.4.* then we will attempt to start a multi-session
   which loads the selected targets into one multi-package session of
   GHC.
1a. The closure property states that in order to load components `p` and `q` into
    the same session that if `p` depends on `z` and `z` depends on `q`
    then `z` must also be loaded into the session.
1b. Only inplace packages are able to be loaded into a multi session (if a component
    `z` exists then it is already made into an inplace package by
    cabal). Therefore cabal has already engineered that there is source
    code locally available for all packages which we will want to load
    into a session.

2. 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
   prepending a "+" to a normal dependency specification. For example:

  ```
     '--dependency=+cabal-install-solver=cabal-install-solver-3.9.0.0-inplace'
  ```

2a. The `./Setup repl` command is modified to allow a user to defer
    starting the repl and instead instruct the command to write the
    necessary build flags to a file. The option is called
    `--repl-multi-file <FILEPATH>`.

    `cabal-install` then invokes this command for each component which
    will populate the session and starts a multi-session with all the
    arguments together.

3. The solver is unmodified, the solver is given the repl targets and
   creates a build plan as before. After the solver is completed then in
   `setRootTargets` and `pruneInstallPlan` we modify the install plan to
   enforce the closure property and mark which dependencies need to be
   promised.

   * Mark the current components as `BuildInPlaceOnly InMemory`, which
     indicates to the compiler that it is to be built in a GHC
     multi-session.
   * Augment the component repl targets to indicate that components
     required by the closure property (in addition to normal targets)
     will be loaded into the repl.
   * Modify the dependency edges in `compLibDependencies` to indicate
     which dependencies are the promised ones (which is precisely
     components which are `BuildInPlaceOnly InMemory` build styles).
     This is the field which is eventually used to populate the
     `--dependency` argument to `./Setup configure`.

Author: mpickering

Cabal-syntax/src/Distribution/Types/ExposedModule.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Distribution.Types.ExposedModule where
 
 import Distribution.Compat.Prelude

Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs

@@ -29,7 +29,7 @@ tests = testGroup "Distribution.Utils.Structured"
     , testCase "GenericPackageDescription" $
       md5Check (Proxy :: Proxy GenericPackageDescription) 0xa3e9433662ecf0c7a3c26f6d75a53ba1
     , testCase "LocalBuildInfo" $
-      md5Check (Proxy :: Proxy LocalBuildInfo) 0x91ffcd61bbd83525e8edba877435a031
+      md5Check (Proxy :: Proxy LocalBuildInfo) 0x30ebb8fffa1af2aefa9432ff4028eef8
 #endif
     ]
 

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,17 @@ 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 +138,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 +147,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 +188,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

@@ -49,6 +49,7 @@ import qualified Data.Map as Map
 import Distribution.Pretty
 import Text.PrettyPrint (Doc, hang, text, vcat, hsep, quotes, ($$))
 import qualified Text.PrettyPrint as PP
+import Distribution.Compat.Stack
 
 -- | A configured component, we know exactly what its 'ComponentId' is,
 -- and the 'ComponentId's of the things it depends on.
@@ -177,22 +178,23 @@ 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
+                                $$ text (prettyCallStack callStack)
+                        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 any_promised 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 any_promised
+            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,20 @@ 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 ]
+                -- [(mn_new, OpenModule mn_new) | (mn_new, Nothing) <- reexports_list ]
 
     let final_linked_shape = ModuleShape provs (Map.keysSet (modScopeRequires linked_shape))
 
@@ -337,20 +355,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 any_promised 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 any_promised 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,18 @@ 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
+    }
 
 -- | Stripped down version of 'LinkedComponent' for things
 -- we don't need to know how to build.
@@ -56,6 +69,7 @@ ipiToPreExistingComponent ipi =
         pc_shape = shapeInstalledPackage ipi
     }
 
+
 instance HasMungedPackageId PreExistingComponent where
   mungedId = pc_munged_id
 

Cabal/src/Distribution/Compat/ResponseFile.hs

@@ -3,7 +3,7 @@
 -- Compatibility layer for GHC.ResponseFile
 -- Implementation from base 4.12.0 is used.
 -- http://hackage.haskell.org/package/base-4.12.0.0/src/LICENSE
-module Distribution.Compat.ResponseFile (expandResponse) where
+module Distribution.Compat.ResponseFile (expandResponse, escapeArgs) where
 
 import Distribution.Compat.Prelude
 import Prelude ()
@@ -13,7 +13,7 @@ import System.IO (hPutStrLn, stderr)
 import System.IO.Error
 
 #if MIN_VERSION_base(4,12,0)
-import GHC.ResponseFile (unescapeArgs)
+import GHC.ResponseFile (unescapeArgs, escapeArgs)
 #else
 
 unescapeArgs :: String -> [String]
@@ -47,6 +47,20 @@ unescape args = reverse . map reverse $ go args NoneQ False [] []
         | '"'  == c              = go cs DblQ  False a     as
         | otherwise              = go cs NoneQ False (c:a) as
 
+escapeArgs :: [String] -> String
+escapeArgs = unlines . map escapeArg
+
+escapeArg :: String -> String
+escapeArg = reverse . foldl' escape []
+
+escape :: String -> Char -> String
+escape cs c
+  |    isSpace c
+    || '\\' == c
+    || '\'' == c
+    || '"'  == c = c:'\\':cs -- n.b., our caller must reverse the result
+  | otherwise    = c:cs
+
 #endif
 
 expandResponse :: [String] -> IO [String]