Group installed multilib packages

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

@@ -42,6 +42,7 @@ data InstalledPackageInfo = InstalledPackageInfo
     sourcePackageId :: PackageId
   , sourceLibName :: LibraryName
   , installedComponentId_ :: ComponentId
+  , installedSublibs :: [InstalledPackageInfo]
   , libVisibility :: LibraryVisibility
   , installedUnitId :: UnitId
   , -- INVARIANT: if this package is definite, OpenModule's
@@ -135,6 +136,7 @@ emptyInstalledPackageInfo =
     , sourceLibName = LMainLibName
     , installedComponentId_ = mkComponentId ""
     , installedUnitId = mkUnitId ""
+    , installedSublibs = mempty
     , instantiatedWith = []
     , compatPackageKey = ""
     , license = Left SPDX.NONE

Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs

@@ -134,6 +134,7 @@ ipiFieldGrammar =
         (PackageIdentifier pn _basicVersion)
         (combineLibraryName ln _basicLibName)
         (mkComponentId "") -- installedComponentId_, not in use
+        mempty -- installedSublibs
         _basicLibVisibility
       where
         MungedPackageName pn ln = _basicName

Cabal-tests/tests/ParserTests/ipi/Includes2.expr

@@ -9,6 +9,7 @@ InstalledPackageInfo {
     (UnqualComponentName "mylib"),
   installedComponentId_ =
   ComponentId "",
+  installedSublibs = [],
   libVisibility =
   LibraryVisibilityPrivate,
   installedUnitId = UnitId

Cabal-tests/tests/ParserTests/ipi/internal-preprocessor-test.expr

@@ -8,6 +8,7 @@ InstalledPackageInfo {
   sourceLibName = LMainLibName,
   installedComponentId_ =
   ComponentId "",
+  installedSublibs = [],
   libVisibility =
   LibraryVisibilityPublic,
   installedUnitId = UnitId

Cabal-tests/tests/ParserTests/ipi/issue-2276-ghc-9885.expr

@@ -8,6 +8,7 @@ InstalledPackageInfo {
   sourceLibName = LMainLibName,
   installedComponentId_ =
   ComponentId "",
+  installedSublibs = [],
   libVisibility =
   LibraryVisibilityPublic,
   installedUnitId = UnitId

Cabal-tests/tests/ParserTests/ipi/transformers.expr

@@ -8,6 +8,7 @@ InstalledPackageInfo {
   sourceLibName = LMainLibName,
   installedComponentId_ =
   ComponentId "",
+  installedSublibs = [],
   libVisibility =
   LibraryVisibilityPublic,
   installedUnitId = UnitId

Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs

@@ -33,4 +33,4 @@ md5CheckGenericPackageDescription proxy = md5Check proxy
 
 md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion
 md5CheckLocalBuildInfo proxy = md5Check proxy
-    0x78979713e08179ab070d6ab10cd5ef6c
+    0x31137cc4853f0380d1f18eb165d746df

Cabal/src/Distribution/Simple/Register.hs

@@ -502,6 +502,7 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi
     { IPI.sourcePackageId = packageId pkg
     , IPI.installedUnitId = componentUnitId clbi
     , IPI.installedComponentId_ = componentComponentId clbi
+    , IPI.installedSublibs = mempty
     , IPI.instantiatedWith = expectLibraryComponent (maybeComponentInstantiatedWith clbi)
     , IPI.sourceLibName = libName lib
     , IPI.compatPackageKey = expectLibraryComponent (maybeComponentCompatPackageKey clbi)

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

@@ -5,8 +5,11 @@ module Distribution.Solver.Modular.ConfiguredConversion
 import Data.Maybe
 import Prelude hiding (pi)
 import Data.Either (partitionEithers)
+import Data.Set (Set)
+import qualified Data.Set as S
 
 import Distribution.Package (UnitId, packageId)
+import Distribution.Types.InstalledPackageInfo (InstalledPackageInfo(installedSublibs))
 
 import qualified Distribution.Simple.PackageIndex as SI
 
@@ -30,9 +33,10 @@ convCP :: SI.InstalledPackageIndex ->
           CP QPN -> ResolverPackage loc
 convCP iidx sidx (CP qpi fa es ds) =
   case convPI qpi of
-    Left  pi -> PreExisting $
+    Left (pi, subPis) ->
+                PreExisting $
                   InstSolverPackage {
-                    instSolverPkgIPI = fromJust $ SI.lookupUnitId iidx pi,
+                    instSolverPkgIPI = addSublibs iidx subPis $ fromJust $ SI.lookupUnitId iidx pi,
                     instSolverPkgLibDeps = fmap fst ds',
                     instSolverPkgExeDeps = fmap snd ds'
                   }
@@ -50,15 +54,29 @@ convCP iidx sidx (CP qpi fa es ds) =
     ds' :: ComponentDeps ([SolverId] {- lib -}, [SolverId] {- exe -})
     ds' = fmap (partitionEithers . map convConfId) ds
 
-convPI :: PI QPN -> Either UnitId PackageId
-convPI (PI _ (I _ (Inst pi))) = Left pi
-convPI pi                     = Right (packageId (either id id (convConfId pi)))
+    addSublibs
+      :: SI.InstalledPackageIndex
+      -> Set UnitId
+      -> InstalledPackageInfo
+      -> InstalledPackageInfo
+    addSublibs idx subPis info =
+      info { installedSublibs =
+               mapMaybe
+                 (SI.lookupUnitId idx)
+                 (S.toList subPis)
+           }
+
+convPI :: PI QPN -> Either (UnitId, Set UnitId) PackageId
+convPI (PI _ (I _ (Inst pi)))             = Left (pi, mempty)
+convPI (PI _ (I _ (InstGroup pi subPis))) = Left (pi, subPis)
+convPI pi                                 = Right (packageId (either id id (convConfId pi)))
 
 convConfId :: PI QPN -> Either SolverId {- is lib -} SolverId {- is exe -}
 convConfId (PI (Q (PackagePath _ q) pn) (I v loc)) =
     case loc of
         Inst pi -> Left (PreExistingId sourceId pi)
-        _otherwise
+        InstGroup pi _subPis -> Left (PreExistingId sourceId pi)
+        InRepo
           | QualExe _ pn' <- q
           -- NB: the dependencies of the executable are also
           -- qualified.  So the way to tell if this is an executable

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

@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE StandaloneDeriving #-}
 module Distribution.Solver.Modular.Dependency (
     -- * Variables
     Var(..)
@@ -94,6 +95,8 @@ data FlaggedDep qpn =
     -- | Dependencies which are always enabled, for the component 'comp'.
   | Simple (LDep qpn) Component
 
+deriving instance Show qpn => Show (FlaggedDep qpn)
+
 -- | Conservatively flatten out flagged dependencies
 --
 -- NOTE: We do not filter out duplicates.
@@ -115,6 +118,7 @@ type FalseFlaggedDeps qpn = FlaggedDeps qpn
 -- depending; having a 'Functor' instance makes bugs where we don't distinguish
 -- these two far too likely. (By rights 'LDep' ought to have two type variables.)
 data LDep qpn = LDep (DependencyReason qpn) (Dep qpn)
+  deriving Show
 
 -- | A dependency (constraint) associates a package name with a constrained
 -- instance. It can also represent other types of dependencies, such as
@@ -123,7 +127,7 @@ data Dep qpn = Dep (PkgComponent qpn) CI  -- ^ dependency on a package component
              | Ext Extension              -- ^ dependency on a language extension
              | Lang Language              -- ^ dependency on a language version
              | Pkg PkgconfigName PkgconfigVersionRange  -- ^ dependency on a pkg-config package
-  deriving Functor
+  deriving (Functor, Show)
 
 -- | An exposed component within a package. This type is used to represent
 -- build-depends and build-tool-depends dependencies.

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

@@ -36,6 +36,7 @@ data PInfo = PInfo (FlaggedDeps PN)
                    (Map ExposedComponent ComponentInfo)
                    FlagInfo
                    (Maybe FailReason)
+  deriving Show
 
 -- | Info associated with each library and executable in a package instance.
 data ComponentInfo = ComponentInfo {

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

@@ -6,6 +6,7 @@ import Distribution.Solver.Compat.Prelude
 import Prelude ()
 
 import qualified Data.List as L
+import qualified Data.Maybe
 import qualified Data.Map.Strict as M
 import qualified Distribution.Compat.NonEmptySet as NonEmptySet
 import qualified Data.Set as S
@@ -18,8 +19,6 @@ import Distribution.Types.ExeDependency              -- from Cabal
 import Distribution.Types.PkgconfigDependency        -- from Cabal
 import Distribution.Types.ComponentName              -- from Cabal
 import Distribution.Types.CondTree                   -- from Cabal
-import Distribution.Types.MungedPackageId            -- from Cabal
-import Distribution.Types.MungedPackageName          -- from Cabal
 import Distribution.PackageDescription               -- from Cabal
 import Distribution.PackageDescription.Configuration
 import qualified Distribution.Simple.PackageIndex as SI
@@ -62,7 +61,80 @@ convPIs :: OS -> Arch -> CompilerInfo -> Map PN [LabeledPackageConstraint]
         -> Index
 convPIs os arch comp constraints sip strfl solveExes iidx sidx =
   mkIndex $
-  convIPI' sip iidx ++ convSPI' os arch comp constraints strfl solveExes sidx
+       groupInstalledSublibs (convIPI' sip iidx)
+    ++ (convSPI' os arch comp constraints strfl solveExes sidx)
+
+-- | Group packages with the same package name and version,
+-- merge their sub-libraries and dependencies so we get
+-- a similar looking package as if it came from repository.
+groupInstalledSublibs
+  :: [(PN, I, PInfo)]
+  -> [(PN, I, PInfo)]
+groupInstalledSublibs xs =
+    remapPInfoDepsToInstGroups
+  $ M.elems
+  $ foldl
+      (\acc x@(pn, I ver _, _) ->
+        M.insertWith
+          (\(_, newI, newInfo) (_, oldI, oldInfo) ->
+            (pn, mergeIs oldI newI, mergeInfos oldInfo newInfo)
+          )
+          (pn, ver)
+          x
+          acc
+      )
+      M.empty
+      xs
+  where
+  -- flags are probably safe to ignore here as they are fixed for installed anyway
+  mergeInfos :: PInfo -> PInfo -> PInfo
+  mergeInfos (PInfo deps comps flagNfo fr) (PInfo deps' comps' _flagNfo _fr) =
+    PInfo
+      (deps <> deps')
+      (comps <> comps')
+      flagNfo
+      fr
+
+  -- this pass creates InstGroup(s)
+  mergeIs :: I -> I -> I
+  mergeIs (I ver (Inst pId)) (I _ver (Inst subPId)) =
+    I ver (InstGroup pId (S.singleton subPId))
+  mergeIs (I ver (InstGroup pId subPIds)) (I _ver (Inst subPId)) =
+    I ver (InstGroup pId (S.insert subPId subPIds))
+  -- XXX/srk, can't really happen as they are lexicographically ordered
+  mergeIs a b = error $ "Absurd mergeIs" <> show (a,b)
+
+  -- now some deps from convIP/convIPId pass refer to Inst when they should refer to InstGroup
+  remapPInfoDepsToInstGroups :: [(PN, I, PInfo)] -> [(PN, I, PInfo)]
+  remapPInfoDepsToInstGroups ps =
+    let
+      -- Inst -> InstGroup mapping, other Loc(s) are preserved
+      locMap :: Map Loc Loc
+      locMap =
+          M.fromList
+        $ concatMap
+            (\(_pn, I _ver loc, _pInfo) -> case loc of
+              ip@(Inst _pId) ->
+                pure (ip, ip)
+              g@(InstGroup pId subPIds) ->
+                (Inst pId, g):(map (\x -> (Inst x, g)) (S.toList subPIds))
+              InRepo ->
+                pure (InRepo, InRepo)
+            )
+            ps
+
+      remapDep :: FlaggedDep PN -> FlaggedDep PN
+      remapDep (D.Simple (LDep dr (Dep depComp (Fixed (I ver loc)))) comp) =
+        let newLoc = Data.Maybe.fromJust $ M.lookup loc locMap
+        in  (D.Simple (LDep dr (Dep depComp (Fixed (I ver newLoc)))) comp)
+      remapDep x = x
+
+    in map
+        (\(pn, i, PInfo deps comps flagNfo fr) ->
+          (pn, i, PInfo (map remapDep deps) comps flagNfo fr)
+        )
+        ps
+
 
 -- | Convert a Cabal installed package index to the simpler,
 -- more uniform index format of the solver.
@@ -71,8 +143,7 @@ convIPI' (ShadowPkgs sip) idx =
     -- apply shadowing whenever there are multiple installed packages with
     -- the same version
     [ maybeShadow (convIP idx pkg)
-    -- IMPORTANT to get internal libraries. See
-    -- Note [Index conversion with internal libraries]
+    -- IMPORTANT to use @allPackagesBySourcePackageIdAndLibName@ to get internal libraries
     | (_, pkgs) <- SI.allPackagesBySourcePackageIdAndLibName idx
     , (maybeShadow, pkg) <- zip (id : repeat shadow) pkgs ]
   where
@@ -84,21 +155,23 @@ convIPI' (ShadowPkgs sip) idx =
 
 -- | Extract/recover the package ID from an installed package info, and convert it to a solver's I.
 convId :: IPI.InstalledPackageInfo -> (PN, I)
-convId ipi = (pn, I ver $ Inst $ IPI.installedUnitId ipi)
-  where MungedPackageId mpn ver = mungedId ipi
-        -- HACK. See Note [Index conversion with internal libraries]
-        pn = encodeCompatPackageName mpn
+convId ipi = ( pkgName spi
+             , I (pkgVersion spi) $ Inst $ IPI.installedUnitId ipi
+             )
+ where spi = IPI.sourcePackageId ipi
 
 -- | Convert a single installed package into the solver-specific format.
-convIP :: SI.InstalledPackageIndex -> IPI.InstalledPackageInfo -> (PN, I, PInfo)
+convIP
+  :: SI.InstalledPackageIndex
+  -> IPI.InstalledPackageInfo
+  -> (PN, I, PInfo)
 convIP idx ipi =
   case traverse (convIPId (DependencyReason pn M.empty S.empty) comp idx) (IPI.depends ipi) of
         Left u    -> (pn, i, PInfo [] M.empty M.empty (Just (Broken u)))
         Right fds -> (pn, i, PInfo fds components M.empty Nothing)
  where
-  -- TODO: Handle sub-libraries and visibility.
   components =
-      M.singleton (ExposedLib LMainLibName)
+      M.singleton (ExposedLib $ IPI.sourceLibName ipi)
                   ComponentInfo {
                       compIsVisible = IsVisible True
                     , compIsBuildable = IsBuildable True
@@ -111,45 +184,22 @@ convIP idx ipi =
   comp = componentNameToComponent $ CLibName $ IPI.sourceLibName ipi
 -- TODO: Installed packages should also store their encapsulations!
 
--- Note [Index conversion with internal libraries]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- Something very interesting happens when we have internal libraries
--- in our index.  In this case, we maybe have p-0.1, which itself
--- depends on the internal library p-internal ALSO from p-0.1.
--- Here's the danger:
---
---      - If we treat both of these packages as having PN "p",
---        then the solver will try to pick one or the other,
---        but never both.
---
---      - If we drop the internal packages, now p-0.1 has a
---        dangling dependency on an "installed" package we know
---        nothing about. Oops.
---
--- An expedient hack is to put p-internal into cabal-install's
--- index as a MUNGED package name, so that it doesn't conflict
--- with anyone else (except other instances of itself).  But
--- yet, we ought NOT to say that PNs in the solver are munged
--- package names, because they're not; for source packages,
--- we really will never see munged package names.
---
--- The tension here is that the installed package index is actually
--- per library, but the solver is per package.  We need to smooth
--- it over, and munging the package names is a pretty good way to
--- do it.
-
 -- | Convert dependencies specified by an installed package id into
 -- flagged dependencies of the solver.
 --
 -- May return Nothing if the package can't be found in the index. That
 -- indicates that the original package having this dependency is broken
 -- and should be ignored.
-convIPId :: DependencyReason PN -> Component -> SI.InstalledPackageIndex -> UnitId -> Either UnitId (FlaggedDep PN)
+convIPId :: DependencyReason PN
+  -> Component
+  -> SI.InstalledPackageIndex
+  -> UnitId
+  -> Either UnitId (FlaggedDep PN)
 convIPId dr comp idx ipid =
   case SI.lookupUnitId idx ipid of
     Nothing  -> Left ipid
     Just ipi -> let (pn, i) = convId ipi
-                    name = ExposedLib LMainLibName  -- TODO: Handle sub-libraries.
+                    name = ExposedLib $ IPI.sourceLibName ipi
                 in  Right (D.Simple (LDep dr (Dep (PkgComponent pn name) (Fixed i))) comp)
                 -- NB: something we pick up from the
                 -- InstalledPackageIndex is NEVER an executable

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

@@ -289,7 +289,7 @@ showOptions q [x] = showOption q x
 showOptions q xs = showQPN q ++ "; " ++ (L.intercalate ", "
   [if isJust linkedTo
     then showOption q x
-    else showI i -- Don't show the package, just the version
+    else showI q i -- Don't show the package, just the version
   | x@(POption i linkedTo) <- xs
   ])
 
@@ -351,7 +351,7 @@ showConflictingDep (ConflictingDep dr (PkgComponent qpn comp) ci) =
                        ExposedLib (LSubLibName lib) -> " (lib " ++ unUnqualComponentName lib ++ ")"
   in case ci of
        Fixed i        -> (if qpn /= qpn' then showDependencyReason dr ++ " => " else "") ++
-                         showQPN qpn ++ componentStr ++ "==" ++ showI i
+                         showQPN qpn ++ componentStr ++ "==" ++ showI qpn i
        Constrained vr -> showDependencyReason dr ++ " => " ++ showQPN qpn ++
                          componentStr ++ showVR vr