Fix id generation in Backpack.

Author: angerman

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

@@ -59,7 +59,7 @@ mkComponentId :: HasCallStack => String -> ComponentId
 mkComponentId s = case (simpleParsec s) of
     -- Just cid@ComponentId{ unitComp = c, unitId = i } | (fromShortText c) == "ghc-9.8.4", (fromShortText i) == "rts-1.0.3-cec100dd" -> trace ("### ComponentId: `" ++ (fromShortText c) ++ "' `" ++ (fromShortText i) ++ "' is a full one.\n" ++ prettyCallStack callStack) cid
     Just cid@ComponentId{} -> cid
-    Just cid@PartialComponentId{} -> error $ "mkPartialComponentId: `" ++ s ++ "' is a partial component id, not a full one."
+    Just cid@PartialComponentId{} -> error $ "mkPartialComponentId: `" ++ s ++ "' is a partial component id, not a full one.\n" ++ (prettyCallStack callStack)
     _ -> error $ "Unable to parse PartialComponentId: `" ++ s ++ "'."
 
 mkComponentId' :: HasCallStack => String -> String -> Bool -> ComponentId

Cabal/src/Distribution/Backpack/Configure.hs

@@ -127,6 +127,7 @@ configureComponentLocalBuildInfos
         deterministic
         ipid_flag
         cid_flag
+        comp
         pkg_descr
         conf_pkg_map
         (map fst graph0)

Cabal/src/Distribution/Backpack/ConfiguredComponent.hs

@@ -22,6 +22,7 @@ import Distribution.CabalSpecVersion
 import Distribution.Package
 import Distribution.PackageDescription
 import Distribution.Simple.BuildToolDepends
+import Distribution.Simple.Compiler
 import Distribution.Simple.Flag (Flag)
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Types.AnnotatedId
@@ -242,6 +243,7 @@ toConfiguredComponent pkg_descr this_cid lib_dep_map exe_dep_map component = do
 toConfiguredComponent'
   :: Bool -- use_external_internal_deps
   -> FlagAssignment
+  -> Compiler
   -> PackageDescription
   -> Bool -- deterministic
   -> Flag String -- configIPID (todo: remove me)
@@ -252,6 +254,7 @@ toConfiguredComponent'
 toConfiguredComponent'
   use_external_internal_deps
   flags
+  comp
   pkg_descr
   deterministic
   ipid_flag
@@ -276,6 +279,7 @@ toConfiguredComponent'
           deterministic
           ipid_flag
           cid_flag
+          (compilerId comp)
           (package pkg_descr)
           (componentName component)
           (Just (deps, flags))
@@ -308,6 +312,7 @@ toConfiguredComponents
   -> Bool -- deterministic
   -> Flag String -- configIPID
   -> Flag ComponentId -- configCID
+  -> Compiler
   -> PackageDescription
   -> ConfiguredComponentMap
   -> [Component]
@@ -318,6 +323,7 @@ toConfiguredComponents
   deterministic
   ipid_flag
   cid_flag
+  comp
   pkg_descr
   dep_map
   comps =
@@ -328,6 +334,7 @@ toConfiguredComponents
           toConfiguredComponent'
             use_external_internal_deps
             flags
+            comp
             pkg_descr
             deterministic
             ipid_flag

Cabal/src/Distribution/Backpack/Id.hs

@@ -34,12 +34,13 @@ computeComponentId
   :: Bool -- deterministic mode
   -> Flag String
   -> Flag ComponentId
+  -> CompilerId
   -> PackageIdentifier
   -> ComponentName
   -- This is used by cabal-install's legacy codepath
   -> Maybe ([ComponentId], FlagAssignment)
   -> ComponentId
-computeComponentId deterministic mb_ipid mb_cid pid cname mb_details =
+computeComponentId deterministic mb_ipid mb_cid compid pid cname mb_details =
   -- show is found to be faster than intercalate and then replacement of
   -- special character used in intercalating. We cannot simply hash by
   -- doubly concatenating list, as it just flatten out the nested list, so
@@ -67,6 +68,9 @@ computeComponentId deterministic mb_ipid mb_cid pid cname mb_details =
           -- Hack to reuse install dirs machinery
           -- NB: no real IPID available at this point
           env = packageTemplateEnv pid (mkUnitId "")
+      -- can't use pkgCompiler pid here, because it's
+      -- likely not set.
+      compiler_prefix = prettyShow compid ++ "_"
       actual_base = case mb_ipid of
         Flag ipid0 -> explicit_base ipid0
         NoFlag
@@ -76,7 +80,9 @@ computeComponentId deterministic mb_ipid mb_cid pid cname mb_details =
         Flag cid -> cid
         NoFlag ->
           mkComponentId $
-            actual_base
+            (if compiler_prefix `isPrefixOf` actual_base
+            then actual_base
+            else compiler_prefix ++ actual_base)
               ++ ( case componentNameString cname of
                     Nothing -> ""
                     Just s -> "-" ++ unUnqualComponentName s

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

@@ -205,7 +205,7 @@ configure
           (const (return configFlags))
           (const extraArgs)
       Right installPlan0 ->
-        let installPlan = InstallPlan.configureInstallPlan configFlags installPlan0
+        let installPlan = InstallPlan.configureInstallPlan comp configFlags installPlan0
          in case fst (InstallPlan.ready installPlan) of
               [ pkg@( ReadyPackage
                         ( ConfiguredPackage

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

@@ -526,7 +526,7 @@ processInstallPlan
   -> IO ()
 processInstallPlan
   verbosity
-  args@(_, _, _, _, _, _, configFlags, _, installFlags, _, _, _)
+  args@(_, _, comp, _, _, _, configFlags, _, installFlags, _, _, _)
   ( installedPkgIndex
     , sourcePkgDb
     , _
@@ -552,7 +552,7 @@ processInstallPlan
           installPlan
       postInstallActions verbosity args userTargets installPlan buildOutcomes
     where
-      installPlan = InstallPlan.configureInstallPlan configFlags installPlan0
+      installPlan = InstallPlan.configureInstallPlan comp configFlags installPlan0
       dryRun = fromFlag (installDryRun installFlags)
       nothingToInstall = null (fst (InstallPlan.ready installPlan))
 

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

@@ -590,8 +590,8 @@ fromSolverInstallPlanWithProgress f plan = do
 
 -- | Conversion of 'SolverInstallPlan' to 'InstallPlan'.
 -- Similar to 'elaboratedInstallPlan'
-configureInstallPlan :: Cabal.ConfigFlags -> SolverInstallPlan -> InstallPlan
-configureInstallPlan configFlags solverPlan =
+configureInstallPlan :: Cabal.ConfigFlags -> Compiler -> SolverInstallPlan -> InstallPlan
+configureInstallPlan configFlags comp solverPlan =
   flip fromSolverInstallPlan solverPlan $ \mapDep planpkg ->
     [ case planpkg of
         SolverInstallPlan.PreExisting pkg ->
@@ -614,6 +614,7 @@ configureInstallPlan configFlags solverPlan =
               )
               Cabal.NoFlag
               Cabal.NoFlag
+              (compilerId comp)
               (packageId spkg)
               (PD.CLibName PD.LMainLibName)
               ( Just