Visibility: handle multiple units with the same name

Fixes #16228. The included test case is adapted from the reproduction in
the issue, and fails without this patch.

------

We compute an initial visilibity mapping for units based on what is
present in the package databases. To seed this, we compute a set of all
the package configs to add visibilities for.

However, this set was keyed off the unit's *package name*. This is
correct, since we compare packages across databases by version. However,
we would only ever consider a single, most-preferable unit from the
database in which it was found.

The effect of this was that only one of the libraries in a Cabal package
would be added to this initial set. This would cause attempts to use
modules from the omitted libraries to fail, claiming that the package
was hidden (even though `ghc-pkg` would correctly show it as visible).

A solution is to do the selection of the most preferable packages
separately, and then be sure to consider exposing all units in the
same package in the same package db. We can do this by picking a
most-preferable unit for each package name, and then considering
exposing all units that are equi-preferable with that unit.

------

Why wasn't this bug apparent to all people trying to use sub-libraries
in Cabal? The answer is that Cabal explicitly passes `-package` and
`-package-id` flags for all the packages it wants to use, rather than
relying on the state of the package database. So this bug only really
affects people who are trying to use package databases produced by Cabal
outside of Cabal itself.

One particular example of this is the way that the
Nixpkgs Haskell infrastructure provides wrapped GHCs: typically these
are equipped with a package database containing all the needed
package dependencies, and the user is not expected to pass
`-package` flags explicitly.

1 files changed, 32 insertions, 13 deletions

diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index 8c81d82d78..2275267d14 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -1456,23 +1456,42 @@ mkPackageState dflags dbs preload0 = do
   let prelim_pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs1
 
   --
-  -- Calculate the initial set of packages, prior to any package flags.
-  -- This set contains the latest version of all valid (not unusable) packages,
-  -- or is empty if we have -hide-all-packages
+  -- Calculate the initial set of units from package databases, prior to any package flags.
   --
-  let preferLater pkg pkg' =
-        case compareByPreference prec_map pkg pkg' of
-            GT -> pkg
-            _  -> pkg'
-      calcInitial m pkg = addToUDFM_C preferLater m (fsPackageName pkg) pkg
-      initial = if gopt Opt_HideAllPackages dflags
+  -- Conceptually, we select the latest versions of all valid (not unusable) *packages*
+  -- (not units). This is empty if we have -hide-all-packages.
+  --
+  -- Then we create an initial visibility map with default visibilities for all
+  -- exposed, definite units which belong to the latest valid packages.
+  --
+  let preferLater unit unit' =
+        case compareByPreference prec_map unit unit' of
+            GT -> unit
+            _  -> unit'
+      addIfMorePreferable m unit = addToUDFM_C preferLater m (fsPackageName unit) unit
+      -- This is the set of maximally preferable packages. In fact, it is a set of
+      -- most preferable *units* keyed by package name, which act as stand-ins in 
+      -- for "a package in a database". We use units here because we don't have 
+      -- "a package in a database" as a type currently.
+      mostPreferablePackageReps = if gopt Opt_HideAllPackages dflags
                     then emptyUDFM
-                    else foldl' calcInitial emptyUDFM pkgs1
-      vis_map1 = foldUDFM (\p vm ->
+                    else foldl' addIfMorePreferable emptyUDFM pkgs1
+      -- When exposing units, we want to consider all of those in the most preferable
+      -- packages. We can implement that by looking for units that are equi-preferable
+      -- with the most preferable unit for package. Being equi-preferable means that
+      -- they must be in the same database, with the same version, and the same pacakge name.
+      --
+      -- We must take care to consider all these units and not just the most 
+      -- preferable one, otherwise we can end up with problems like #16228.
+      mostPreferable u =
+        case lookupUDFM mostPreferablePackageReps (fsPackageName u) of
+          Nothing -> False
+          Just u' -> compareByPreference prec_map u u' == EQ
+      vis_map1 = foldl' (\vm p ->
                             -- Note: we NEVER expose indefinite packages by
                             -- default, because it's almost assuredly not
                             -- what you want (no mix-in linking has occurred).
-                            if exposed p && unitIdIsDefinite (packageConfigId p)
+                            if exposed p && unitIdIsDefinite (packageConfigId p) && mostPreferable p
                                then Map.insert (packageConfigId p)
                                                UnitVisibility {
                                                  uv_expose_all = True,
@@ -1483,7 +1502,7 @@ mkPackageState dflags dbs preload0 = do
                                                }
                                                vm
                                else vm)
-                         Map.empty initial
+                         Map.empty pkgs1
 
   --
   -- Compute a visibility map according to the command-line flags (-package,