Add stage to SolverPackage, and use stage from elabStage

Author: angerman

cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs

@@ -29,7 +29,7 @@ convCP :: SI.InstalledPackageIndex ->
 convCP iidx sidx (CP qpi fa es ds) =
   case qpi of
     -- Installed
-    (PI qpn (I {- FIXME -} Host _ (Inst pi)))  ->
+    (PI qpn (I _stage _ (Inst pi)))  ->
       PreExisting $
                   InstSolverPackage {
                     instSolverQPN = qpn,
@@ -38,11 +38,12 @@ convCP iidx sidx (CP qpi fa es ds) =
                     instSolverPkgExeDeps = fmap snd ds'
                   }
     -- "In repo" i.e. a source package
-    (PI qpn@(Q _path pn) (I {- FIXME -} Host v InRepo)) ->
+    (PI qpn@(Q _path pn) (I stage v InRepo)) ->
       let pi = PackageIdentifier pn v in
       Configured $
                   SolverPackage {
                       solverPkgQPN = qpn,
+                      solverPkgStage = stage,
                       solverPkgSource = fromMaybe (error "convCP: lookupPackageId failed") $ CI.lookupPackageId sidx pi,
                       solverPkgFlags = fa,
                       solverPkgStanzas = es,

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

@@ -13,6 +13,7 @@ import Distribution.Solver.Types.OptionalStanza
 import Distribution.Solver.Types.PackagePath (QPN)
 import Distribution.Solver.Types.SolverId
 import Distribution.Solver.Types.SourcePackage
+import Distribution.Solver.Types.Stage (Stage (..))
 
 -- | A 'SolverPackage' is a package specified by the dependency solver.
 -- It will get elaborated into a 'ConfiguredPackage' or even an
@@ -23,6 +24,7 @@ import Distribution.Solver.Types.SourcePackage
 --
 data SolverPackage loc = SolverPackage {
         solverPkgQPN     :: QPN,
+        solverPkgStage   :: Stage,
         solverPkgSource  :: SourcePackage loc,
         solverPkgFlags   :: FlagAssignment,
         solverPkgStanzas :: OptionalStanzaSet,

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

@@ -1019,7 +1019,7 @@ configuredPackageProblems
   -> [PackageProblem]
 configuredPackageProblems
   toolchains
-  (SolverPackage _qpn pkg specifiedFlags stanzas specifiedDeps0 _specifiedExeDeps') =
+  (SolverPackage _qpn _stage pkg specifiedFlags stanzas specifiedDeps0 _specifiedExeDeps') =
     [ DuplicateFlag flag
     | flag <- PD.findDuplicateFlagAssignments specifiedFlags
     ]

cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs

@@ -80,7 +80,9 @@ import Distribution.Simple.Command (CommandUI)
 import Distribution.Simple.Compiler
   ( PackageDBStackCWD
   , coercePackageDBStack
+  , showCompilerId
   )
+import Distribution.Solver.Types.Stage
 import qualified Distribution.Simple.InstallDirs as InstallDirs
 import Distribution.Simple.LocalBuildInfo
   ( ComponentName (..)
@@ -178,15 +180,7 @@ buildAndRegisterUnpackedPackage
   registerLock
   cacheLock
   pkgshared@ElaboratedSharedConfig
-    { pkgConfigToolchains =
-      Toolchains
-        { buildToolchain =
-          Toolchain
-            { toolchainCompiler = compiler
-            , toolchainProgramDb = progdb
-            }
-        }
-    }
+    { pkgConfigToolchains = toolchains }
   plan
   rpkg@(ReadyPackage pkg)
   srcdir
@@ -260,6 +254,10 @@ buildAndRegisterUnpackedPackage
 
     return ()
     where
+      (compiler, progdb) = case elabStage pkg of
+        Host -> (toolchainCompiler (hostToolchain toolchains), toolchainProgramDb (hostToolchain toolchains))
+        Build -> (toolchainCompiler (buildToolchain toolchains), toolchainProgramDb (buildToolchain toolchains))
+
       uid = installedUnitId rpkg
 
       comp_par_strat = case maybe_semaphore of
@@ -458,14 +456,7 @@ buildInplaceUnpackedPackage
   registerLock
   cacheLock
   pkgshared@ElaboratedSharedConfig
-    { pkgConfigToolchains =
-      Toolchains
-        { buildToolchain =
-          Toolchain
-            { toolchainPlatform = Platform _ os
-            }
-        }
-    }
+    { pkgConfigToolchains = toolchains }
   plan
   rpkg@(ReadyPackage pkg)
   buildStatus
@@ -610,6 +601,10 @@ buildInplaceUnpackedPackage
         , buildResultLogFile = Nothing
         }
     where
+      Platform _ os = case elabStage pkg of
+        Host -> toolchainPlatform (hostToolchain toolchains)
+        Build -> toolchainPlatform (buildToolchain toolchains)
+
       dparams = elabDistDirParams pkgshared pkg
 
       packageFileMonitor = newPackageFileMonitor pkgshared distDirLayout dparams
@@ -671,15 +666,7 @@ buildAndInstallUnpackedPackage
   registerLock
   cacheLock
   pkgshared@ElaboratedSharedConfig
-    { pkgConfigToolchains =
-      Toolchains
-        { buildToolchain =
-          Toolchain
-            { toolchainCompiler = compiler
-            , toolchainPlatform = platform
-            }
-        }
-    }
+    { pkgConfigToolchains = toolchains }
   plan
   rpkg@(ReadyPackage pkg)
   srcdir
@@ -826,6 +813,10 @@ buildAndInstallUnpackedPackage
         , buildResultLogFile = mlogFile
         }
     where
+      (compiler, platform) = case elabStage pkg of
+          Host -> (toolchainCompiler (hostToolchain toolchains), toolchainPlatform (hostToolchain toolchains))
+          Build -> (toolchainCompiler (buildToolchain toolchains), toolchainPlatform (buildToolchain toolchains))
+
       uid = installedUnitId rpkg
       pkgid = packageId rpkg
 
@@ -836,13 +827,20 @@ buildAndInstallUnpackedPackage
           prettyShow pkgid
             ++ " (all, legacy fallback: "
             ++ unwords (map whyNotPerComponent $ NE.toList pkgWhyNotPerComponent)
+            ++ ", "
+            ++ dispcompiler (elabStage pkg)
             ++ ")"
         -- Packages built per component
         ElabComponent comp ->
           prettyShow pkgid
             ++ " ("
             ++ maybe "custom" prettyShow (compComponentName comp)
+            ++ ", "
+            ++ dispcompiler (elabStage pkg)
             ++ ")"
+      dispcompiler :: Stage -> String
+      dispcompiler Host = showCompilerId (toolchainCompiler (hostToolchain toolchains))
+      dispcompiler Build = showCompilerId (toolchainCompiler (buildToolchain toolchains))
 
       noticeProgress :: ProgressPhase -> IO ()
       noticeProgress phase =

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

@@ -1002,6 +1002,7 @@ printPlan
         unwords $
           filter (not . null) $
             [ " -"
+            , show (elabStage elab)
             , if verbosity >= deafening
                 then prettyShow (installedUnitId elab)
                 else prettyShow (packageId elab)

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

@@ -1683,7 +1683,7 @@ elaborateInstallPlan
         :: (SolverId -> [ElaboratedPlanPackage])
         -> SolverPackage UnresolvedPkgLoc
         -> LogProgress [ElaboratedConfiguredPackage]
-      elaborateSolverToComponents mapDep spkg@(SolverPackage qpn _ _ _ deps0 exe_deps0) =
+      elaborateSolverToComponents mapDep spkg@(SolverPackage _qpn _stage _ _ _ deps0 exe_deps0) =
         case mkComponentsGraph (elabEnabledSpec elab0) pd of
           Right g -> do
             let src_comps = componentsGraphToList g
@@ -2072,7 +2072,8 @@ elaborateInstallPlan
       elaborateSolverToPackage
         pkgWhyNotPerComponent
         pkg@( SolverPackage
-                qpn
+                _qpn
+                _stage
                 (SourcePackage pkgid _gpd _srcloc _descOverride)
                 _flags
                 _stanzas
@@ -2176,7 +2177,8 @@ elaborateInstallPlan
         -> ElaboratedConfiguredPackage
       elaborateSolverToCommon
         pkg@( SolverPackage
-                qpn
+                _qpn
+                stage
                 (SourcePackage pkgid gdesc srcloc descOverride)
                 flags
                 stanzas
@@ -2200,7 +2202,7 @@ elaborateInstallPlan
             elabPkgSourceId = pkgid
 
             -- TODO: temporarily set everything to build on build
-            elabStage = Build
+            elabStage = stage
             elabCompiler = toolchainCompiler (toolchainFor elabStage toolchains)
             elabPlatform = toolchainPlatform (toolchainFor elabStage toolchains)
             elabProgramDb = toolchainProgramDb (toolchainFor elabStage toolchains)