Skip to content

Commit d59d2b4

Browse files
committed
Solver: Support dependencies on sub-libraries (issue haskell#6039).
This commit tracks dependencies on sub-libraries by extending the functionality for tracking executables that was added in e86f838. It also starts adding support for library visibility, though it currently only works for source packages. There is a TODO for handling installed packages. This commit handles visibility similarly to the way that the buildable field is handled currently. It only checks whether a component is made private by the current environment and flag constraints at the start of dependency solving. This means that the solver can treat a component as visible when the visibility is controlled by an automatic flag, and the build can fail later, depending on the value that is chosen for the flag. Fixes haskell#6038.
1 parent 26fef05 commit d59d2b4

File tree

6 files changed

+139
-67
lines changed

6 files changed

+139
-67
lines changed

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

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,7 @@ import qualified Distribution.Solver.Modular.ConflictSet as CS
5555

5656
import Distribution.Solver.Types.ComponentDeps (Component(..))
5757
import Distribution.Solver.Types.PackagePath
58+
import Distribution.Types.LibraryName
5859
import Distribution.Types.PkgconfigVersionRange
5960
import Distribution.Types.UnqualComponentName
6061

@@ -131,7 +132,9 @@ data PkgComponent qpn = PkgComponent qpn ExposedComponent
131132

132133
-- | A component that can be depended upon by another package, i.e., a library
133134
-- or an executable.
134-
data ExposedComponent = ExposedLib | ExposedExe UnqualComponentName
135+
data ExposedComponent =
136+
ExposedLib LibraryName
137+
| ExposedExe UnqualComponentName
135138
deriving (Eq, Ord, Show)
136139

137140
-- | The reason that a dependency is active. It identifies the package and any
@@ -185,7 +188,7 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
185188
-- Suppose package B has a setup dependency on package A.
186189
-- This will be recorded as something like
187190
--
188-
-- > LDep (DependencyReason "B") (Dep (PkgComponent "A" ExposedLib) (Constrained AnyVersion))
191+
-- > LDep (DependencyReason "B") (Dep (PkgComponent "A" (ExposedLib LMainLibName)) (Constrained AnyVersion))
189192
--
190193
-- Observe that when we qualify this dependency, we need to turn that
191194
-- @"A"@ into @"B-setup.A"@, but we should not apply that same qualifier
@@ -199,7 +202,7 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
199202
goD (Pkg pkn vr) _ = Pkg pkn vr
200203
goD (Dep dep@(PkgComponent qpn (ExposedExe _)) ci) _ =
201204
Dep (Q (PackagePath ns (QualExe pn qpn)) <$> dep) ci
202-
goD (Dep dep@(PkgComponent qpn ExposedLib) ci) comp
205+
goD (Dep dep@(PkgComponent qpn (ExposedLib _)) ci) comp
203206
| qBase qpn = Dep (Q (PackagePath ns (QualBase pn)) <$> dep) ci
204207
| qSetup comp = Dep (Q (PackagePath ns (QualSetup pn)) <$> dep) ci
205208
| otherwise = Dep (Q (PackagePath ns inheritedQ ) <$> dep) ci

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

Lines changed: 17 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
11
module Distribution.Solver.Modular.Index
22
( Index
33
, PInfo(..)
4+
, ComponentInfo(..)
5+
, IsVisible(..)
46
, IsBuildable(..)
57
, defaultQualifyOptions
68
, mkIndex
@@ -28,10 +30,24 @@ type Index = Map PN (Map I PInfo)
2830
-- globally, for reasons external to the solver. We currently use this
2931
-- for shadowing which essentially is a GHC limitation, and for
3032
-- installed packages that are broken.
31-
data PInfo = PInfo (FlaggedDeps PN) (Map ExposedComponent IsBuildable) FlagInfo (Maybe FailReason)
33+
data PInfo = PInfo (FlaggedDeps PN)
34+
(Map ExposedComponent ComponentInfo)
35+
FlagInfo
36+
(Maybe FailReason)
37+
38+
-- | Info associated with each library and executable in a package instance.
39+
data ComponentInfo = ComponentInfo {
40+
compIsVisible :: IsVisible
41+
, compIsBuildable :: IsBuildable
42+
}
43+
44+
-- | Whether a component is visible in the current environment.
45+
newtype IsVisible = IsVisible Bool
46+
deriving Eq
3247

3348
-- | Whether a component is made unbuildable by a "buildable: False" field.
3449
newtype IsBuildable = IsBuildable Bool
50+
deriving Eq
3551

3652
mkIndex :: [(PN, I, PInfo)] -> Index
3753
mkIndex xs = M.map M.fromList (groupMap (L.map (\ (pn, i, pi) -> (pn, (i, pi))) xs))

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

Lines changed: 66 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ import Distribution.PackageDescription.Configuration as PDC
2626
import qualified Distribution.Simple.PackageIndex as SI
2727
import Distribution.System
2828
import Distribution.Types.ForeignLib
29+
import Distribution.Types.LibraryVisibility
2930

3031
import Distribution.Solver.Types.ComponentDeps
3132
( Component(..), componentNameToComponent )
@@ -93,11 +94,18 @@ convIP :: SI.InstalledPackageIndex -> InstalledPackageInfo -> (PN, I, PInfo)
9394
convIP idx ipi =
9495
case mapM (convIPId (DependencyReason pn M.empty S.empty) comp idx) (IPI.depends ipi) of
9596
Nothing -> (pn, i, PInfo [] M.empty M.empty (Just Broken))
96-
Just fds -> ( pn
97-
, i
98-
, PInfo fds (M.singleton ExposedLib (IsBuildable True)) M.empty Nothing)
97+
Just fds -> ( pn, i, PInfo fds components M.empty Nothing)
9998
where
99+
-- TODO: Handle sub-libraries and visibility.
100+
components =
101+
M.singleton (ExposedLib LMainLibName)
102+
ComponentInfo {
103+
compIsVisible = IsVisible True
104+
, compIsBuildable = IsBuildable True
105+
}
106+
100107
(pn, i) = convId ipi
108+
101109
-- 'sourceLibName' is unreliable, but for now we only really use this for
102110
-- primary libs anyways
103111
comp = componentNameToComponent $ CLibName $ sourceLibName ipi
@@ -141,7 +149,8 @@ convIPId dr comp idx ipid =
141149
case SI.lookupUnitId idx ipid of
142150
Nothing -> Nothing
143151
Just ipi -> let (pn, i) = convId ipi
144-
in Just (D.Simple (LDep dr (Dep (PkgComponent pn ExposedLib) (Fixed i))) comp)
152+
name = ExposedLib LMainLibName -- TODO: Handle sub-libraries.
153+
in Just (D.Simple (LDep dr (Dep (PkgComponent pn name) (Fixed i))) comp)
145154
-- NB: something we pick up from the
146155
-- InstalledPackageIndex is NEVER an executable
147156

@@ -236,34 +245,52 @@ convGPD os arch cinfo constraints strfl solveExes pn
236245
fr | reqSpecVer > maxSpecVer = Just (UnsupportedSpecVer reqSpecVer)
237246
| otherwise = Nothing
238247

239-
components :: Map ExposedComponent IsBuildable
240-
components = M.fromList $ libComps ++ exeComps
248+
components :: Map ExposedComponent ComponentInfo
249+
components = M.fromList $ libComps ++ subLibComps ++ exeComps
241250
where
242-
libComps = [ (ExposedLib, IsBuildable $ isBuildable libBuildInfo lib)
251+
libComps = [ (ExposedLib LMainLibName, libToComponentInfo lib)
243252
| lib <- maybeToList mlib ]
244-
exeComps = [ (ExposedExe name, IsBuildable $ isBuildable buildInfo exe)
253+
subLibComps = [ (ExposedLib (LSubLibName name), libToComponentInfo lib)
254+
| (name, lib) <- sub_libs ]
255+
exeComps = [ ( ExposedExe name
256+
, ComponentInfo {
257+
compIsVisible = IsVisible True
258+
, compIsBuildable = IsBuildable $ testCondition (buildable . buildInfo) exe /= Just False
259+
}
260+
)
245261
| (name, exe) <- exes ]
246-
isBuildable = isBuildableComponent os arch cinfo constraints
262+
263+
libToComponentInfo lib =
264+
ComponentInfo {
265+
compIsVisible = IsVisible $ testCondition (isPrivate . PD.libVisibility) lib /= Just True
266+
, compIsBuildable = IsBuildable $ testCondition (buildable . libBuildInfo) lib /= Just False
267+
}
268+
269+
testCondition = testConditionForComponent os arch cinfo constraints
270+
271+
isPrivate LibraryVisibilityPrivate = True
272+
isPrivate LibraryVisibilityPublic = False
247273

248274
in PInfo flagged_deps components fds fr
249275

250-
-- | Returns true if the component is buildable in the given environment.
251-
-- This function can give false-positives. For example, it only considers flags
252-
-- that are set by unqualified flag constraints, and it doesn't check whether
253-
-- the intra-package dependencies of a component are buildable. It is also
254-
-- possible for the solver to later assign a value to an automatic flag that
255-
-- makes the component unbuildable.
256-
isBuildableComponent :: OS
257-
-> Arch
258-
-> CompilerInfo
259-
-> [LabeledPackageConstraint]
260-
-> (a -> BuildInfo)
261-
-> CondTree ConfVar [Dependency] a
262-
-> Bool
263-
isBuildableComponent os arch cinfo constraints getInfo tree =
264-
case simplifyCondition $ extractCondition (buildable . getInfo) tree of
265-
Lit False -> False
266-
_ -> True
276+
-- | Applies the given predicate (for example, testing buildability or
277+
-- visibility) to the given component and environment. Values are combined with
278+
-- AND. This function returns 'Nothing' when the result cannot be determined
279+
-- before dependency solving. Additionally, this function only considers flags
280+
-- that are set by unqualified flag constraints, and it doesn't check the
281+
-- intra-package dependencies of a component.
282+
testConditionForComponent :: OS
283+
-> Arch
284+
-> CompilerInfo
285+
-> [LabeledPackageConstraint]
286+
-> (a -> Bool)
287+
-> CondTree ConfVar [Dependency] a
288+
-> Maybe Bool
289+
testConditionForComponent os arch cinfo constraints p tree =
290+
case simplifyCondition $ extractCondition p tree of
291+
Lit True -> Just True
292+
Lit False -> Just False
293+
_ -> Nothing
267294
where
268295
flagAssignment :: [(FlagName, Bool)]
269296
flagAssignment =
@@ -355,8 +382,10 @@ convCondTree flags dr pkg os arch cinfo pn fds comp getInfo ipns solveExes@(Solv
355382
-- duplicates could grow exponentially from the leaves to the root
356383
-- of the tree.
357384
mergeSimpleDeps $
358-
L.map (\d -> D.Simple (convLibDep dr d) comp)
359-
(mapMaybe (filterIPNs ipns) ds) -- unconditional package dependencies
385+
[ D.Simple singleDep comp
386+
| dep <- mapMaybe (filterIPNs ipns) ds
387+
, singleDep <- convLibDeps dr dep ] -- unconditional package dependencies
388+
360389
++ L.map (\e -> D.Simple (LDep dr (Ext e)) comp) (PD.allExtensions bi) -- unconditional extension dependencies
361390
++ L.map (\l -> D.Simple (LDep dr (Lang l)) comp) (PD.allLanguages bi) -- unconditional language dependencies
362391
++ L.map (\(PkgconfigDependency pkn vr) -> D.Simple (LDep dr (Pkg pkn vr)) comp) (PD.pkgconfigDepends bi) -- unconditional pkg-config dependencies
@@ -560,9 +589,12 @@ unionDRs :: DependencyReason pn -> DependencyReason pn -> DependencyReason pn
560589
unionDRs (DependencyReason pn' fs1 ss1) (DependencyReason _ fs2 ss2) =
561590
DependencyReason pn' (M.union fs1 fs2) (S.union ss1 ss2)
562591

563-
-- | Convert a Cabal dependency on a library to a solver-specific dependency.
564-
convLibDep :: DependencyReason PN -> Dependency -> LDep PN
565-
convLibDep dr (Dependency pn vr _) = LDep dr $ Dep (PkgComponent pn ExposedLib) (Constrained vr)
592+
-- | Convert a Cabal dependency on a set of library components (from a single
593+
-- package) to solver-specific dependencies.
594+
convLibDeps :: DependencyReason PN -> Dependency -> [LDep PN]
595+
convLibDeps dr (Dependency pn vr libs) =
596+
[ LDep dr $ Dep (PkgComponent pn (ExposedLib lib)) (Constrained vr)
597+
| lib <- S.toList libs ]
566598

567599
-- | Convert a Cabal dependency on an executable (build-tools) to a solver-specific dependency.
568600
convExeDep :: DependencyReason PN -> ExeDependency -> LDep PN
@@ -571,5 +603,6 @@ convExeDep dr (ExeDependency pn exe vr) = LDep dr $ Dep (PkgComponent pn (Expose
571603
-- | Convert setup dependencies
572604
convSetupBuildInfo :: PN -> SetupBuildInfo -> FlaggedDeps PN
573605
convSetupBuildInfo pn nfo =
574-
L.map (\d -> D.Simple (convLibDep (DependencyReason pn M.empty S.empty) d) ComponentSetup)
575-
(PD.setupDepends nfo)
606+
[ D.Simple singleDep ComponentSetup
607+
| dep <- PD.setupDepends nfo
608+
, singleDep <- convLibDeps (DependencyReason pn M.empty S.empty) dep ]

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

Lines changed: 9 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ import Distribution.Solver.Modular.Version
2525
import Distribution.Solver.Types.ConstraintSource
2626
import Distribution.Solver.Types.PackagePath
2727
import Distribution.Solver.Types.Progress
28+
import Distribution.Types.LibraryName
2829
import Distribution.Types.UnqualComponentName
2930

3031
data Message =
@@ -220,8 +221,10 @@ showFR _ (MissingPkgconfigPackage pn vr) = " (conflict: pkg-config package " ++
220221
showFR _ (NewPackageDoesNotMatchExistingConstraint d) = " (conflict: " ++ showConflictingDep d ++ ")"
221222
showFR _ (ConflictingConstraints d1 d2) = " (conflict: " ++ L.intercalate ", " (L.map showConflictingDep [d1, d2]) ++ ")"
222223
showFR _ (NewPackageIsMissingRequiredComponent comp dr) = " (does not contain " ++ showExposedComponent comp ++ ", which is required by " ++ showDependencyReason dr ++ ")"
224+
showFR _ (NewPackageHasPrivateRequiredComponent comp dr) = " (" ++ showExposedComponent comp ++ " is private, but it is required by " ++ showDependencyReason dr ++ ")"
223225
showFR _ (NewPackageHasUnbuildableRequiredComponent comp dr) = " (" ++ showExposedComponent comp ++ " is not buildable in the current environment, but it is required by " ++ showDependencyReason dr ++ ")"
224226
showFR _ (PackageRequiresMissingComponent qpn comp) = " (requires " ++ showExposedComponent comp ++ " from " ++ showQPN qpn ++ ", but the component does not exist)"
227+
showFR _ (PackageRequiresPrivateComponent qpn comp) = " (requires " ++ showExposedComponent comp ++ " from " ++ showQPN qpn ++ ", but the component is private)"
225228
showFR _ (PackageRequiresUnbuildableComponent qpn comp) = " (requires " ++ showExposedComponent comp ++ " from " ++ showQPN qpn ++ ", but the component is not buildable in the current environment)"
226229
showFR _ CannotInstall = " (only already installed instances can be used)"
227230
showFR _ CannotReinstall = " (avoiding to reinstall a package with same version but new dependencies)"
@@ -247,8 +250,9 @@ showFR _ (MalformedStanzaChoice qsn) = " (INTERNAL ERROR: MALFORMED STANZA
247250
showFR _ EmptyGoalChoice = " (INTERNAL ERROR: EMPTY GOAL CHOICE)"
248251

249252
showExposedComponent :: ExposedComponent -> String
250-
showExposedComponent ExposedLib = "library"
251-
showExposedComponent (ExposedExe name) = "executable '" ++ unUnqualComponentName name ++ "'"
253+
showExposedComponent (ExposedLib LMainLibName) = "library"
254+
showExposedComponent (ExposedLib (LSubLibName name)) = "library '" ++ unUnqualComponentName name ++ "'"
255+
showExposedComponent (ExposedExe name) = "executable '" ++ unUnqualComponentName name ++ "'"
252256

253257
constraintSource :: ConstraintSource -> String
254258
constraintSource src = "constraint from " ++ showConstraintSource src
@@ -257,8 +261,9 @@ showConflictingDep :: ConflictingDep -> String
257261
showConflictingDep (ConflictingDep dr (PkgComponent qpn comp) ci) =
258262
let DependencyReason qpn' _ _ = dr
259263
componentStr = case comp of
260-
ExposedExe exe -> " (exe " ++ unUnqualComponentName exe ++ ")"
261-
ExposedLib -> ""
264+
ExposedExe exe -> " (exe " ++ unUnqualComponentName exe ++ ")"
265+
ExposedLib LMainLibName -> ""
266+
ExposedLib (LSubLibName lib) -> " (lib " ++ unUnqualComponentName lib ++ ")"
262267
in case ci of
263268
Fixed i -> (if qpn /= qpn' then showDependencyReason dr ++ " => " else "") ++
264269
showQPN qpn ++ componentStr ++ "==" ++ showI i

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

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -102,8 +102,10 @@ data FailReason = UnsupportedExtension Extension
102102
| NewPackageDoesNotMatchExistingConstraint ConflictingDep
103103
| ConflictingConstraints ConflictingDep ConflictingDep
104104
| NewPackageIsMissingRequiredComponent ExposedComponent (DependencyReason QPN)
105+
| NewPackageHasPrivateRequiredComponent ExposedComponent (DependencyReason QPN)
105106
| NewPackageHasUnbuildableRequiredComponent ExposedComponent (DependencyReason QPN)
106107
| PackageRequiresMissingComponent QPN ExposedComponent
108+
| PackageRequiresPrivateComponent QPN ExposedComponent
107109
| PackageRequiresUnbuildableComponent QPN ExposedComponent
108110
| CannotInstall
109111
| CannotReinstall

0 commit comments

Comments
 (0)