Skip to content

Commit b747032

Browse files
grayjayhvr
grayjay
authored and
hvr
committed
Solver: Check whether components are buildable in the current environment.
This commit handles the most common case of issue #5325 by checking that each component that is required as a dependency is buildable in the current environment, where environment refers to the compiler, os, arch, and global flag constraints. The solver records whether each component is buildable in the package's PInfo during index conversion. Then it checks that each required component is buildable in the validation phase, similar to the check for missing components. The buildable check can give false-positives, because it only considers flags that are set by unqualified flag constraints, and it doesn't check whether the intra-package dependencies of a component are buildable. The check is also incomplete because it is performed before any automatic flags are assigned. It is possible for the solver to later choose a value for a flag that makes the package unbuildable.
1 parent a655942 commit b747032

File tree

8 files changed

+236
-38
lines changed

8 files changed

+236
-38
lines changed

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -59,7 +59,7 @@ modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns
5959
solve' sc cinfo idx pkgConfigDB pprefs gcs pns
6060
where
6161
-- Indices have to be converted into solver-specific uniform index.
62-
idx = convPIs os arch cinfo (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) iidx sidx
62+
idx = convPIs os arch cinfo gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) iidx sidx
6363
-- Constraints have to be converted into a finite map indexed by PN.
6464
gcs = M.fromListWith (++) (map pair pcs)
6565
where

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

+7-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
module Distribution.Solver.Modular.Index
22
( Index
33
, PInfo(..)
4+
, IsBuildable(..)
45
, defaultQualifyOptions
56
, mkIndex
67
) where
@@ -21,11 +22,16 @@ type Index = Map PN (Map I PInfo)
2122

2223
-- | Info associated with a package instance.
2324
-- Currently, dependencies, component names, flags and failure reasons.
25+
-- The component map records whether any components are unbuildable in the
26+
-- current environment (compiler, os, arch, and global flag constraints).
2427
-- Packages that have a failure reason recorded for them are disabled
2528
-- globally, for reasons external to the solver. We currently use this
2629
-- for shadowing which essentially is a GHC limitation, and for
2730
-- installed packages that are broken.
28-
data PInfo = PInfo (FlaggedDeps PN) [ExposedComponent] FlagInfo (Maybe FailReason)
31+
data PInfo = PInfo (FlaggedDeps PN) (Map ExposedComponent IsBuildable) FlagInfo (Maybe FailReason)
32+
33+
-- | Whether a component is made unbuildable by a "buildable: False" field.
34+
newtype IsBuildable = IsBuildable Bool
2935

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

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

+102-17
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,9 @@ import Distribution.Types.ForeignLib
3030
import Distribution.Solver.Types.ComponentDeps
3131
( Component(..), componentNameToComponent )
3232
import Distribution.Solver.Types.Flag
33+
import Distribution.Solver.Types.LabeledPackageConstraint
3334
import Distribution.Solver.Types.OptionalStanza
35+
import Distribution.Solver.Types.PackageConstraint
3436
import qualified Distribution.Solver.Types.PackageIndex as CI
3537
import Distribution.Solver.Types.Settings
3638
import Distribution.Solver.Types.SourcePackage
@@ -53,10 +55,13 @@ import Distribution.Solver.Modular.Version
5355
-- resolving these situations. However, the right thing to do is to
5456
-- fix the problem there, so for now, shadowing is only activated if
5557
-- explicitly requested.
56-
convPIs :: OS -> Arch -> CompilerInfo -> ShadowPkgs -> StrongFlags -> SolveExecutables ->
57-
SI.InstalledPackageIndex -> CI.PackageIndex (SourcePackage loc) -> Index
58-
convPIs os arch comp sip strfl solveExes iidx sidx =
59-
mkIndex (convIPI' sip iidx ++ convSPI' os arch comp strfl solveExes sidx)
58+
convPIs :: OS -> Arch -> CompilerInfo -> Map PN [LabeledPackageConstraint]
59+
-> ShadowPkgs -> StrongFlags -> SolveExecutables
60+
-> SI.InstalledPackageIndex -> CI.PackageIndex (SourcePackage loc)
61+
-> Index
62+
convPIs os arch comp constraints sip strfl solveExes iidx sidx =
63+
mkIndex $
64+
convIPI' sip iidx ++ convSPI' os arch comp constraints strfl solveExes sidx
6065

6166
-- | Convert a Cabal installed package index to the simpler,
6267
-- more uniform index format of the solver.
@@ -87,8 +92,10 @@ convId ipi = (pn, I ver $ Inst $ IPI.installedUnitId ipi)
8792
convIP :: SI.InstalledPackageIndex -> InstalledPackageInfo -> (PN, I, PInfo)
8893
convIP idx ipi =
8994
case mapM (convIPId (DependencyReason pn M.empty S.empty) comp idx) (IPI.depends ipi) of
90-
Nothing -> (pn, i, PInfo [] [] M.empty (Just Broken))
91-
Just fds -> (pn, i, PInfo fds [ExposedLib] M.empty Nothing)
95+
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)
9299
where
93100
(pn, i) = convId ipi
94101
-- 'sourceLibName' is unreliable, but for now we only really use this for
@@ -140,24 +147,29 @@ convIPId dr comp idx ipid =
140147

141148
-- | Convert a cabal-install source package index to the simpler,
142149
-- more uniform index format of the solver.
143-
convSPI' :: OS -> Arch -> CompilerInfo -> StrongFlags -> SolveExecutables ->
144-
CI.PackageIndex (SourcePackage loc) -> [(PN, I, PInfo)]
145-
convSPI' os arch cinfo strfl solveExes = L.map (convSP os arch cinfo strfl solveExes) . CI.allPackages
150+
convSPI' :: OS -> Arch -> CompilerInfo -> Map PN [LabeledPackageConstraint]
151+
-> StrongFlags -> SolveExecutables
152+
-> CI.PackageIndex (SourcePackage loc) -> [(PN, I, PInfo)]
153+
convSPI' os arch cinfo constraints strfl solveExes =
154+
L.map (convSP os arch cinfo constraints strfl solveExes) . CI.allPackages
146155

147156
-- | Convert a single source package into the solver-specific format.
148-
convSP :: OS -> Arch -> CompilerInfo -> StrongFlags -> SolveExecutables -> SourcePackage loc -> (PN, I, PInfo)
149-
convSP os arch cinfo strfl solveExes (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
157+
convSP :: OS -> Arch -> CompilerInfo -> Map PN [LabeledPackageConstraint]
158+
-> StrongFlags -> SolveExecutables -> SourcePackage loc -> (PN, I, PInfo)
159+
convSP os arch cinfo constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
150160
let i = I pv InRepo
151-
in (pn, i, convGPD os arch cinfo strfl solveExes pn gpd)
161+
pkgConstraints = fromMaybe [] $ M.lookup pn constraints
162+
in (pn, i, convGPD os arch cinfo pkgConstraints strfl solveExes pn gpd)
152163

153164
-- We do not use 'flattenPackageDescription' or 'finalizePD'
154165
-- from 'Distribution.PackageDescription.Configuration' here, because we
155166
-- want to keep the condition tree, but simplify much of the test.
156167

157168
-- | Convert a generic package description to a solver-specific 'PInfo'.
158-
convGPD :: OS -> Arch -> CompilerInfo -> StrongFlags -> SolveExecutables ->
159-
PN -> GenericPackageDescription -> PInfo
160-
convGPD os arch cinfo strfl solveExes pn
169+
convGPD :: OS -> Arch -> CompilerInfo -> [LabeledPackageConstraint]
170+
-> StrongFlags -> SolveExecutables -> PN -> GenericPackageDescription
171+
-> PInfo
172+
convGPD os arch cinfo constraints strfl solveExes pn
161173
(GenericPackageDescription pkg flags mlib sub_libs flibs exes tests benchs) =
162174
let
163175
fds = flagInfo strfl flags
@@ -223,8 +235,81 @@ convGPD os arch cinfo strfl solveExes pn
223235
-- forced to, emit a meaningful solver error message).
224236
fr | reqSpecVer > maxSpecVer = Just (UnsupportedSpecVer reqSpecVer)
225237
| otherwise = Nothing
226-
in
227-
PInfo flagged_deps (L.map (ExposedExe . fst) exes ++ [ExposedLib | isJust mlib]) fds fr
238+
239+
components :: Map ExposedComponent IsBuildable
240+
components = M.fromList $ libComps ++ exeComps
241+
where
242+
libComps = [ (ExposedLib, IsBuildable $ isBuildable libBuildInfo lib)
243+
| lib <- maybeToList mlib ]
244+
exeComps = [ (ExposedExe name, IsBuildable $ isBuildable buildInfo exe)
245+
| (name, exe) <- exes ]
246+
isBuildable = isBuildableComponent os arch cinfo constraints
247+
248+
in PInfo flagged_deps components fds fr
249+
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
267+
where
268+
flagAssignment :: [(FlagName, Bool)]
269+
flagAssignment =
270+
mconcat [ unFlagAssignment fa
271+
| PackageConstraint (ScopeAnyQualifier _) (PackagePropertyFlags fa)
272+
<- L.map unlabelPackageConstraint constraints]
273+
274+
-- Simplify the condition, using the current environment. Most of this
275+
-- function was copied from convBranch and
276+
-- Distribution.Types.Condition.simplifyCondition.
277+
simplifyCondition :: Condition ConfVar -> Condition ConfVar
278+
simplifyCondition (Var (OS os')) = Lit (os == os')
279+
simplifyCondition (Var (Arch arch')) = Lit (arch == arch')
280+
simplifyCondition (Var (Impl cf cvr))
281+
| matchImpl (compilerInfoId cinfo) ||
282+
-- fixme: Nothing should be treated as unknown, rather than empty
283+
-- list. This code should eventually be changed to either
284+
-- support partial resolution of compiler flags or to
285+
-- complain about incompletely configured compilers.
286+
any matchImpl (fromMaybe [] $ compilerInfoCompat cinfo) = Lit True
287+
| otherwise = Lit False
288+
where
289+
matchImpl (CompilerId cf' cv) = cf == cf' && checkVR cvr cv
290+
simplifyCondition (Var (Flag f))
291+
| Just b <- L.lookup f flagAssignment = Lit b
292+
simplifyCondition (Var v) = Var v
293+
simplifyCondition (Lit b) = Lit b
294+
simplifyCondition (CNot c) =
295+
case simplifyCondition c of
296+
Lit True -> Lit False
297+
Lit False -> Lit True
298+
c' -> CNot c'
299+
simplifyCondition (COr c d) =
300+
case (simplifyCondition c, simplifyCondition d) of
301+
(Lit False, d') -> d'
302+
(Lit True, _) -> Lit True
303+
(c', Lit False) -> c'
304+
(_, Lit True) -> Lit True
305+
(c', d') -> COr c' d'
306+
simplifyCondition (CAnd c d) =
307+
case (simplifyCondition c, simplifyCondition d) of
308+
(Lit False, _) -> Lit False
309+
(Lit True, d') -> d'
310+
(_, Lit False) -> Lit False
311+
(c', Lit True) -> c'
312+
(c', d') -> CAnd c' d'
228313

229314
-- | Create a flagged dependency tree from a list @fds@ of flagged
230315
-- dependencies, using @f@ to form the tree node (@f@ will be

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

+2
Original file line numberDiff line numberDiff line change
@@ -110,7 +110,9 @@ showFR _ (MissingPkgconfigPackage pn vr) = " (conflict: pkg-config package " ++
110110
showFR _ (NewPackageDoesNotMatchExistingConstraint d) = " (conflict: " ++ showConflictingDep d ++ ")"
111111
showFR _ (ConflictingConstraints d1 d2) = " (conflict: " ++ L.intercalate ", " (L.map showConflictingDep [d1, d2]) ++ ")"
112112
showFR _ (NewPackageIsMissingRequiredComponent comp dr) = " (does not contain " ++ showExposedComponent comp ++ ", which is required by " ++ showDependencyReason dr ++ ")"
113+
showFR _ (NewPackageHasUnbuildableRequiredComponent comp dr) = " (" ++ showExposedComponent comp ++ " is not buildable in the current environment, but it is required by " ++ showDependencyReason dr ++ ")"
113114
showFR _ (PackageRequiresMissingComponent qpn comp) = " (requires " ++ showExposedComponent comp ++ " from " ++ showQPN qpn ++ ", but the component does not exist)"
115+
showFR _ (PackageRequiresUnbuildableComponent qpn comp) = " (requires " ++ showExposedComponent comp ++ " from " ++ showQPN qpn ++ ", but the component is not buildable in the current environment)"
114116
showFR _ CannotInstall = " (only already installed instances can be used)"
115117
showFR _ CannotReinstall = " (avoiding to reinstall a package with same version but new dependencies)"
116118
showFR _ Shadowed = " (shadowed by another installed package with same version)"

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

+2
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,9 @@ data FailReason = UnsupportedExtension Extension
101101
| NewPackageDoesNotMatchExistingConstraint ConflictingDep
102102
| ConflictingConstraints ConflictingDep ConflictingDep
103103
| NewPackageIsMissingRequiredComponent ExposedComponent (DependencyReason QPN)
104+
| NewPackageHasUnbuildableRequiredComponent ExposedComponent (DependencyReason QPN)
104105
| PackageRequiresMissingComponent QPN ExposedComponent
106+
| PackageRequiresUnbuildableComponent QPN ExposedComponent
105107
| CannotInstall
106108
| CannotReinstall
107109
| Shadowed

‎cabal-install/Distribution/Solver/Modular/Validate.hs

+44-15
Original file line numberDiff line numberDiff line change
@@ -108,8 +108,8 @@ data ValidateState = VS {
108108
pa :: PreAssignment,
109109

110110
-- Map from package name to the components that are provided by the chosen
111-
-- instance of that package.
112-
availableComponents :: Map QPN [ExposedComponent],
111+
-- instance of that package, and whether those components are buildable.
112+
availableComponents :: Map QPN (Map ExposedComponent IsBuildable),
113113

114114
-- Map from package name to the components that are required from that
115115
-- package.
@@ -226,7 +226,7 @@ validate = cata go
226226
newDeps = do
227227
nppa <- mnppa
228228
rComps' <- extendRequiredComponents aComps rComps newactives
229-
checkComponentsInNewPackage rComps qpn comps
229+
checkComponentsInNewPackage (M.findWithDefault M.empty qpn rComps) qpn comps
230230
return (nppa, rComps')
231231
in case newDeps of
232232
Left (c, fr) -> -- We have an inconsistency. We can stop.
@@ -299,17 +299,31 @@ validate = cata go
299299
local (\ s -> s { pa = PA nppa pfa npsa, requiredComponents = rComps' }) r
300300

301301
-- | Check that a newly chosen package instance contains all components that
302-
-- are required from that package so far.
303-
checkComponentsInNewPackage :: Map QPN ComponentDependencyReasons
302+
-- are required from that package so far. The components must also be buildable.
303+
checkComponentsInNewPackage :: ComponentDependencyReasons
304304
-> QPN
305-
-> [ExposedComponent]
305+
-> Map ExposedComponent IsBuildable
306306
-> Either Conflict ()
307307
checkComponentsInNewPackage required qpn providedComps =
308-
case M.toList $ deleteKeys providedComps (M.findWithDefault M.empty qpn required) of
309-
(missingComp, dr) : _ -> let cs = CS.insert (P qpn) $ dependencyReasonToCS dr
310-
in Left (cs, NewPackageIsMissingRequiredComponent missingComp dr)
311-
[] -> Right ()
308+
case M.toList $ deleteKeys (M.keys providedComps) required of
309+
(missingComp, dr) : _ ->
310+
Left $ mkConflict missingComp dr NewPackageIsMissingRequiredComponent
311+
[] ->
312+
case M.toList $ deleteKeys buildableProvidedComps required of
313+
(unbuildableComp, dr) : _ ->
314+
Left $ mkConflict unbuildableComp dr NewPackageHasUnbuildableRequiredComponent
315+
[] -> Right ()
312316
where
317+
mkConflict :: ExposedComponent
318+
-> DependencyReason QPN
319+
-> (ExposedComponent -> DependencyReason QPN -> FailReason)
320+
-> Conflict
321+
mkConflict comp dr mkFailure =
322+
(CS.insert (P qpn) (dependencyReasonToCS dr), mkFailure comp dr)
323+
324+
buildableProvidedComps :: [ExposedComponent]
325+
buildableProvidedComps = [comp | (comp, IsBuildable True) <- M.toList providedComps]
326+
313327
deleteKeys :: Ord k => [k] -> Map k v -> Map k v
314328
deleteKeys ks m = L.foldr M.delete m ks
315329

@@ -466,9 +480,9 @@ merge (MergedDepConstrained vrOrigins) (PkgDep vs2 (PkgComponent _ comp2) (Const
466480

467481
-- | Takes a list of new dependencies and uses it to try to update the map of
468482
-- known component dependencies. It returns a failure when a new dependency
469-
-- requires a component that is missing from one of the previously chosen
483+
-- requires a component that is missing or unbuildable in a previously chosen
470484
-- packages.
471-
extendRequiredComponents :: Map QPN [ExposedComponent]
485+
extendRequiredComponents :: Map QPN (Map ExposedComponent IsBuildable)
472486
-> Map QPN ComponentDependencyReasons
473487
-> [LDep QPN]
474488
-> Either Conflict (Map QPN ComponentDependencyReasons)
@@ -483,11 +497,26 @@ extendRequiredComponents available = foldM extendSingle
483497
-- already been chosen.
484498
case M.lookup qpn available of
485499
Just comps
486-
| L.notElem comp comps -> let cs = CS.insert (P qpn) (dependencyReasonToCS dr)
487-
in Left (cs, PackageRequiresMissingComponent qpn comp)
488-
_ -> Right $ M.insertWith M.union qpn (M.insert comp dr compDeps) required
500+
| M.notMember comp comps ->
501+
Left $ mkConflict qpn comp dr PackageRequiresMissingComponent
502+
| L.notElem comp (buildableComps comps) ->
503+
Left $ mkConflict qpn comp dr PackageRequiresUnbuildableComponent
504+
_ ->
505+
Right $ M.insertWith M.union qpn (M.insert comp dr compDeps) required
489506
extendSingle required _ = Right required
490507

508+
mkConflict :: QPN
509+
-> ExposedComponent
510+
-> DependencyReason QPN
511+
-> (QPN -> ExposedComponent -> FailReason)
512+
-> Conflict
513+
mkConflict qpn comp dr mkFailure =
514+
(CS.insert (P qpn) (dependencyReasonToCS dr), mkFailure qpn comp)
515+
516+
buildableComps :: Map comp IsBuildable -> [comp]
517+
buildableComps comps = [comp | (comp, IsBuildable True) <- M.toList comps]
518+
519+
491520
-- | Interface.
492521
validateTree :: CompilerInfo -> Index -> PkgConfigDb -> Tree d c -> Tree d c
493522
validateTree cinfo idx pkgConfigDb t = runValidate (validate t) VS {

0 commit comments

Comments
 (0)