Support getting nonreinstallable units from GHC

cabal-install includes a hardcoded list of non-reinstallable packages.
cabal-install will refuse to use a different version of these packages
in a build plan unless the --allow-boot-library-installs flag is set.

This list of packages is too pessimistic, and needlessly coupled to GHC.
For instance, as of GHC-9.12, `base` and `template-haskell` can be
"re-installed" without issue.

This patch allows compilers to specify exactly which packages are wired-in
and so should not be reinstalled.

In the case of GHC-9.14+, this amounts to ghc-internal and ghc itself.

If a compiler chooses to specify this information then it overrides the
hardcoded non-reinstallable package list. Otherwise, it is still used
for the sake of backwards compatibility.

Note that this information comes in the form of unit-ids rather than
package names. This patch extends the solver with constraints that force
the use of a precise unit-id.

The behaviour here is still somewhat pessimistic. In the future, we
could further relax this restriction and only ban reinstalling these
packafes when absolutely necessary, eg, only ban re-installing `ghc` if
we are using plugins, etc.

For the GHC change that added the interface to expose the unit-id of
ghc-internal, see: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/13297

Resolves #10087

Co-Authored-By: Matthew Pickering <matthewtpickering@gmail.com>

Author: TeofilC

Cabal-syntax/src/Distribution/Compiler.hs

@@ -56,8 +56,10 @@ import Language.Haskell.Extension
 import Distribution.Version (Version, mkVersion', nullVersion)
 
 import qualified Distribution.Compat.CharParsing as P
+import Distribution.Package (PackageName)
 import Distribution.Parsec (Parsec (..))
 import Distribution.Pretty (Pretty (..), prettyShow)
+import Distribution.Types.UnitId (UnitId)
 import qualified System.Info (compilerName, compilerVersion)
 import qualified Text.PrettyPrint as Disp
 
@@ -213,6 +215,11 @@ data CompilerInfo = CompilerInfo
   -- ^ Supported language standards, if known.
   , compilerInfoExtensions :: Maybe [Extension]
   -- ^ Supported extensions, if known.
+  , compilerInfoWiredInUnitIds :: Maybe [(PackageName, UnitId)]
+  -- ^ 'UnitId's that the compiler doesn't support reinstalling.
+  -- For instance, when using GHC plugins, one wants to use the
+  -- exact same version of the `ghc` package as the one the
+  -- compiler was linked against.
   }
   deriving (Generic, Show, Read)
 
@@ -244,4 +251,4 @@ abiTagString (AbiTag tag) = tag
 --   compiler id's.
 unknownCompilerInfo :: CompilerId -> AbiTag -> CompilerInfo
 unknownCompilerInfo compilerId abiTag =
-  CompilerInfo compilerId abiTag (Just []) Nothing Nothing
+  CompilerInfo compilerId abiTag (Just []) Nothing Nothing Nothing

Cabal-tests/tests/UnitTests/Distribution/Simple/Program/GHC.hs

@@ -54,6 +54,7 @@ tests = testGroup "Distribution.Simple.Program.GHC"
                       , compilerLanguages = []
                       , compilerExtensions = []
                       , compilerProperties = Map.singleton "Support parallel --make" "YES"
+                      , compilerWiredInUnitIds = Nothing
                       })
                   (Platform X86_64 Linux)
                   (mempty { ghcOptNumJobs = Flag (NumJobs (Just 4)) })

Cabal/src/Distribution/Simple/Compiler.hs

@@ -98,7 +98,9 @@ import Distribution.Pretty
 import Prelude ()
 
 import Distribution.Compiler
+import Distribution.Package (PackageName)
 import Distribution.Simple.Utils
+import Distribution.Types.UnitId (UnitId)
 import Distribution.Utils.Path
 import Distribution.Version
 
@@ -120,6 +122,11 @@ data Compiler = Compiler
   -- ^ Supported language standards.
   , compilerExtensions :: [(Extension, Maybe CompilerFlag)]
   -- ^ Supported extensions.
+  , compilerWiredInUnitIds :: Maybe [(PackageName, UnitId)]
+  -- ^ 'UnitId's that the compiler doesn't support reinstalling.
+  -- For instance, when using GHC plugins, one wants to use the
+  -- exact same version of the `ghc` package as the one the
+  -- compiler was linked against.
   , compilerProperties :: Map String String
   -- ^ A key-value map for properties not covered by the above fields.
   }
@@ -178,6 +185,7 @@ compilerInfo c =
     (Just . compilerCompat $ c)
     (Just . map fst . compilerLanguages $ c)
     (Just . map fst . compilerExtensions $ c)
+    (compilerWiredInUnitIds c)
 
 -- ------------------------------------------------------------
 

Cabal/src/Distribution/Simple/GHC.hs

@@ -247,14 +247,25 @@ configure verbosity hcPath hcPkgPath conf0 = do
       compilerId :: CompilerId
       compilerId = CompilerId GHC ghcVersion
 
+      projectUnitId :: Maybe String
+      projectUnitId = Map.lookup "Project Unit Id" ghcInfoMap
+
       -- The @AbiTag@ is the @Project Unit Id@ but with redundant information from the compiler version removed.
       -- For development versions of the compiler these look like:
       -- @Project Unit Id@: "ghc-9.13-inplace"
       -- @compilerId@: "ghc-9.13.20250413"
       -- So, we need to be careful to only strip the /common/ prefix.
       -- In this example, @AbiTag@ is "inplace".
       compilerAbiTag :: AbiTag
-      compilerAbiTag = maybe NoAbiTag AbiTag (dropWhile (== '-') . stripCommonPrefix (prettyShow compilerId) <$> Map.lookup "Project Unit Id" ghcInfoMap)
+      compilerAbiTag = maybe NoAbiTag AbiTag (dropWhile (== '-') . stripCommonPrefix (prettyShow compilerId) <$> projectUnitId)
+
+      wiredInUnitIds = do
+        ghcInternalUnitId <- Map.lookup "ghc-internal Unit Id" ghcInfoMap
+        ghcUnitId <- projectUnitId
+        pure
+          [ (mkPackageName "ghc", mkUnitId ghcUnitId)
+          , (mkPackageName "ghc-internal", mkUnitId ghcInternalUnitId)
+          ]
 
   let comp =
         Compiler
@@ -264,6 +275,7 @@ configure verbosity hcPath hcPkgPath conf0 = do
           , compilerLanguages = languages
           , compilerExtensions = extensions
           , compilerProperties = ghcInfoMap
+          , compilerWiredInUnitIds = wiredInUnitIds
           }
       compPlatform = Internal.targetPlatform ghcInfo
       -- configure gcc and ld

Cabal/src/Distribution/Simple/GHCJS.hs

@@ -203,6 +203,7 @@ configure verbosity hcPath hcPkgPath conf0 = do
           , compilerLanguages = languages
           , compilerExtensions = extensions
           , compilerProperties = ghcInfoMap
+          , compilerWiredInUnitIds = Nothing
           }
       compPlatform = Internal.targetPlatform ghcjsInfo
   return (comp, compPlatform, progdb3)

Cabal/src/Distribution/Simple/UHC.hs

@@ -78,6 +78,7 @@ configure verbosity hcPath _hcPkgPath progdb = do
           , compilerLanguages = uhcLanguages
           , compilerExtensions = uhcLanguageExtensions
           , compilerProperties = Map.empty
+          , compilerWiredInUnitIds = Nothing
           }
       compPlatform = Nothing
   return (comp, compPlatform, progdb')

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

@@ -295,6 +295,7 @@ showFR _ UnknownPackage                   = " (unknown package)"
 showFR _ (GlobalConstraintVersion vr (ConstraintSourceProjectConfig pc)) = '\n' : (render . nest 6 $ docProjectConfigPathFailReason vr pc)
 showFR _ (GlobalConstraintVersion vr src) = " (" ++ constraintSource src ++ " requires " ++ prettyShow vr ++ ")"
 showFR _ (GlobalConstraintInstalled src)  = " (" ++ constraintSource src ++ " requires installed instance)"
+showFR _ (GlobalConstraintInstalledSpecificUnitId unitId src)  = " (" ++ constraintSource src ++ " requires installed instance with unit id " ++ prettyShow unitId ++ ")"
 showFR _ (GlobalConstraintSource src)     = " (" ++ constraintSource src ++ " requires source instance)"
 showFR _ (GlobalConstraintFlag src)       = " (" ++ constraintSource src ++ " requires opposite flag selection)"
 showFR _ ManualFlag                       = " (manual flag can only be changed explicitly)"

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

@@ -10,6 +10,7 @@ module Distribution.Solver.Modular.Package
   , PN
   , QPV
   , instI
+  , instUid
   , makeIndependent
   , primaryPP
   , setupPP
@@ -77,6 +78,10 @@ instI :: I -> Bool
 instI (I _ (Inst _)) = True
 instI _              = False
 
+instUid :: UnitId -> I -> Bool
+instUid uid (I _ (Inst uid')) = uid == uid'
+instUid _ _ = False
+
 -- | Is the package in the primary group of packages.  This is used to
 -- determine (1) if we should try to establish stanza preferences
 -- for this goal, and (2) whether or not a user specified @--constraint@

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

@@ -190,6 +190,9 @@ processPackageConstraintP qpn c i (LabeledPackageConstraint (PackageConstraint s
     go _       PackagePropertyInstalled
         | instI i       = r
         | otherwise     = Fail c (GlobalConstraintInstalled src)
+    go _       (PackagePropertyInstalledSpecificUnitId unitId)
+        | instUid unitId i       = r
+        | otherwise     = Fail c (GlobalConstraintInstalledSpecificUnitId unitId src)
     go _       PackagePropertySource
         | not (instI i) = r
         | otherwise     = Fail c (GlobalConstraintSource src)

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

@@ -118,6 +118,7 @@ data FailReason = UnsupportedExtension Extension
                 | UnknownPackage
                 | GlobalConstraintVersion VR ConstraintSource
                 | GlobalConstraintInstalled ConstraintSource
+                | GlobalConstraintInstalledSpecificUnitId UnitId ConstraintSource
                 | GlobalConstraintSource ConstraintSource
                 | GlobalConstraintFlag ConstraintSource
                 | ManualFlag