diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs index b510a34d540..aa5d87666dc 100644 --- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs +++ b/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 diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs index 6d2849c5142..56f2381559b 100644 --- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs +++ b/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 diff --git a/Cabal-tests/tests/ParserTests/ipi/Includes2.expr b/Cabal-tests/tests/ParserTests/ipi/Includes2.expr index cc002958c05..4459fffc7f8 100644 --- a/Cabal-tests/tests/ParserTests/ipi/Includes2.expr +++ b/Cabal-tests/tests/ParserTests/ipi/Includes2.expr @@ -9,6 +9,7 @@ InstalledPackageInfo { (UnqualComponentName "mylib"), installedComponentId_ = ComponentId "", + installedSublibs = [], libVisibility = LibraryVisibilityPrivate, installedUnitId = UnitId diff --git a/Cabal-tests/tests/ParserTests/ipi/internal-preprocessor-test.expr b/Cabal-tests/tests/ParserTests/ipi/internal-preprocessor-test.expr index 3c3be058152..a0a9e419216 100644 --- a/Cabal-tests/tests/ParserTests/ipi/internal-preprocessor-test.expr +++ b/Cabal-tests/tests/ParserTests/ipi/internal-preprocessor-test.expr @@ -8,6 +8,7 @@ InstalledPackageInfo { sourceLibName = LMainLibName, installedComponentId_ = ComponentId "", + installedSublibs = [], libVisibility = LibraryVisibilityPublic, installedUnitId = UnitId diff --git a/Cabal-tests/tests/ParserTests/ipi/issue-2276-ghc-9885.expr b/Cabal-tests/tests/ParserTests/ipi/issue-2276-ghc-9885.expr index d5da47695e5..a652d1dcf09 100644 --- a/Cabal-tests/tests/ParserTests/ipi/issue-2276-ghc-9885.expr +++ b/Cabal-tests/tests/ParserTests/ipi/issue-2276-ghc-9885.expr @@ -8,6 +8,7 @@ InstalledPackageInfo { sourceLibName = LMainLibName, installedComponentId_ = ComponentId "", + installedSublibs = [], libVisibility = LibraryVisibilityPublic, installedUnitId = UnitId diff --git a/Cabal-tests/tests/ParserTests/ipi/transformers.expr b/Cabal-tests/tests/ParserTests/ipi/transformers.expr index bcb40470a87..7fd98212897 100644 --- a/Cabal-tests/tests/ParserTests/ipi/transformers.expr +++ b/Cabal-tests/tests/ParserTests/ipi/transformers.expr @@ -8,6 +8,7 @@ InstalledPackageInfo { sourceLibName = LMainLibName, installedComponentId_ = ComponentId "", + installedSublibs = [], libVisibility = LibraryVisibilityPublic, installedUnitId = UnitId diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index 93ec21c5b9f..bb3a18e9ec7 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/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 diff --git a/Cabal/src/Distribution/Simple/Register.hs b/Cabal/src/Distribution/Simple/Register.hs index 3e603a14d6a..599af063894 100644 --- a/Cabal/src/Distribution/Simple/Register.hs +++ b/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) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs index 0e2e8ad5baa..e306631aa5a 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs +++ b/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 diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs index fff2dacde4e..3b0fe5a95eb 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs +++ b/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. diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs index 2f28d12de85..e04b62dd0c7 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs +++ b/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 { diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs index f150235631f..04ec19ba6fc 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs +++ b/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 diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs index 5dbcce9194c..03c8afb2663 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs +++ b/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 diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs index 876ac2d790c..9cda3734465 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Package.hs @@ -22,12 +22,16 @@ module Distribution.Solver.Modular.Package import Prelude () import Distribution.Solver.Compat.Prelude +import qualified Data.List as L +import qualified Data.Set as S + import Distribution.Package -- from Cabal import Distribution.Pretty (prettyShow) import Distribution.Solver.Modular.Version import Distribution.Solver.Types.PackagePath + -- | A package name. type PN = PackageName @@ -49,7 +53,10 @@ type PId = UnitId -- package instance via its 'PId'. -- -- TODO: More information is needed about the repo. -data Loc = Inst PId | InRepo +data Loc + = Inst PId + | InstGroup PId (Set PId) + | InRepo deriving (Eq, Ord, Show) -- | Instance. A version number and a location. @@ -57,14 +64,29 @@ data I = I Ver Loc deriving (Eq, Ord, Show) -- | String representation of an instance. -showI :: I -> String -showI (I v InRepo) = showVer v -showI (I v (Inst uid)) = showVer v ++ "/installed" ++ extractPackageAbiHash uid - where - extractPackageAbiHash xs = - case first reverse $ break (=='-') $ reverse (prettyShow xs) of - (ys, []) -> ys - (ys, _) -> '-' : ys +showI :: QPN -> I -> String +showI _qpn (I v InRepo) = showVer v +showI qpn (I v (Inst uid)) = + let + uidPrefix = showQPN qpn <> "-" <> showVer v <> "-" + renderUid u = + case L.stripPrefix uidPrefix (prettyShow u) of + Nothing -> showVer v + Just stripped -> stripped + in + showVer v <> "/installed-" <> renderUid uid +showI qpn (I v (InstGroup uid subUids)) = + let + uidPrefix = showQPN qpn <> "-" <> showVer v <> "-" + renderUid u = + case L.stripPrefix uidPrefix (prettyShow u) of + Nothing -> prettyShow u + Just stripped -> stripped + in + showI qpn (I v (Inst uid)) + <> " installed package group [" + <> unwords (map renderUid $ S.toList subUids) + <> "]" -- | Package instance. A package name and an instance. data PI qpn = PI qpn I @@ -72,7 +94,7 @@ data PI qpn = PI qpn I -- | String representation of a package instance. showPI :: PI QPN -> String -showPI (PI qpn i) = showQPN qpn ++ "-" ++ showI i +showPI (PI qpn i) = showQPN qpn ++ "-" ++ showI qpn i instI :: I -> Bool instI (I _ (Inst _)) = True diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs index ed01234bdba..88d494d4396 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs @@ -129,6 +129,7 @@ type PPreAssignment = Map QPN MergedPkgDep -- | A dependency on a component, including its DependencyReason. data PkgDep = PkgDep (DependencyReason QPN) (PkgComponent QPN) CI + deriving Show -- | Map from component name to one of the reasons that the component is -- required. @@ -146,6 +147,7 @@ type ComponentDependencyReasons = Map ExposedComponent (DependencyReason QPN) data MergedPkgDep = MergedDepFixed ExposedComponent (DependencyReason QPN) I | MergedDepConstrained [VROrigin] + deriving Show -- | Version ranges paired with origins. type VROrigin = (VR, ExposedComponent, DependencyReason QPN) diff --git a/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs b/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs index 871a0dd15a9..719ac0ea2ef 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs @@ -6,12 +6,9 @@ module Distribution.Solver.Types.InstSolverPackage import Distribution.Solver.Compat.Prelude import Prelude () -import Distribution.Package ( Package(..), HasMungedPackageId(..), HasUnitId(..) ) +import Distribution.Package ( Package(..), HasUnitId(..) ) import Distribution.Solver.Types.ComponentDeps ( ComponentDeps ) import Distribution.Solver.Types.SolverId -import Distribution.Types.MungedPackageId -import Distribution.Types.PackageId -import Distribution.Types.MungedPackageName import Distribution.InstalledPackageInfo (InstalledPackageInfo) -- | An 'InstSolverPackage' is a pre-existing installed package @@ -27,13 +24,7 @@ instance Binary InstSolverPackage instance Structured InstSolverPackage instance Package InstSolverPackage where - packageId i = - -- HACK! See Note [Index conversion with internal libraries] - let MungedPackageId mpn v = mungedId i - in PackageIdentifier (encodeCompatPackageName mpn) v - -instance HasMungedPackageId InstSolverPackage where - mungedId = mungedId . instSolverPkgIPI + packageId = packageId . instSolverPkgIPI instance HasUnitId InstSolverPackage where installedUnitId = installedUnitId . instSolverPkgIPI diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 5ec48a249aa..aeb478e67ad 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -1672,18 +1672,19 @@ elaborateInstallPlan preexistingInstantiatedPkgs :: Map UnitId FullUnitId preexistingInstantiatedPkgs = - Map.fromList (mapMaybe f (SolverInstallPlan.toList solverPlan)) + Map.fromList (concat $ mapMaybe f (SolverInstallPlan.toList solverPlan)) where f (SolverInstallPlan.PreExisting inst) | let ipkg = instSolverPkgIPI inst , not (IPI.indefinite ipkg) = - Just - ( IPI.installedUnitId ipkg - , ( FullUnitId - (IPI.installedComponentId ipkg) - (Map.fromList (IPI.instantiatedWith ipkg)) - ) - ) + let mkEntry x = + ( IPI.installedUnitId x + , ( FullUnitId + (IPI.installedComponentId x) + (Map.fromList (IPI.instantiatedWith x)) + ) + ) + in Just $ (mkEntry ipkg) : (map mkEntry (IPI.installedSublibs ipkg)) f _ = Nothing elaboratedInstallPlan @@ -1692,7 +1693,9 @@ elaborateInstallPlan flip InstallPlan.fromSolverInstallPlanWithProgress solverPlan $ \mapDep planpkg -> case planpkg of SolverInstallPlan.PreExisting pkg -> - return [InstallPlan.PreExisting (instSolverPkgIPI pkg)] + return $ + [InstallPlan.PreExisting (instSolverPkgIPI pkg)] + ++ map InstallPlan.PreExisting (IPI.installedSublibs (instSolverPkgIPI pkg)) SolverInstallPlan.Configured pkg -> let inplace_doc | shouldBuildInplaceOnly pkg = text "inplace" @@ -2675,12 +2678,7 @@ shouldBeLocal (SpecificSourcePackage pkg) = case srcpkgSource pkg of -- | Given a 'ElaboratedPlanPackage', report if it matches a 'ComponentName'. matchPlanPkg :: (ComponentName -> Bool) -> ElaboratedPlanPackage -> Bool -matchPlanPkg p = InstallPlan.foldPlanPackage (p . ipiComponentName) (matchElabPkg p) - --- | Get the appropriate 'ComponentName' which identifies an installed --- component. -ipiComponentName :: IPI.InstalledPackageInfo -> ComponentName -ipiComponentName = CLibName . IPI.sourceLibName +matchPlanPkg p = InstallPlan.foldPlanPackage (p . IPI.sourceComponentName) (matchElabPkg p) -- | Given a 'ElaboratedConfiguredPackage', report if it matches a -- 'ComponentName'. @@ -2712,7 +2710,7 @@ mkCCMapping = ( \ipkg -> ( packageName ipkg , Map.singleton - (ipiComponentName ipkg) + (IPI.sourceComponentName ipkg) -- TODO: libify ( AnnotatedId { ann_id = IPI.installedComponentId ipkg @@ -3174,7 +3172,7 @@ availableInstalledTargets ipkg = status = TargetBuildable (unitid, cname) TargetRequestedByDefault target = AvailableTarget (packageId ipkg) cname status False fake = False - in [(packageId ipkg, cname, fake, target)] + in (packageId ipkg, cname, fake, target) : (concatMap availableInstalledTargets (IPI.installedSublibs ipkg)) availableSourceTargets :: ElaboratedConfiguredPackage @@ -3637,10 +3635,11 @@ pruneInstallPlanPass1 pkgs ] availablePkgs = - Set.fromList - [ installedUnitId pkg - | InstallPlan.PreExisting pkg <- pkgs - ] + Set.fromList $ + concat + [ (installedUnitId pkg) : (map installedUnitId (IPI.installedSublibs pkg)) + | InstallPlan.PreExisting pkg <- pkgs + ] {- Note [Pruning for Multi Repl] diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index 9ea020bd512..ef1d8da532b 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -932,7 +932,7 @@ tests = , runTest $ let db = [ Right $ exAv "my-package" 1 [ExFix "other-package" 3] - , Left $ exInst "other-package" 2 "other-package-AbCdEfGhIj0123456789" [] + , Left $ exInst "other-package" 2 "other-package-2-AbCdEfGhIj0123456789" [] ] msg = "rejecting: other-package-2/installed-AbCdEfGhIj0123456789" in mkTest db "show full installed package ABI hash (issue #5892)" ["my-package"] $ diff --git a/cabal.project b/cabal.project index a2075cfdc29..cc64225a0e4 100644 --- a/cabal.project +++ b/cabal.project @@ -12,3 +12,5 @@ package cabal-install package Cabal flags: +git-rev + +multi-repl: True