Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Make solver able to reject build-type: Custom packages #7802

Closed
wants to merge 2 commits into from
Closed

Make solver able to reject build-type: Custom packages #7802

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
969e4bc
Make solver able to reject build-type: Custom packages
phadej Nov 7, 2021
c920766
WIP: Add documentation section
phadej Nov 8, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion Cabal/src/Distribution/Types/BuildType.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ data BuildType
-- information used by later phases.
| Make -- ^ calls @Distribution.Make.defaultMain@
| Custom -- ^ uses user-supplied @Setup.hs@ or @Setup.lhs@ (default)
deriving (Generic, Show, Read, Eq, Typeable, Data)
deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)

instance Binary BuildType
instance Structured BuildType
Expand Down
1 change: 1 addition & 0 deletions cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -89,6 +89,7 @@ extendOpen qpn' gs s@(BS { rdeps = gs', open = o' }) = go gs' o' gs
go g o ((Simple (LDep _dr (Ext _ext )) _) : ngs) = go g o ngs
go g o ((Simple (LDep _dr (Lang _lang))_) : ngs) = go g o ngs
go g o ((Simple (LDep _dr (Pkg _pn _vr))_) : ngs) = go g o ngs
go g o ((Simple (LDep _dr (BT _bt))_) : ngs) = go g o ngs

addIfAbsent :: Eq a => a -> [a] -> [a]
addIfAbsent x xs = if x `elem` xs then xs else x : xs
Expand Down
3 changes: 3 additions & 0 deletions cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -58,6 +58,7 @@ import Distribution.Solver.Types.PackagePath
import Distribution.Types.LibraryName
import Distribution.Types.PkgconfigVersionRange
import Distribution.Types.UnqualComponentName
import qualified Distribution.Types.BuildType as C

{-------------------------------------------------------------------------------
Constrained instances
Expand Down Expand Up @@ -123,6 +124,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
| BT C.BuildType -- ^ dependency on a build-type.
deriving Functor

-- | An exposed component within a package. This type is used to represent
Expand Down Expand Up @@ -200,6 +202,7 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
goD (Ext ext) _ = Ext ext
goD (Lang lang) _ = Lang lang
goD (Pkg pkn vr) _ = Pkg pkn vr
goD (BT bt) _ = BT bt
goD (Dep dep@(PkgComponent qpn (ExposedExe _)) ci) _ =
Dep (Q (PackagePath ns (QualExe pn qpn)) <$> dep) ci
goD (Dep dep@(PkgComponent qpn (ExposedLib _)) ci) comp
Expand Down
1 change: 1 addition & 0 deletions cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -344,6 +344,7 @@ convCondTree flags dr pkg os arch cinfo pn fds comp getInfo solveExes@(SolveExec
++ L.map (\e -> D.Simple (LDep dr (Ext e)) comp) (allExtensions bi) -- unconditional extension dependencies
++ L.map (\l -> D.Simple (LDep dr (Lang l)) comp) (allLanguages bi) -- unconditional language dependencies
++ L.map (\(PkgconfigDependency pkn vr) -> D.Simple (LDep dr (Pkg pkn vr)) comp) (pkgconfigDepends bi) -- unconditional pkg-config dependencies
++ [D.Simple (LDep dr (BT (buildType pkg))) comp]
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This line seems to add the build type constraint to every component and the branches of every conditional. Could the constraint be associated with the whole package instead, similar to UnsupportedSpecVer?

++ concatMap (convBranch flags dr pkg os arch cinfo pn fds comp getInfo solveExes) branches
-- build-tools dependencies
-- NB: Only include these dependencies if SolveExecutables
Expand Down
1 change: 1 addition & 0 deletions cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -270,6 +270,7 @@ linkDeps target = \deps -> do
(Simple (LDep _ (Ext _)) _, _) -> return ()
(Simple (LDep _ (Lang _)) _, _) -> return ()
(Simple (LDep _ (Pkg _ _)) _, _) -> return ()
(Simple (LDep _ (BT _)) _, _) -> return ()

requalify :: FlaggedDeps QPN -> UpdateState (FlaggedDeps QPN)
requalify deps = do
Expand Down
1 change: 1 addition & 0 deletions cabal-install-solver/src/Distribution/Solver/Modular/Message.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -219,6 +219,7 @@ showGR (DependencyGoal dr) = " (dependency of " ++ showDependencyReason dr ++ ")
showFR :: ConflictSet -> FailReason -> String
showFR _ (UnsupportedExtension ext) = " (conflict: requires " ++ showUnsupportedExtension ext ++ ")"
showFR _ (UnsupportedLanguage lang) = " (conflict: requires " ++ showUnsupportedLanguage lang ++ ")"
showFR _ (UnsupportedBuildType bt) = " (conflict: disallowed build-type " ++ prettyShow bt ++ ")"
showFR _ (MissingPkgconfigPackage pn vr) = " (conflict: pkg-config package " ++ prettyShow pn ++ prettyShow vr ++ ", not found in the pkg-config database)"
showFR _ (NewPackageDoesNotMatchExistingConstraint d) = " (conflict: " ++ showConflictingDep d ++ ")"
showFR _ (ConflictingConstraints d1 d2) = " (conflict: " ++ L.intercalate ", " (L.map showConflictingDep [d1, d2]) ++ ")"
Expand Down
4 changes: 3 additions & 1 deletion cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,7 @@ import Distribution.Solver.Modular.Tree
import qualified Distribution.Solver.Modular.PSQ as PSQ

import Distribution.Simple.Setup (BooleanFlag(..))
import qualified Distribution.Types.BuildType as C

#ifdef DEBUG_TRACETREE
import qualified Distribution.Solver.Modular.ConflictSet as CS
Expand All @@ -68,6 +69,7 @@ data SolverConfig = SolverConfig {
strongFlags :: StrongFlags,
allowBootLibInstalls :: AllowBootLibInstalls,
onlyConstrained :: OnlyConstrained,
buildTypes :: Maybe (S.Set C.BuildType),
maxBackjumps :: Maybe Int,
enableBackjumping :: EnableBackjumping,
solveExecutables :: SolveExecutables,
Expand Down Expand Up @@ -138,7 +140,7 @@ solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals =
P.enforceManualFlags userConstraints
validationCata = P.enforceSingleInstanceRestriction .
validateLinking idx .
validateTree cinfo idx pkgConfigDB
validateTree cinfo idx pkgConfigDB (buildTypes sc)
prunePhase = (if asBool (avoidReinstalls sc) then P.avoidReinstalls (const True) else id) .
(if asBool (allowBootLibInstalls sc)
then id
Expand Down
2 changes: 2 additions & 0 deletions cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@ import Distribution.Solver.Types.PackagePath
import Distribution.Types.PkgconfigVersionRange
import Distribution.Types.UnitId (UnitId)
import Language.Haskell.Extension (Extension, Language)
import qualified Distribution.Types.BuildType as C

type Weight = Double

Expand Down Expand Up @@ -129,6 +130,7 @@ data FailReason = UnsupportedExtension Extension
| DependenciesNotLinked String
| CyclicDependencies
| UnsupportedSpecVer Ver
| UnsupportedBuildType C.BuildType
deriving (Eq, Show)

-- | Information about a dependency involved in a conflict, for error messages.
Expand Down
30 changes: 24 additions & 6 deletions cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,7 @@ import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, pkgConfigPkgIsPresent)
import Distribution.Types.LibraryName
import Distribution.Types.PkgconfigVersionRange
import qualified Distribution.Types.BuildType as C

#ifdef DEBUG_CONFLICT_SETS
import GHC.Stack (CallStack)
Expand Down Expand Up @@ -97,6 +98,7 @@ import GHC.Stack (CallStack)
data ValidateState = VS {
supportedExt :: Extension -> Bool,
supportedLang :: Language -> Bool,
supportedBuildType :: C.BuildType -> Bool,
presentPkgs :: PkgconfigName -> PkgconfigVersionRange -> Bool,
index :: Index,

Expand Down Expand Up @@ -202,6 +204,7 @@ validate = go
PA ppa pfa psa <- asks pa -- obtain current preassignment
extSupported <- asks supportedExt -- obtain the supported extensions
langSupported <- asks supportedLang -- obtain the supported languages
btypeSupported <- asks supportedBuildType
pkgPresent <- asks presentPkgs -- obtain the present pkg-config pkgs
idx <- asks index -- obtain the index
svd <- asks saved -- obtain saved dependencies
Expand All @@ -216,7 +219,7 @@ validate = go
-- plus the dependency information we have for that instance
let newactives = extractAllDeps pfa psa qdeps
-- We now try to extend the partial assignment with the new active constraints.
let mnppa = extend extSupported langSupported pkgPresent newactives
let mnppa = extend extSupported langSupported btypeSupported pkgPresent newactives
=<< extendWithPackageChoice (PI qpn i) ppa
-- In case we continue, we save the scoped dependencies
let nsvd = M.insert qpn qdeps svd
Expand Down Expand Up @@ -246,6 +249,7 @@ validate = go
PA ppa pfa psa <- asks pa -- obtain current preassignment
extSupported <- asks supportedExt -- obtain the supported extensions
langSupported <- asks supportedLang -- obtain the supported languages
btypeSupported <- asks supportedBuildType
pkgPresent <- asks presentPkgs -- obtain the present pkg-config pkgs
svd <- asks saved -- obtain saved dependencies
aComps <- asks availableComponents
Expand All @@ -264,7 +268,7 @@ validate = go
let newactives = extractNewDeps (F qfn) b npfa psa qdeps
mNewRequiredComps = extendRequiredComponents qpn aComps rComps newactives
-- As in the package case, we try to extend the partial assignment.
let mnppa = extend extSupported langSupported pkgPresent newactives ppa
let mnppa = extend extSupported langSupported btypeSupported pkgPresent newactives ppa
case liftM2 (,) mnppa mNewRequiredComps of
Left (c, fr) -> return (Fail c fr) -- inconsistency found
Right (nppa, rComps') ->
Expand All @@ -276,6 +280,7 @@ validate = go
PA ppa pfa psa <- asks pa -- obtain current preassignment
extSupported <- asks supportedExt -- obtain the supported extensions
langSupported <- asks supportedLang -- obtain the supported languages
btypeSupported <- asks supportedBuildType
pkgPresent <- asks presentPkgs -- obtain the present pkg-config pkgs
svd <- asks saved -- obtain saved dependencies
aComps <- asks availableComponents
Expand All @@ -294,7 +299,7 @@ validate = go
let newactives = extractNewDeps (S qsn) b pfa npsa qdeps
mNewRequiredComps = extendRequiredComponents qpn aComps rComps newactives
-- As in the package case, we try to extend the partial assignment.
let mnppa = extend extSupported langSupported pkgPresent newactives ppa
let mnppa = extend extSupported langSupported btypeSupported pkgPresent newactives ppa
case liftM2 (,) mnppa mNewRequiredComps of
Left (c, fr) -> return (Fail c fr) -- inconsistency found
Right (nppa, rComps') ->
Expand Down Expand Up @@ -390,11 +395,12 @@ extractNewDeps v b fa sa = go
-- or the successfully extended assignment.
extend :: (Extension -> Bool) -- ^ is a given extension supported
-> (Language -> Bool) -- ^ is a given language supported
-> (C.BuildType -> Bool) -- ^ is a given build-type supported
-> (PkgconfigName -> PkgconfigVersionRange -> Bool) -- ^ is a given pkg-config requirement satisfiable
-> [LDep QPN]
-> PPreAssignment
-> Either Conflict PPreAssignment
extend extSupported langSupported pkgPresent newactives ppa = foldM extendSingle ppa newactives
extend extSupported langSupported btypeSupported pkgPresent newactives ppa = foldM extendSingle ppa newactives
where

extendSingle :: PPreAssignment -> LDep QPN -> Either Conflict PPreAssignment
Expand All @@ -407,6 +413,9 @@ extend extSupported langSupported pkgPresent newactives ppa = foldM extendSingle
extendSingle a (LDep dr (Pkg pn vr)) =
if pkgPresent pn vr then Right a
else Left (dependencyReasonToConflictSet dr, MissingPkgconfigPackage pn vr)
extendSingle a (LDep dr (BT bt)) =
if btypeSupported bt then Right a
else Left (dependencyReasonToConflictSet dr, UnsupportedBuildType bt)
extendSingle a (LDep dr (Dep dep@(PkgComponent qpn _) ci)) =
let mergedDep = M.findWithDefault (MergedDepConstrained []) qpn a
in case (\ x -> M.insert qpn x a) <$> merge mergedDep (PkgDep dr dep ci) of
Expand Down Expand Up @@ -572,14 +581,23 @@ extendRequiredComponents eqpn available = foldM extendSingle


-- | Interface.
validateTree :: CompilerInfo -> Index -> PkgConfigDb -> Tree d c -> Tree d c
validateTree cinfo idx pkgConfigDb t = runValidate (validate t) VS {
validateTree
:: CompilerInfo
-> Index
-> PkgConfigDb
-> Maybe (S.Set C.BuildType)
-> Tree d c
-> Tree d c
validateTree cinfo idx pkgConfigDb bts t = runValidate (validate t) VS {
supportedExt = maybe (const True) -- if compiler has no list of extensions, we assume everything is supported
(\ es -> let s = S.fromList es in \ x -> S.member x s)
(compilerInfoExtensions cinfo)
, supportedLang = maybe (const True)
(flip L.elem) -- use list lookup because language list is small and no Ord instance
(compilerInfoLanguages cinfo)
, supportedBuildType = maybe (const True)
(flip S.member)
bts
, presentPkgs = pkgConfigPkgIsPresent pkgConfigDb
, index = idx
, saved = M.empty
Expand Down
10 changes: 5 additions & 5 deletions cabal-install-solver/src/Distribution/Solver/Types/PackageConstraint.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -141,8 +141,8 @@ showPackageConstraint pc@(PackageConstraint scope prop) =
packageConstraintToDependency :: PackageConstraint -> Maybe PackageVersionConstraint
packageConstraintToDependency (PackageConstraint scope prop) = toDep prop
where
toDep (PackagePropertyVersion vr) = Just $ PackageVersionConstraint (scopeToPackageName scope) vr
toDep (PackagePropertyInstalled) = Nothing
toDep (PackagePropertySource) = Nothing
toDep (PackagePropertyFlags _) = Nothing
toDep (PackagePropertyStanzas _) = Nothing
toDep (PackagePropertyVersion vr) = Just $ PackageVersionConstraint (scopeToPackageName scope) vr
toDep (PackagePropertyInstalled) = Nothing
toDep (PackagePropertySource) = Nothing
toDep (PackagePropertyFlags _) = Nothing
toDep (PackagePropertyStanzas _) = Nothing
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It looks like this file has only whitespace changes.

1 change: 1 addition & 0 deletions cabal-install/src/Distribution/Client/Config.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -299,6 +299,7 @@ instance Semigroup SavedConfig where
installMaxBackjumps = combine installMaxBackjumps,
installReorderGoals = combine installReorderGoals,
installCountConflicts = combine installCountConflicts,
installBuildTypeCustom = combine installBuildTypeCustom,
installFineGrainedConflicts = combine installFineGrainedConflicts,
installMinimizeConflictSet = combine installMinimizeConflictSet,
installIndependentGoals = combine installIndependentGoals,
Expand Down
21 changes: 15 additions & 6 deletions cabal-install/src/Distribution/Client/Dependency.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,7 @@ module Distribution.Client.Dependency (
setPreferenceDefault,
setReorderGoals,
setCountConflicts,
setBuildTypeCustom,
setFineGrainedConflicts,
setMinimizeConflictSet,
setIndependentGoals,
Expand Down Expand Up @@ -156,6 +157,7 @@ data DepResolverParams = DepResolverParams {
depResolverAvoidReinstalls :: AvoidReinstalls,
depResolverShadowPkgs :: ShadowPkgs,
depResolverStrongFlags :: StrongFlags,
depResolverBuildTypeCustom :: Bool,

-- | Whether to allow base and its dependencies to be installed.
depResolverAllowBootLibInstalls :: AllowBootLibInstalls,
Expand Down Expand Up @@ -195,6 +197,7 @@ showDepResolverParams p =
++ "\navoid reinstalls: " ++ show (asBool (depResolverAvoidReinstalls p))
++ "\nshadow packages: " ++ show (asBool (depResolverShadowPkgs p))
++ "\nstrong flags: " ++ show (asBool (depResolverStrongFlags p))
++ "\nbuild type custom: " ++ show (depResolverBuildTypeCustom p)
++ "\nallow boot library installs: " ++ show (asBool (depResolverAllowBootLibInstalls p))
++ "\nonly constrained packages: " ++ show (depResolverOnlyConstrained p)
++ "\nmax backjumps: " ++ maybe "infinite" show
Expand Down Expand Up @@ -253,6 +256,7 @@ basicDepResolverParams installedPkgIndex sourcePkgIndex =
depResolverAvoidReinstalls = AvoidReinstalls False,
depResolverShadowPkgs = ShadowPkgs False,
depResolverStrongFlags = StrongFlags False,
depResolverBuildTypeCustom = True,
depResolverAllowBootLibInstalls = AllowBootLibInstalls False,
depResolverOnlyConstrained = OnlyConstrainedNone,
depResolverMaxBackjumps = Nothing,
Expand Down Expand Up @@ -304,6 +308,9 @@ setCountConflicts count params =
depResolverCountConflicts = count
}

setBuildTypeCustom :: Bool -> DepResolverParams -> DepResolverParams
setBuildTypeCustom x params = params { depResolverBuildTypeCustom = x }

setFineGrainedConflicts :: FineGrainedConflicts -> DepResolverParams -> DepResolverParams
setFineGrainedConflicts fineGrained params =
params {
Expand Down Expand Up @@ -705,14 +712,15 @@ resolveDependencies platform comp pkgConfigDB solver params =

Step (showDepResolverParams finalparams)
$ fmap (validateSolverResult platform comp indGoals)
$ runSolver solver (SolverConfig reordGoals cntConflicts fineGrained minimize
indGoals noReinstalls
shadowing strFlags allowBootLibs onlyConstrained_ maxBkjumps enableBj
solveExes order verbosity (PruneAfterFirstSuccess False))
$ runSolver solver solverConfig
platform comp installedPkgIndex sourcePkgIndex
pkgConfigDB preferences constraints targets
where

solverConfig = SolverConfig reordGoals cntConflicts fineGrained minimize
indGoals noReinstalls
shadowing strFlags allowBootLibs onlyConstrained_ buildTypeCustom_ maxBkjumps enableBj
solveExes order verbosity (PruneAfterFirstSuccess False)
buildTypeCustom_ = if buildTypeCustom then Nothing else Just $ Set.fromList [PD.Simple, PD.Configure, PD.Make]
finalparams@(DepResolverParams
targets constraints
prefs defpref
Expand All @@ -726,6 +734,7 @@ resolveDependencies platform comp pkgConfigDB solver params =
noReinstalls
shadowing
strFlags
buildTypeCustom
allowBootLibs
onlyConstrained_
maxBkjumps
Expand Down Expand Up @@ -992,7 +1001,7 @@ resolveWithoutDependencies (DepResolverParams targets constraints
prefs defpref installedPkgIndex sourcePkgIndex
_reorderGoals _countConflicts _fineGrained
_minimizeConflictSet _indGoals _avoidReinstalls
_shadowing _strFlags _maxBjumps _enableBj _solveExes
_shadowing _strFlags _buildTypeCustom _maxBjumps _enableBj _solveExes
_allowBootLibInstalls _onlyConstrained _order _verbosity) =
collectEithers $ map selectPackage (Set.toList targets)
where
Expand Down
1 change: 1 addition & 0 deletions cabal-install/src/Distribution/Client/ProjectConfig.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -251,6 +251,7 @@ resolveSolverSettings ProjectConfig{
solverSettingAllowBootLibInstalls = fromFlag projectConfigAllowBootLibInstalls
solverSettingOnlyConstrained = fromFlag projectConfigOnlyConstrained
solverSettingIndexState = flagToMaybe projectConfigIndexState
solverSettingBuildTypeCustom = fromFlag projectConfigBuildTypeCustom
solverSettingActiveRepos = flagToMaybe projectConfigActiveRepos
solverSettingIndependentGoals = fromFlag projectConfigIndependentGoals
--solverSettingShadowPkgs = fromFlag projectConfigShadowPkgs
Expand Down
Loading