fixup! Add support for loading multiple components into one repl session

* Add setup.Cabal>=3.11 constraint when multi-repl is enabled (+ test)

Author: fgaz

cabal-install-solver/src/Distribution/Solver/Types/ConstraintSource.hs

@@ -36,6 +36,10 @@ data ConstraintSource =
   -- target, when a more specific source is not known.
   | ConstraintSourceConfigFlagOrTarget
 
+  -- | Constraint introduced by --enable-multi-repl, which requires features
+  -- from Cabal >= 3.11
+  | ConstraintSourceMultiRepl
+
   -- | The source of the constraint is not specified.
   | ConstraintSourceUnknown
 
@@ -65,6 +69,8 @@ showConstraintSource ConstraintSourceNonUpgradeablePackage =
 showConstraintSource ConstraintSourceFreeze = "cabal freeze"
 showConstraintSource ConstraintSourceConfigFlagOrTarget =
     "config file, command line flag, or user target"
+showConstraintSource ConstraintSourceMultiRepl =
+    "--enable-multi-repl"
 showConstraintSource ConstraintSourceUnknown = "unknown source"
 showConstraintSource ConstraintSetupCabalMinVersion =
     "minimum version of Cabal used by Setup.hs"

cabal-install/src/Distribution/Client/CmdRepl.hs

@@ -36,6 +36,8 @@ import Distribution.Client.CmdErrorMessages
            targetSelectorRefersToPkgs,
            renderComponentKind, renderListCommaAnd, renderListSemiAnd,
            componentKind, sortGroupOn, Plural(..) )
+import Distribution.Client.Targets
+         ( UserConstraint(..), UserConstraintScope(..) )
 import Distribution.Client.TargetProblem
          ( TargetProblem(..) )
 import qualified Distribution.Client.InstallPlan as InstallPlan
@@ -65,9 +67,13 @@ import Distribution.Compiler
 import Distribution.Simple.Compiler
          ( Compiler, compilerCompatVersion )
 import Distribution.Package
-         ( Package(..), packageName, UnitId, installedUnitId )
+         ( Package(..), packageName, mkPackageName, UnitId, installedUnitId )
 import Distribution.Solver.Types.SourcePackage
          ( SourcePackage(..) )
+import Distribution.Solver.Types.ConstraintSource
+         ( ConstraintSource(ConstraintSourceMultiRepl) )
+import Distribution.Solver.Types.PackageConstraint
+         ( PackageProperty(PackagePropertyVersion) )
 import Distribution.Types.BuildInfo
          ( BuildInfo(..), emptyBuildInfo )
 import Distribution.Types.ComponentName
@@ -81,7 +87,7 @@ import Distribution.Types.Library
 import Distribution.Types.Version
          ( Version, mkVersion )
 import Distribution.Types.VersionRange
-         ( anyVersion )
+         ( anyVersion, orLaterVersion )
 import Distribution.Utils.Generic
          ( safeHead )
 import Distribution.Verbosity
@@ -115,7 +121,7 @@ import Distribution.Client.ReplFlags
       topReplOptions )
 import Distribution.Simple.Flag ( Flag(Flag), fromFlagOrDefault )
 import Distribution.Client.ProjectConfig
-    ( ProjectConfigShared(projectConfigMultiRepl),
+    ( ProjectConfigShared(projectConfigMultiRepl, projectConfigConstraints),
       ProjectConfig(projectConfigShared) )
 
 
@@ -183,8 +189,8 @@ multiReplDecision ctx compiler flags =
 -- up to date, selects that part of the plan needed by the given or implicit
 -- repl target and then executes the plan.
 --
--- Compared to @build@ the difference is that only one target is allowed
--- (given or implicit) and the target type is repl rather than build. The
+-- Compared to @build@ the difference is that multiple targets are handled
+-- specially and the target type is repl rather than build. The
 -- general plan execution infrastructure handles both build and repl targets.
 --
 -- For more details on how this works, see the module
@@ -228,13 +234,24 @@ replAction flags@NixStyleFlags { extraFlags = r@ReplFlags{..} , ..} targetString
 
         updateContextAndWriteProjectFile ctx scriptPath scriptExecutable
 
-    (originalComponent, baseCtx') <- if null (envPackages replEnvFlags)
-      then return (Nothing, baseCtx)
+    -- If multi-repl is used, we need a Cabal recent enough to handle it.
+    -- We need to do this before solving, but the compiler version is only known
+    -- after solving (phaseConfigureCompiler), so instead of using
+    -- multiReplDecision we just check the flag.
+    let baseCtx' = if fromFlagOrDefault False $
+                        projectConfigMultiRepl (projectConfigShared $ projectConfig baseCtx)
+                        <> replUseMulti
+                   then baseCtx & lProjectConfig . lProjectConfigShared . lProjectConfigConstraints
+                          %~ (multiReplCabalConstraint:)
+                   else baseCtx
+
+    (originalComponent, baseCtx'') <- if null (envPackages replEnvFlags)
+      then return (Nothing, baseCtx')
       else
         -- Unfortunately, the best way to do this is to let the normal solver
         -- help us resolve the targets, but that isn't ideal for performance,
         -- especially in the no-project case.
-        withInstallPlan (lessVerbose verbosity) baseCtx $ \elaboratedPlan sharedConfig -> do
+        withInstallPlan (lessVerbose verbosity) baseCtx' $ \elaboratedPlan sharedConfig -> do
           -- targets should be non-empty map, but there's no NonEmptyMap yet.
           targets <- validatedTargets (projectConfigShared (projectConfig ctx)) (pkgConfigCompiler sharedConfig) elaboratedPlan targetSelectors
 
@@ -243,9 +260,9 @@ replAction flags@NixStyleFlags { extraFlags = r@ReplFlags{..} , ..} targetString
             originalDeps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan unitId
             oci = OriginalComponentInfo unitId originalDeps
             pkgId = fromMaybe (error $ "cannot find " ++ prettyShow unitId) $ packageId <$> InstallPlan.lookup elaboratedPlan unitId
-            baseCtx' = addDepsToProjectTarget (envPackages replEnvFlags) pkgId baseCtx
+            baseCtx'' = addDepsToProjectTarget (envPackages replEnvFlags) pkgId baseCtx'
 
-          return (Just oci, baseCtx')
+          return (Just oci, baseCtx'')
 
     -- Now, we run the solver again with the added packages. While the graph
     -- won't actually reflect the addition of transitive dependencies,
@@ -255,9 +272,9 @@ replAction flags@NixStyleFlags { extraFlags = r@ReplFlags{..} , ..} targetString
     -- In addition, to avoid a *third* trip through the solver, we are
     -- replicating the second half of 'runProjectPreBuildPhase' by hand
     -- here.
-    (buildCtx, compiler, replOpts', targets) <- withInstallPlan verbosity baseCtx' $
+    (buildCtx, compiler, replOpts', targets) <- withInstallPlan verbosity baseCtx'' $
       \elaboratedPlan elaboratedShared' -> do
-        let ProjectBaseContext{..} = baseCtx'
+        let ProjectBaseContext{..} = baseCtx''
 
         -- Recalculate with updated project.
         targets <- validatedTargets (projectConfigShared projectConfig) (pkgConfigCompiler elaboratedShared') elaboratedPlan targetSelectors
@@ -296,7 +313,7 @@ replAction flags@NixStyleFlags { extraFlags = r@ReplFlags{..} , ..} targetString
     -- Multi Repl implemention see: https://well-typed.com/blog/2023/03/cabal-multi-unit/ for
     -- a high-level overview about how everything fits together.
     if Set.size (distinctTargetComponents targets) > 1
-    then withTempDirectoryEx verbosity (TempFileOptions keepTempFiles) distDir "multi-out-" $ \dir' -> do
+    then withTempDirectoryEx verbosity (TempFileOptions keepTempFiles) distDir "multi-out" $ \dir' -> do
       -- multi target repl
       dir <- makeAbsolute dir'
       -- Modify the replOptions so that the ./Setup repl command will write options
@@ -306,12 +323,12 @@ replAction flags@NixStyleFlags { extraFlags = r@ReplFlags{..} , ..} targetString
         _              -> usingGhciScript compiler projectRoot replOpts'
 
       let buildCtx' = buildCtx & lElaboratedShared . lPkgConfigReplOptions .~ replOpts''
-      printPlan verbosity baseCtx' buildCtx'
+      printPlan verbosity baseCtx'' buildCtx'
 
       -- The project build phase will call `./Setup repl` but write the options
       -- out into a file without starting a repl.
-      buildOutcomes <- runProjectBuildPhase verbosity baseCtx' buildCtx'
-      runProjectPostBuildPhase verbosity baseCtx' buildCtx' buildOutcomes
+      buildOutcomes <- runProjectBuildPhase verbosity baseCtx'' buildCtx'
+      runProjectPostBuildPhase verbosity baseCtx'' buildCtx' buildOutcomes
 
       -- calculate PATH, we construct a PATH which is the union of all paths from
       -- the units which have been loaded. This is not quite right but usually works fine.
@@ -354,10 +371,10 @@ replAction flags@NixStyleFlags { extraFlags = r@ReplFlags{..} , ..} targetString
         _              -> usingGhciScript compiler projectRoot replOpts'
 
       let buildCtx' = buildCtx & lElaboratedShared . lPkgConfigReplOptions .~ replOpts''
-      printPlan verbosity baseCtx' buildCtx'
+      printPlan verbosity baseCtx'' buildCtx'
 
-      buildOutcomes <- runProjectBuildPhase verbosity baseCtx' buildCtx'
-      runProjectPostBuildPhase verbosity baseCtx' buildCtx' buildOutcomes
+      buildOutcomes <- runProjectBuildPhase verbosity baseCtx'' buildCtx'
+      runProjectPostBuildPhase verbosity baseCtx'' buildCtx' buildOutcomes
   where
 
     combine_search_paths paths =
@@ -391,6 +408,17 @@ replAction flags@NixStyleFlags { extraFlags = r@ReplFlags{..} , ..} targetString
 
       return targets
 
+    -- This is the constraint setup.Cabal>=3.11. 3.11 is when Cabal options
+    -- used for multi-repl were introduced.
+    -- Idelly we'd apply this constraint only on the closure of repl targets,
+    -- but that would require another solver run for marginal advantages that
+    -- will further shrink as 3.11 is adopted.
+    multiReplCabalConstraint =
+      ( UserConstraint
+          (UserAnySetupQualifier (mkPackageName "Cabal"))
+          (PackagePropertyVersion $ orLaterVersion $ mkVersion [3,11])
+      , ConstraintSourceMultiRepl )
+
 -- | First version of GHC which supports multiple home packages
 minMultipleHomeUnitsVersion :: Version
 minMultipleHomeUnitsVersion = mkVersion [9, 4]
@@ -685,3 +713,15 @@ lPkgConfigReplOptions f s = fmap (\x -> s { pkgConfigReplOptions = x }) (f (pkgC
 lReplOptionsFlags :: Lens' ReplOptions [String]
 lReplOptionsFlags f s = fmap (\x -> s { replOptionsFlags = x }) (f (replOptionsFlags s))
 {-# inline lReplOptionsFlags #-}
+
+lProjectConfig :: Lens' ProjectBaseContext ProjectConfig
+lProjectConfig f s = fmap (\x -> s { projectConfig = x }) (f (projectConfig s))
+{-# inline lProjectConfig #-}
+
+lProjectConfigShared :: Lens' ProjectConfig ProjectConfigShared
+lProjectConfigShared f s = fmap (\x -> s { projectConfigShared = x }) (f (projectConfigShared s))
+{-# inline lProjectConfigShared #-}
+
+lProjectConfigConstraints :: Lens' ProjectConfigShared [(UserConstraint, ConstraintSource)]
+lProjectConfigConstraints f s = fmap (\x -> s { projectConfigConstraints = x }) (f (projectConfigConstraints s))
+{-# inline lProjectConfigConstraints #-}

cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out

@@ -0,0 +1,10 @@
+# cabal v2-update
+Downloading the latest package list from test-local-repo
+# cabal v2-repl
+Resolving dependencies...
+Error: cabal: Could not resolve dependencies:
+[__0] trying: pkg-a-0 (user goal)
+[__1] next goal: pkg-a:setup.Cabal (dependency of pkg-a)
+[__1] rejecting: pkg-a:setup.Cabal-<VERSION>/installed-<HASH>, pkg-a:setup.Cabal-3.8.0.0 (constraint from --enable-multi-repl requires >=3.11)
+[__1] fail (backjumping, conflict set: pkg-a, pkg-a:setup.Cabal)
+After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: pkg-a:setup.Cabal (3), pkg-a (2)

cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.project

@@ -0,0 +1,2 @@
+packages: pkg-a/*.cabal
+packages: pkg-b/*.cabal

cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.test.hs

@@ -0,0 +1,5 @@
+import Test.Cabal.Prelude
+
+main = cabalTest $ withRepo "repo" $ do
+    skipUnlessGhcVersion ">= 9.4"
+    void $ fails $ cabalWithStdin "v2-repl" ["--keep-temp-files","--enable-multi-repl","pkg-a", "pkg-b"] ""

cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-a/Foo.hs

@@ -0,0 +1,5 @@
+module Foo where
+
+foo :: Int
+foo = 42
+

cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-a/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-a/pkg-a.cabal

@@ -0,0 +1,14 @@
+cabal-version: 2.2
+name: pkg-a
+version: 0
+build-type: Custom
+
+custom-setup
+  setup-depends:
+    base  >= 4 && < 5,
+    Cabal < 3.11
+
+library
+  default-language: Haskell2010
+  build-depends: base
+  exposed-modules: Foo

cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-b/Bar.hs

@@ -0,0 +1,6 @@
+module Bar (foo, bar) where
+
+import Foo (foo)
+
+bar :: Int
+bar = 0xdeadc0de

cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-b/pkg-b.cabal

@@ -0,0 +1,8 @@
+cabal-version: 2.2
+name: pkg-b
+version: 0
+
+library
+  default-language: Haskell2010
+  build-depends: base, pkg-a
+  exposed-modules: Bar