From 5b3be96f0af782503a2ff1c36cb93ad674da8aa8 Mon Sep 17 00:00:00 2001 From: maralorn Date: Mon, 12 Jun 2023 14:55:55 +0200 Subject: [PATCH 1/9] Cabal: Copy cabal-install Distribution.Client.Types.AllowNewer -> Cabal Distribution.Types.AllowNewer In this first step only copy so the diff in the next commit makes clear what is happening. --- Cabal/src/Distribution/Types/AllowNewer.hs | 244 +++++++++++++++++++++ 1 file changed, 244 insertions(+) create mode 100644 Cabal/src/Distribution/Types/AllowNewer.hs diff --git a/Cabal/src/Distribution/Types/AllowNewer.hs b/Cabal/src/Distribution/Types/AllowNewer.hs new file mode 100644 index 00000000000..0a5700174b8 --- /dev/null +++ b/Cabal/src/Distribution/Types/AllowNewer.hs @@ -0,0 +1,244 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Distribution.Client.Types.AllowNewer + ( AllowNewer (..) + , AllowOlder (..) + , RelaxDeps (..) + , mkRelaxDepSome + , RelaxDepMod (..) + , RelaxDepScope (..) + , RelaxDepSubject (..) + , RelaxedDep (..) + , isRelaxDeps + ) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Distribution.Parsec (parsecLeadingCommaNonEmpty) +import Distribution.Types.PackageId (PackageId, PackageIdentifier (..)) +import Distribution.Types.PackageName (PackageName, mkPackageName) +import Distribution.Types.Version (nullVersion) + +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as Disp + +-- $setup +-- >>> import Distribution.Parsec + +-- TODO: When https://github.com/haskell/cabal/issues/4203 gets tackled, +-- it may make sense to move these definitions to the Solver.Types +-- module + +-- | 'RelaxDeps' in the context of upper bounds (i.e. for @--allow-newer@ flag) +newtype AllowNewer = AllowNewer {unAllowNewer :: RelaxDeps} + deriving (Eq, Read, Show, Generic) + +-- | 'RelaxDeps' in the context of lower bounds (i.e. for @--allow-older@ flag) +newtype AllowOlder = AllowOlder {unAllowOlder :: RelaxDeps} + deriving (Eq, Read, Show, Generic) + +-- | Generic data type for policy when relaxing bounds in dependencies. +-- Don't use this directly: use 'AllowOlder' or 'AllowNewer' depending +-- on whether or not you are relaxing an lower or upper bound +-- (respectively). +data RelaxDeps + = -- | Ignore upper (resp. lower) bounds in some (or no) dependencies on the given packages. + -- + -- @RelaxDepsSome []@ is the default, i.e. honor the bounds in all + -- dependencies, never choose versions newer (resp. older) than allowed. + RelaxDepsSome [RelaxedDep] + | -- | Ignore upper (resp. lower) bounds in dependencies on all packages. + -- + -- __Note__: This is should be semantically equivalent to + -- + -- > RelaxDepsSome [RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll] + -- + -- (TODO: consider normalising 'RelaxDeps' and/or 'RelaxedDep') + RelaxDepsAll + deriving (Eq, Read, Show, Generic) + +-- | Dependencies can be relaxed either for all packages in the install plan, or +-- only for some packages. +data RelaxedDep = RelaxedDep !RelaxDepScope !RelaxDepMod !RelaxDepSubject + deriving (Eq, Read, Show, Generic) + +-- | Specify the scope of a relaxation, i.e. limit which depending +-- packages are allowed to have their version constraints relaxed. +data RelaxDepScope + = -- | Apply relaxation in any package + RelaxDepScopeAll + | -- | Apply relaxation to in all versions of a package + RelaxDepScopePackage !PackageName + | -- | Apply relaxation to a specific version of a package only + RelaxDepScopePackageId !PackageId + deriving (Eq, Read, Show, Generic) + +-- | Modifier for dependency relaxation +data RelaxDepMod + = -- | Default semantics + RelaxDepModNone + | -- | Apply relaxation only to @^>=@ constraints + RelaxDepModCaret + deriving (Eq, Read, Show, Generic) + +-- | Express whether to relax bounds /on/ @all@ packages, or a single package +data RelaxDepSubject + = RelaxDepSubjectAll + | RelaxDepSubjectPkg !PackageName + deriving (Eq, Ord, Read, Show, Generic) + +instance Pretty RelaxedDep where + pretty (RelaxedDep scope rdmod subj) = case scope of + RelaxDepScopeAll -> Disp.text "*:" Disp.<> modDep + RelaxDepScopePackage p0 -> pretty p0 Disp.<> Disp.colon Disp.<> modDep + RelaxDepScopePackageId p0 -> pretty p0 Disp.<> Disp.colon Disp.<> modDep + where + modDep = case rdmod of + RelaxDepModNone -> pretty subj + RelaxDepModCaret -> Disp.char '^' Disp.<> pretty subj + +instance Parsec RelaxedDep where + parsec = P.char '*' *> relaxedDepStarP <|> (parsec >>= relaxedDepPkgidP) + +-- continuation after * +relaxedDepStarP :: CabalParsing m => m RelaxedDep +relaxedDepStarP = + RelaxedDep RelaxDepScopeAll <$ P.char ':' <*> modP <*> parsec + <|> pure (RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll) + +-- continuation after package identifier +relaxedDepPkgidP :: CabalParsing m => PackageIdentifier -> m RelaxedDep +relaxedDepPkgidP pid@(PackageIdentifier pn v) + | pn == mkPackageName "all" + , v == nullVersion = + RelaxedDep RelaxDepScopeAll <$ P.char ':' <*> modP <*> parsec + <|> pure (RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll) + | v == nullVersion = + RelaxedDep (RelaxDepScopePackage pn) <$ P.char ':' <*> modP <*> parsec + <|> pure (RelaxedDep RelaxDepScopeAll RelaxDepModNone (RelaxDepSubjectPkg pn)) + | otherwise = + RelaxedDep (RelaxDepScopePackageId pid) <$ P.char ':' <*> modP <*> parsec + +modP :: P.CharParsing m => m RelaxDepMod +modP = RelaxDepModCaret <$ P.char '^' <|> pure RelaxDepModNone + +instance Pretty RelaxDepSubject where + pretty RelaxDepSubjectAll = Disp.text "*" + pretty (RelaxDepSubjectPkg pn) = pretty pn + +instance Parsec RelaxDepSubject where + parsec = RelaxDepSubjectAll <$ P.char '*' <|> pkgn + where + pkgn = do + pn <- parsec + pure $ + if pn == mkPackageName "all" + then RelaxDepSubjectAll + else RelaxDepSubjectPkg pn + +instance Pretty RelaxDeps where + pretty rd | not (isRelaxDeps rd) = Disp.text "none" + pretty (RelaxDepsSome pkgs) = + Disp.fsep + . Disp.punctuate Disp.comma + . map pretty + $ pkgs + pretty RelaxDepsAll = Disp.text "all" + +-- | +-- +-- >>> simpleParsec "all" :: Maybe RelaxDeps +-- Just RelaxDepsAll +-- +-- >>> simpleParsec "none" :: Maybe RelaxDeps +-- Just (RelaxDepsSome []) +-- +-- >>> simpleParsec "*, *" :: Maybe RelaxDeps +-- Just RelaxDepsAll +-- +-- >>> simpleParsec "*:*" :: Maybe RelaxDeps +-- Just RelaxDepsAll +-- +-- >>> simpleParsec "foo:bar, quu:puu" :: Maybe RelaxDeps +-- Just (RelaxDepsSome [RelaxedDep (RelaxDepScopePackage (PackageName "foo")) RelaxDepModNone (RelaxDepSubjectPkg (PackageName "bar")),RelaxedDep (RelaxDepScopePackage (PackageName "quu")) RelaxDepModNone (RelaxDepSubjectPkg (PackageName "puu"))]) +-- +-- This is not a glitch, even it looks like: +-- +-- >>> simpleParsec ", all" :: Maybe RelaxDeps +-- Just RelaxDepsAll +-- +-- >>> simpleParsec "" :: Maybe RelaxDeps +-- Nothing +instance Parsec RelaxDeps where + parsec = do + xs <- parsecLeadingCommaNonEmpty parsec + pure $ case toList xs of + [RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll] -> + RelaxDepsAll + [RelaxedDep RelaxDepScopeAll RelaxDepModNone (RelaxDepSubjectPkg pn)] + | pn == mkPackageName "none" -> + mempty + xs' -> mkRelaxDepSome xs' + +instance Binary RelaxDeps +instance Binary RelaxDepMod +instance Binary RelaxDepScope +instance Binary RelaxDepSubject +instance Binary RelaxedDep +instance Binary AllowNewer +instance Binary AllowOlder + +instance Structured RelaxDeps +instance Structured RelaxDepMod +instance Structured RelaxDepScope +instance Structured RelaxDepSubject +instance Structured RelaxedDep +instance Structured AllowNewer +instance Structured AllowOlder + +-- | Return 'True' if 'RelaxDeps' specifies a non-empty set of relaxations +-- +-- Equivalent to @isRelaxDeps = (/= 'mempty')@ +isRelaxDeps :: RelaxDeps -> Bool +isRelaxDeps (RelaxDepsSome []) = False +isRelaxDeps (RelaxDepsSome (_ : _)) = True +isRelaxDeps RelaxDepsAll = True + +-- | A smarter 'RelaxedDepsSome', @*:*@ is the same as @all@. +mkRelaxDepSome :: [RelaxedDep] -> RelaxDeps +mkRelaxDepSome xs + | any (== RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll) xs = + RelaxDepsAll + | otherwise = + RelaxDepsSome xs + +-- | 'RelaxDepsAll' is the /absorbing element/ +instance Semigroup RelaxDeps where + -- identity element + RelaxDepsSome [] <> r = r + l@(RelaxDepsSome _) <> RelaxDepsSome [] = l + -- absorbing element + l@RelaxDepsAll <> _ = l + (RelaxDepsSome _) <> r@RelaxDepsAll = r + -- combining non-{identity,absorbing} elements + (RelaxDepsSome a) <> (RelaxDepsSome b) = RelaxDepsSome (a ++ b) + +-- | @'RelaxDepsSome' []@ is the /identity element/ +instance Monoid RelaxDeps where + mempty = RelaxDepsSome [] + mappend = (<>) + +instance Semigroup AllowNewer where + AllowNewer x <> AllowNewer y = AllowNewer (x <> y) + +instance Semigroup AllowOlder where + AllowOlder x <> AllowOlder y = AllowOlder (x <> y) + +instance Monoid AllowNewer where + mempty = AllowNewer mempty + mappend = (<>) + +instance Monoid AllowOlder where + mempty = AllowOlder mempty + mappend = (<>) From d167a3e16f0b2d771bced018474abc74835c9f92 Mon Sep 17 00:00:00 2001 From: maralorn Date: Mon, 12 Jun 2023 14:57:24 +0200 Subject: [PATCH 2/9] Cabal: Fix Distribution.Types.AllowNewer to build in Cabal --- Cabal/Cabal.cabal | 1 + Cabal/src/Distribution/Types/AllowNewer.hs | 8 ++++---- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index b1049bc5c62..7aabe62356f 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -140,6 +140,7 @@ library Distribution.Simple.UserHooks Distribution.Simple.Utils Distribution.TestSuite + Distribution.Types.AllowNewer Distribution.Types.AnnotatedId Distribution.Types.ComponentInclude Distribution.Types.DumpBuildInfo diff --git a/Cabal/src/Distribution/Types/AllowNewer.hs b/Cabal/src/Distribution/Types/AllowNewer.hs index 0a5700174b8..4f2a27e9e5f 100644 --- a/Cabal/src/Distribution/Types/AllowNewer.hs +++ b/Cabal/src/Distribution/Types/AllowNewer.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} -module Distribution.Client.Types.AllowNewer +module Distribution.Types.AllowNewer ( AllowNewer (..) , AllowOlder (..) , RelaxDeps (..) @@ -12,15 +12,15 @@ module Distribution.Client.Types.AllowNewer , isRelaxDeps ) where -import Distribution.Client.Compat.Prelude -import Prelude () +import Distribution.Compat.Prelude -import Distribution.Parsec (parsecLeadingCommaNonEmpty) +import Distribution.Parsec (CabalParsing, Parsec (parsec), parsecLeadingCommaNonEmpty) import Distribution.Types.PackageId (PackageId, PackageIdentifier (..)) import Distribution.Types.PackageName (PackageName, mkPackageName) import Distribution.Types.Version (nullVersion) import qualified Distribution.Compat.CharParsing as P +import Distribution.Pretty (Pretty (pretty)) import qualified Text.PrettyPrint as Disp -- $setup From fa205e2f98651386f2770abda5ddf751572987df Mon Sep 17 00:00:00 2001 From: maralorn Date: Mon, 12 Jun 2023 15:18:17 +0200 Subject: [PATCH 3/9] Cabal: Copy cabal-install Distribution.Client.Dependency -> Cabal Distribution.AllowNewer File will be edited in next commit, doing this separately to preserve Diff --- Cabal/src/Distribution/AllowNewer.hs | 1236 ++++++++++++++++++++++++++ 1 file changed, 1236 insertions(+) create mode 100644 Cabal/src/Distribution/AllowNewer.hs diff --git a/Cabal/src/Distribution/AllowNewer.hs b/Cabal/src/Distribution/AllowNewer.hs new file mode 100644 index 00000000000..5bc5ec51b86 --- /dev/null +++ b/Cabal/src/Distribution/AllowNewer.hs @@ -0,0 +1,1236 @@ +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- + +-- | +-- Module : Distribution.Client.Dependency +-- Copyright : (c) David Himmelstrup 2005, +-- Bjorn Bringert 2007 +-- Duncan Coutts 2008 +-- License : BSD-like +-- +-- Maintainer : cabal-devel@gmail.com +-- Stability : provisional +-- Portability : portable +-- +-- Top level interface to dependency resolution. +module Distribution.Client.Dependency + ( -- * The main package dependency resolver + DepResolverParams + , chooseSolver + , resolveDependencies + , Progress (..) + , foldProgress + + -- * Alternate, simple resolver that does not do dependencies recursively + , resolveWithoutDependencies + + -- * Constructing resolver policies + , PackageProperty (..) + , PackageConstraint (..) + , scopeToplevel + , PackagesPreferenceDefault (..) + , PackagePreference (..) + + -- ** Standard policy + , basicInstallPolicy + , standardInstallPolicy + , PackageSpecifier (..) + + -- ** Extra policy options + , upgradeDependencies + , reinstallTargets + + -- ** Policy utils + , addConstraints + , addPreferences + , setPreferenceDefault + , setReorderGoals + , setCountConflicts + , setFineGrainedConflicts + , setMinimizeConflictSet + , setIndependentGoals + , setAvoidReinstalls + , setShadowPkgs + , setStrongFlags + , setAllowBootLibInstalls + , setOnlyConstrained + , setMaxBackjumps + , setEnableBackjumping + , setSolveExecutables + , setGoalOrder + , setSolverVerbosity + , removeLowerBounds + , removeUpperBounds + , addDefaultSetupDependencies + , addSetupCabalMinVersionConstraint + , addSetupCabalMaxVersionConstraint + ) where + +import Distribution.Client.Compat.Prelude +import qualified Prelude as Unsafe (head) + +import Distribution.Client.Dependency.Types + ( PackagesPreferenceDefault (..) + , PreSolver (..) + , Solver (..) + ) +import Distribution.Client.SolverInstallPlan (SolverInstallPlan) +import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan +import Distribution.Client.Types + ( AllowNewer (..) + , AllowOlder (..) + , PackageSpecifier (..) + , RelaxDepMod (..) + , RelaxDepScope (..) + , RelaxDepSubject (..) + , RelaxDeps (..) + , RelaxedDep (..) + , SourcePackageDb (SourcePackageDb) + , UnresolvedPkgLoc + , UnresolvedSourcePackage + , isRelaxDeps + , pkgSpecifierConstraints + , pkgSpecifierTarget + ) +import Distribution.Client.Utils + ( MergeResult (..) + , duplicatesBy + , mergeBy + ) +import qualified Distribution.Compat.Graph as Graph +import Distribution.Compiler + ( CompilerInfo (..) + ) +import Distribution.Package + ( Package (..) + , PackageId + , PackageIdentifier (PackageIdentifier) + , PackageName + , mkPackageName + , packageName + , packageVersion + ) +import qualified Distribution.PackageDescription as PD +import Distribution.PackageDescription.Configuration + ( finalizePD + ) +import qualified Distribution.PackageDescription.Configuration as PD +import Distribution.Simple.PackageIndex (InstalledPackageIndex) +import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex +import Distribution.Simple.Setup + ( asBool + ) +import Distribution.Solver.Modular + ( PruneAfterFirstSuccess (..) + , SolverConfig (..) + , modularResolver + ) +import Distribution.System + ( Platform + ) +import Distribution.Types.Dependency +import Distribution.Verbosity + ( normal + ) +import Distribution.Version + +import Distribution.Solver.Types.ComponentDeps (ComponentDeps) +import qualified Distribution.Solver.Types.ComponentDeps as CD +import Distribution.Solver.Types.ConstraintSource +import Distribution.Solver.Types.DependencyResolver +import Distribution.Solver.Types.InstalledPreference as Preference +import Distribution.Solver.Types.LabeledPackageConstraint +import Distribution.Solver.Types.OptionalStanza +import Distribution.Solver.Types.PackageConstraint +import qualified Distribution.Solver.Types.PackageIndex as PackageIndex +import Distribution.Solver.Types.PackagePath +import Distribution.Solver.Types.PackagePreferences +import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb) +import Distribution.Solver.Types.Progress +import Distribution.Solver.Types.ResolverPackage +import Distribution.Solver.Types.Settings +import Distribution.Solver.Types.SolverId +import Distribution.Solver.Types.SolverPackage +import Distribution.Solver.Types.SourcePackage +import Distribution.Solver.Types.Variable + +import Control.Exception + ( assert + ) +import Data.List + ( maximumBy + ) +import qualified Data.Map as Map +import qualified Data.Set as Set + +-- ------------------------------------------------------------ + +-- * High level planner policy + +-- ------------------------------------------------------------ + +-- | The set of parameters to the dependency resolver. These parameters are +-- relatively low level but many kinds of high level policies can be +-- implemented in terms of adjustments to the parameters. +data DepResolverParams = DepResolverParams + { depResolverTargets :: Set PackageName + , depResolverConstraints :: [LabeledPackageConstraint] + , depResolverPreferences :: [PackagePreference] + , depResolverPreferenceDefault :: PackagesPreferenceDefault + , depResolverInstalledPkgIndex :: InstalledPackageIndex + , depResolverSourcePkgIndex :: PackageIndex.PackageIndex UnresolvedSourcePackage + , depResolverReorderGoals :: ReorderGoals + , depResolverCountConflicts :: CountConflicts + , depResolverFineGrainedConflicts :: FineGrainedConflicts + , depResolverMinimizeConflictSet :: MinimizeConflictSet + , depResolverIndependentGoals :: IndependentGoals + , depResolverAvoidReinstalls :: AvoidReinstalls + , depResolverShadowPkgs :: ShadowPkgs + , depResolverStrongFlags :: StrongFlags + , depResolverAllowBootLibInstalls :: AllowBootLibInstalls + -- ^ Whether to allow base and its dependencies to be installed. + , depResolverOnlyConstrained :: OnlyConstrained + -- ^ Whether to only allow explicitly constrained packages plus + -- goals or to allow any package. + , depResolverMaxBackjumps :: Maybe Int + , depResolverEnableBackjumping :: EnableBackjumping + , depResolverSolveExecutables :: SolveExecutables + -- ^ Whether or not to solve for dependencies on executables. + -- This should be true, except in the legacy code path where + -- we can't tell if an executable has been installed or not, + -- so we shouldn't solve for them. See #3875. + , depResolverGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering) + -- ^ Function to override the solver's goal-ordering heuristics. + , depResolverVerbosity :: Verbosity + } + +showDepResolverParams :: DepResolverParams -> String +showDepResolverParams p = + "targets: " + ++ intercalate ", " (map prettyShow $ Set.toList (depResolverTargets p)) + ++ "\nconstraints: " + ++ concatMap + (("\n " ++) . showLabeledConstraint) + (depResolverConstraints p) + ++ "\npreferences: " + ++ concatMap + (("\n " ++) . showPackagePreference) + (depResolverPreferences p) + ++ "\nstrategy: " + ++ show (depResolverPreferenceDefault p) + ++ "\nreorder goals: " + ++ show (asBool (depResolverReorderGoals p)) + ++ "\ncount conflicts: " + ++ show (asBool (depResolverCountConflicts p)) + ++ "\nfine grained conflicts: " + ++ show (asBool (depResolverFineGrainedConflicts p)) + ++ "\nminimize conflict set: " + ++ show (asBool (depResolverMinimizeConflictSet p)) + ++ "\nindependent goals: " + ++ show (asBool (depResolverIndependentGoals p)) + ++ "\navoid reinstalls: " + ++ show (asBool (depResolverAvoidReinstalls p)) + ++ "\nshadow packages: " + ++ show (asBool (depResolverShadowPkgs p)) + ++ "\nstrong flags: " + ++ show (asBool (depResolverStrongFlags p)) + ++ "\nallow boot library installs: " + ++ show (asBool (depResolverAllowBootLibInstalls p)) + ++ "\nonly constrained packages: " + ++ show (depResolverOnlyConstrained p) + ++ "\nmax backjumps: " + ++ maybe + "infinite" + show + (depResolverMaxBackjumps p) + where + showLabeledConstraint :: LabeledPackageConstraint -> String + showLabeledConstraint (LabeledPackageConstraint pc src) = + showPackageConstraint pc ++ " (" ++ showConstraintSource src ++ ")" + +-- | A package selection preference for a particular package. +-- +-- Preferences are soft constraints that the dependency resolver should try to +-- respect where possible. It is not specified if preferences on some packages +-- are more important than others. +data PackagePreference + = -- | A suggested constraint on the version number. + PackageVersionPreference PackageName VersionRange + | -- | If we prefer versions of packages that are already installed. + PackageInstalledPreference PackageName InstalledPreference + | -- | If we would prefer to enable these optional stanzas + -- (i.e. test suites and/or benchmarks) + PackageStanzasPreference PackageName [OptionalStanza] + +-- | Provide a textual representation of a package preference +-- for debugging purposes. +showPackagePreference :: PackagePreference -> String +showPackagePreference (PackageVersionPreference pn vr) = + prettyShow pn ++ " " ++ prettyShow (simplifyVersionRange vr) +showPackagePreference (PackageInstalledPreference pn ip) = + prettyShow pn ++ " " ++ show ip +showPackagePreference (PackageStanzasPreference pn st) = + prettyShow pn ++ " " ++ show st + +basicDepResolverParams + :: InstalledPackageIndex + -> PackageIndex.PackageIndex UnresolvedSourcePackage + -> DepResolverParams +basicDepResolverParams installedPkgIndex sourcePkgIndex = + DepResolverParams + { depResolverTargets = Set.empty + , depResolverConstraints = [] + , depResolverPreferences = [] + , depResolverPreferenceDefault = PreferLatestForSelected + , depResolverInstalledPkgIndex = installedPkgIndex + , depResolverSourcePkgIndex = sourcePkgIndex + , depResolverReorderGoals = ReorderGoals False + , depResolverCountConflicts = CountConflicts True + , depResolverFineGrainedConflicts = FineGrainedConflicts True + , depResolverMinimizeConflictSet = MinimizeConflictSet False + , depResolverIndependentGoals = IndependentGoals False + , depResolverAvoidReinstalls = AvoidReinstalls False + , depResolverShadowPkgs = ShadowPkgs False + , depResolverStrongFlags = StrongFlags False + , depResolverAllowBootLibInstalls = AllowBootLibInstalls False + , depResolverOnlyConstrained = OnlyConstrainedNone + , depResolverMaxBackjumps = Nothing + , depResolverEnableBackjumping = EnableBackjumping True + , depResolverSolveExecutables = SolveExecutables True + , depResolverGoalOrder = Nothing + , depResolverVerbosity = normal + } + +addTargets + :: [PackageName] + -> DepResolverParams + -> DepResolverParams +addTargets extraTargets params = + params + { depResolverTargets = Set.fromList extraTargets `Set.union` depResolverTargets params + } + +addConstraints + :: [LabeledPackageConstraint] + -> DepResolverParams + -> DepResolverParams +addConstraints extraConstraints params = + params + { depResolverConstraints = + extraConstraints + ++ depResolverConstraints params + } + +addPreferences + :: [PackagePreference] + -> DepResolverParams + -> DepResolverParams +addPreferences extraPreferences params = + params + { depResolverPreferences = + extraPreferences + ++ depResolverPreferences params + } + +setPreferenceDefault + :: PackagesPreferenceDefault + -> DepResolverParams + -> DepResolverParams +setPreferenceDefault preferenceDefault params = + params + { depResolverPreferenceDefault = preferenceDefault + } + +setReorderGoals :: ReorderGoals -> DepResolverParams -> DepResolverParams +setReorderGoals reorder params = + params + { depResolverReorderGoals = reorder + } + +setCountConflicts :: CountConflicts -> DepResolverParams -> DepResolverParams +setCountConflicts count params = + params + { depResolverCountConflicts = count + } + +setFineGrainedConflicts :: FineGrainedConflicts -> DepResolverParams -> DepResolverParams +setFineGrainedConflicts fineGrained params = + params + { depResolverFineGrainedConflicts = fineGrained + } + +setMinimizeConflictSet :: MinimizeConflictSet -> DepResolverParams -> DepResolverParams +setMinimizeConflictSet minimize params = + params + { depResolverMinimizeConflictSet = minimize + } + +setIndependentGoals :: IndependentGoals -> DepResolverParams -> DepResolverParams +setIndependentGoals indep params = + params + { depResolverIndependentGoals = indep + } + +setAvoidReinstalls :: AvoidReinstalls -> DepResolverParams -> DepResolverParams +setAvoidReinstalls avoid params = + params + { depResolverAvoidReinstalls = avoid + } + +setShadowPkgs :: ShadowPkgs -> DepResolverParams -> DepResolverParams +setShadowPkgs shadow params = + params + { depResolverShadowPkgs = shadow + } + +setStrongFlags :: StrongFlags -> DepResolverParams -> DepResolverParams +setStrongFlags sf params = + params + { depResolverStrongFlags = sf + } + +setAllowBootLibInstalls :: AllowBootLibInstalls -> DepResolverParams -> DepResolverParams +setAllowBootLibInstalls i params = + params + { depResolverAllowBootLibInstalls = i + } + +setOnlyConstrained :: OnlyConstrained -> DepResolverParams -> DepResolverParams +setOnlyConstrained i params = + params + { depResolverOnlyConstrained = i + } + +setMaxBackjumps :: Maybe Int -> DepResolverParams -> DepResolverParams +setMaxBackjumps n params = + params + { depResolverMaxBackjumps = n + } + +setEnableBackjumping :: EnableBackjumping -> DepResolverParams -> DepResolverParams +setEnableBackjumping b params = + params + { depResolverEnableBackjumping = b + } + +setSolveExecutables :: SolveExecutables -> DepResolverParams -> DepResolverParams +setSolveExecutables b params = + params + { depResolverSolveExecutables = b + } + +setGoalOrder + :: Maybe (Variable QPN -> Variable QPN -> Ordering) + -> DepResolverParams + -> DepResolverParams +setGoalOrder order params = + params + { depResolverGoalOrder = order + } + +setSolverVerbosity :: Verbosity -> DepResolverParams -> DepResolverParams +setSolverVerbosity verbosity params = + params + { depResolverVerbosity = verbosity + } + +-- | Some packages are specific to a given compiler version and should never be +-- upgraded. +dontUpgradeNonUpgradeablePackages :: DepResolverParams -> DepResolverParams +dontUpgradeNonUpgradeablePackages params = + addConstraints extraConstraints params + where + extraConstraints = + [ LabeledPackageConstraint + (PackageConstraint (ScopeAnyQualifier pkgname) PackagePropertyInstalled) + ConstraintSourceNonUpgradeablePackage + | Set.notMember (mkPackageName "base") (depResolverTargets params) + , pkgname <- nonUpgradeablePackages + , isInstalled pkgname + ] + + isInstalled = + not + . null + . InstalledPackageIndex.lookupPackageName + (depResolverInstalledPkgIndex params) + +-- NOTE: the lists of non-upgradable and non-installable packages used to be +-- respectively in this module and in `Distribution.Solver.Modular.Solver`. +-- Since they were kept synced, they are now combined in the following list. +-- +-- See: https://github.com/haskell/cabal/issues/8581 +nonUpgradeablePackages :: [PackageName] +nonUpgradeablePackages = + [ mkPackageName "base" + , mkPackageName "ghc-bignum" + , mkPackageName "ghc-prim" + , mkPackageName "ghc-boot" + , mkPackageName "ghc" + , mkPackageName "ghci" + , mkPackageName "integer-gmp" + , mkPackageName "integer-simple" + , mkPackageName "template-haskell" + ] + +addSourcePackages + :: [UnresolvedSourcePackage] + -> DepResolverParams + -> DepResolverParams +addSourcePackages pkgs params = + params + { depResolverSourcePkgIndex = + foldl + (flip PackageIndex.insert) + (depResolverSourcePkgIndex params) + pkgs + } + +hideInstalledPackagesSpecificBySourcePackageId + :: [PackageId] + -> DepResolverParams + -> DepResolverParams +hideInstalledPackagesSpecificBySourcePackageId pkgids params = + -- TODO: this should work using exclude constraints instead + params + { depResolverInstalledPkgIndex = + foldl' + (flip InstalledPackageIndex.deleteSourcePackageId) + (depResolverInstalledPkgIndex params) + pkgids + } + +hideInstalledPackagesAllVersions + :: [PackageName] + -> DepResolverParams + -> DepResolverParams +hideInstalledPackagesAllVersions pkgnames params = + -- TODO: this should work using exclude constraints instead + params + { depResolverInstalledPkgIndex = + foldl' + (flip InstalledPackageIndex.deletePackageName) + (depResolverInstalledPkgIndex params) + pkgnames + } + +-- | Remove upper bounds in dependencies using the policy specified by the +-- 'AllowNewer' argument (all/some/none). +-- +-- Note: It's important to apply 'removeUpperBounds' after +-- 'addSourcePackages'. Otherwise, the packages inserted by +-- 'addSourcePackages' won't have upper bounds in dependencies relaxed. +removeUpperBounds :: AllowNewer -> DepResolverParams -> DepResolverParams +removeUpperBounds (AllowNewer relDeps) = removeBounds RelaxUpper relDeps + +-- | Dual of 'removeUpperBounds' +removeLowerBounds :: AllowOlder -> DepResolverParams -> DepResolverParams +removeLowerBounds (AllowOlder relDeps) = removeBounds RelaxLower relDeps + +data RelaxKind = RelaxLower | RelaxUpper + +-- | Common internal implementation of 'removeLowerBounds'/'removeUpperBounds' +removeBounds :: RelaxKind -> RelaxDeps -> DepResolverParams -> DepResolverParams +removeBounds _ rd params | not (isRelaxDeps rd) = params -- no-op optimisation +removeBounds relKind relDeps params = + params + { depResolverSourcePkgIndex = sourcePkgIndex' + } + where + sourcePkgIndex' :: PackageIndex.PackageIndex UnresolvedSourcePackage + sourcePkgIndex' = relaxDeps <$> depResolverSourcePkgIndex params + + relaxDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage + relaxDeps srcPkg = + srcPkg + { srcpkgDescription = relaxPackageDeps relKind relDeps (srcpkgDescription srcPkg) + } + +-- | Relax the dependencies of this package if needed. +-- +-- Helper function used by 'removeBounds' +relaxPackageDeps + :: RelaxKind + -> RelaxDeps + -> PD.GenericPackageDescription + -> PD.GenericPackageDescription +relaxPackageDeps _ rd gpd | not (isRelaxDeps rd) = gpd -- subsumed by no-op case in 'removeBounds' +relaxPackageDeps relKind RelaxDepsAll gpd = PD.transformAllBuildDepends relaxAll gpd + where + relaxAll :: Dependency -> Dependency + relaxAll (Dependency pkgName verRange cs) = + Dependency pkgName (removeBound relKind RelaxDepModNone verRange) cs +relaxPackageDeps relKind (RelaxDepsSome depsToRelax0) gpd = + PD.transformAllBuildDepends relaxSome gpd + where + thisPkgName = packageName gpd + thisPkgId = packageId gpd + depsToRelax = Map.fromList $ mapMaybe f depsToRelax0 + + f :: RelaxedDep -> Maybe (RelaxDepSubject, RelaxDepMod) + f (RelaxedDep scope rdm p) = case scope of + RelaxDepScopeAll -> Just (p, rdm) + RelaxDepScopePackage p0 + | p0 == thisPkgName -> Just (p, rdm) + | otherwise -> Nothing + RelaxDepScopePackageId p0 + | p0 == thisPkgId -> Just (p, rdm) + | otherwise -> Nothing + + relaxSome :: Dependency -> Dependency + relaxSome d@(Dependency depName verRange cs) + | Just relMod <- Map.lookup RelaxDepSubjectAll depsToRelax = + -- a '*'-subject acts absorbing, for consistency with + -- the 'Semigroup RelaxDeps' instance + Dependency depName (removeBound relKind relMod verRange) cs + | Just relMod <- Map.lookup (RelaxDepSubjectPkg depName) depsToRelax = + Dependency depName (removeBound relKind relMod verRange) cs + | otherwise = d -- no-op + +-- | Internal helper for 'relaxPackageDeps' +removeBound :: RelaxKind -> RelaxDepMod -> VersionRange -> VersionRange +removeBound RelaxLower RelaxDepModNone = removeLowerBound +removeBound RelaxUpper RelaxDepModNone = removeUpperBound +removeBound RelaxLower RelaxDepModCaret = transformCaretLower +removeBound RelaxUpper RelaxDepModCaret = transformCaretUpper + +-- | Supply defaults for packages without explicit Setup dependencies +-- +-- Note: It's important to apply 'addDefaultSetupDepends' after +-- 'addSourcePackages'. Otherwise, the packages inserted by +-- 'addSourcePackages' won't have upper bounds in dependencies relaxed. +addDefaultSetupDependencies + :: (UnresolvedSourcePackage -> Maybe [Dependency]) + -> DepResolverParams + -> DepResolverParams +addDefaultSetupDependencies defaultSetupDeps params = + params + { depResolverSourcePkgIndex = + fmap applyDefaultSetupDeps (depResolverSourcePkgIndex params) + } + where + applyDefaultSetupDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage + applyDefaultSetupDeps srcpkg = + srcpkg + { srcpkgDescription = + gpkgdesc + { PD.packageDescription = + pkgdesc + { PD.setupBuildInfo = + case PD.setupBuildInfo pkgdesc of + Just sbi -> Just sbi + Nothing -> case defaultSetupDeps srcpkg of + Nothing -> Nothing + Just deps + | isCustom -> + Just + PD.SetupBuildInfo + { PD.defaultSetupDepends = True + , PD.setupDepends = deps + } + | otherwise -> Nothing + } + } + } + where + isCustom = PD.buildType pkgdesc == PD.Custom + gpkgdesc = srcpkgDescription srcpkg + pkgdesc = PD.packageDescription gpkgdesc + +-- | If a package has a custom setup then we need to add a setup-depends +-- on Cabal. +addSetupCabalMinVersionConstraint + :: Version + -> DepResolverParams + -> DepResolverParams +addSetupCabalMinVersionConstraint minVersion = + addConstraints + [ LabeledPackageConstraint + ( PackageConstraint + (ScopeAnySetupQualifier cabalPkgname) + (PackagePropertyVersion $ orLaterVersion minVersion) + ) + ConstraintSetupCabalMinVersion + ] + where + cabalPkgname = mkPackageName "Cabal" + +-- | Variant of 'addSetupCabalMinVersionConstraint' which sets an +-- upper bound on @setup.Cabal@ labeled with 'ConstraintSetupCabalMaxVersion'. +addSetupCabalMaxVersionConstraint + :: Version + -> DepResolverParams + -> DepResolverParams +addSetupCabalMaxVersionConstraint maxVersion = + addConstraints + [ LabeledPackageConstraint + ( PackageConstraint + (ScopeAnySetupQualifier cabalPkgname) + (PackagePropertyVersion $ earlierVersion maxVersion) + ) + ConstraintSetupCabalMaxVersion + ] + where + cabalPkgname = mkPackageName "Cabal" + +upgradeDependencies :: DepResolverParams -> DepResolverParams +upgradeDependencies = setPreferenceDefault PreferAllLatest + +reinstallTargets :: DepResolverParams -> DepResolverParams +reinstallTargets params = + hideInstalledPackagesAllVersions (Set.toList $ depResolverTargets params) params + +-- | A basic solver policy on which all others are built. +basicInstallPolicy + :: InstalledPackageIndex + -> SourcePackageDb + -> [PackageSpecifier UnresolvedSourcePackage] + -> DepResolverParams +basicInstallPolicy + installedPkgIndex + (SourcePackageDb sourcePkgIndex sourcePkgPrefs) + pkgSpecifiers = + addPreferences + [ PackageVersionPreference name ver + | (name, ver) <- Map.toList sourcePkgPrefs + ] + . addConstraints + (concatMap pkgSpecifierConstraints pkgSpecifiers) + . addTargets + (map pkgSpecifierTarget pkgSpecifiers) + . hideInstalledPackagesSpecificBySourcePackageId + [packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers] + . addSourcePackages + [pkg | SpecificSourcePackage pkg <- pkgSpecifiers] + $ basicDepResolverParams + installedPkgIndex + sourcePkgIndex + +-- | The policy used by all the standard commands, install, fetch, freeze etc +-- (but not the v2-build and related commands). +-- +-- It extends the 'basicInstallPolicy' with a policy on setup deps. +standardInstallPolicy + :: InstalledPackageIndex + -> SourcePackageDb + -> [PackageSpecifier UnresolvedSourcePackage] + -> DepResolverParams +standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers = + addDefaultSetupDependencies mkDefaultSetupDeps $ + basicInstallPolicy + installedPkgIndex + sourcePkgDb + pkgSpecifiers + where + -- Force Cabal >= 1.24 dep when the package is affected by #3199. + mkDefaultSetupDeps :: UnresolvedSourcePackage -> Maybe [Dependency] + mkDefaultSetupDeps srcpkg + | affected = + Just [Dependency (mkPackageName "Cabal") (orLaterVersion $ mkVersion [1, 24]) mainLibSet] + | otherwise = Nothing + where + gpkgdesc = srcpkgDescription srcpkg + pkgdesc = PD.packageDescription gpkgdesc + bt = PD.buildType pkgdesc + affected = bt == PD.Custom && hasBuildableFalse gpkgdesc + + -- Does this package contain any components with non-empty 'build-depends' + -- and a 'buildable' field that could potentially be set to 'False'? False + -- positives are possible. + hasBuildableFalse :: PD.GenericPackageDescription -> Bool + hasBuildableFalse gpkg = + not (all alwaysTrue (zipWith PD.cOr buildableConditions noDepConditions)) + where + buildableConditions = PD.extractConditions PD.buildable gpkg + noDepConditions = + PD.extractConditions + (null . PD.targetBuildDepends) + gpkg + alwaysTrue (PD.Lit True) = True + alwaysTrue _ = False + +-- ------------------------------------------------------------ + +-- * Interface to the standard resolver + +-- ------------------------------------------------------------ + +chooseSolver :: Verbosity -> PreSolver -> CompilerInfo -> IO Solver +chooseSolver _verbosity preSolver _cinfo = + case preSolver of + AlwaysModular -> do + return Modular + +runSolver :: Solver -> SolverConfig -> DependencyResolver UnresolvedPkgLoc +runSolver Modular = modularResolver + +-- | Run the dependency solver. +-- +-- Since this is potentially an expensive operation, the result is wrapped in a +-- a 'Progress' structure that can be unfolded to provide progress information, +-- logging messages and the final result or an error. +resolveDependencies + :: Platform + -> CompilerInfo + -> PkgConfigDb + -> Solver + -> DepResolverParams + -> Progress String String SolverInstallPlan +-- TODO: is this needed here? see dontUpgradeNonUpgradeablePackages +resolveDependencies platform comp _pkgConfigDB _solver params + | Set.null (depResolverTargets params) = + return (validateSolverResult platform comp indGoals []) + where + indGoals = depResolverIndependentGoals params +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 + -- See comment of nonUpgradeablePackages about + -- non-installable and non-upgradable packages. + nonUpgradeablePackages + onlyConstrained_ + maxBkjumps + enableBj + solveExes + order + verbosity + (PruneAfterFirstSuccess False) + ) + platform + comp + installedPkgIndex + sourcePkgIndex + pkgConfigDB + preferences + constraints + targets + where + finalparams@( DepResolverParams + targets + constraints + prefs + defpref + installedPkgIndex + sourcePkgIndex + reordGoals + cntConflicts + fineGrained + minimize + indGoals + noReinstalls + shadowing + strFlags + allowBootLibs + onlyConstrained_ + maxBkjumps + enableBj + solveExes + order + verbosity + ) = + if asBool (depResolverAllowBootLibInstalls params) + then params + else dontUpgradeNonUpgradeablePackages params + + preferences :: PackageName -> PackagePreferences + preferences = interpretPackagesPreference targets defpref prefs + +-- | Give an interpretation to the global 'PackagesPreference' as +-- specific per-package 'PackageVersionPreference'. +interpretPackagesPreference + :: Set PackageName + -> PackagesPreferenceDefault + -> [PackagePreference] + -> (PackageName -> PackagePreferences) +interpretPackagesPreference selected defaultPref prefs = + \pkgname -> + PackagePreferences + (versionPref pkgname) + (installPref pkgname) + (stanzasPref pkgname) + where + versionPref :: PackageName -> [VersionRange] + versionPref pkgname = + fromMaybe [anyVersion] (Map.lookup pkgname versionPrefs) + versionPrefs = + Map.fromListWith + (++) + [ (pkgname, [pref]) + | PackageVersionPreference pkgname pref <- prefs + ] + + installPref :: PackageName -> InstalledPreference + installPref pkgname = + fromMaybe (installPrefDefault pkgname) (Map.lookup pkgname installPrefs) + installPrefs = + Map.fromList + [ (pkgname, pref) + | PackageInstalledPreference pkgname pref <- prefs + ] + installPrefDefault = case defaultPref of + PreferAllLatest -> const Preference.PreferLatest + PreferAllOldest -> const Preference.PreferOldest + PreferAllInstalled -> const Preference.PreferInstalled + PreferLatestForSelected -> \pkgname -> + -- When you say cabal install foo, what you really mean is, prefer the + -- latest version of foo, but the installed version of everything else + if pkgname `Set.member` selected + then Preference.PreferLatest + else Preference.PreferInstalled + + stanzasPref :: PackageName -> [OptionalStanza] + stanzasPref pkgname = + fromMaybe [] (Map.lookup pkgname stanzasPrefs) + stanzasPrefs = + Map.fromListWith + (\a b -> nub (a ++ b)) + [ (pkgname, pref) + | PackageStanzasPreference pkgname pref <- prefs + ] + +-- ------------------------------------------------------------ + +-- * Checking the result of the solver + +-- ------------------------------------------------------------ + +-- | Make an install plan from the output of the dep resolver. +-- It checks that the plan is valid, or it's an error in the dep resolver. +validateSolverResult + :: Platform + -> CompilerInfo + -> IndependentGoals + -> [ResolverPackage UnresolvedPkgLoc] + -> SolverInstallPlan +validateSolverResult platform comp indepGoals pkgs = + case planPackagesProblems platform comp pkgs of + [] -> case SolverInstallPlan.new indepGoals graph of + Right plan -> plan + Left problems -> error (formatPlanProblems problems) + problems -> error (formatPkgProblems problems) + where + graph :: Graph.Graph (ResolverPackage UnresolvedPkgLoc) + graph = Graph.fromDistinctList pkgs + + formatPkgProblems :: [PlanPackageProblem] -> String + formatPkgProblems = formatProblemMessage . map showPlanPackageProblem + formatPlanProblems :: [SolverInstallPlan.SolverPlanProblem] -> String + formatPlanProblems = formatProblemMessage . map SolverInstallPlan.showPlanProblem + + formatProblemMessage problems = + unlines $ + "internal error: could not construct a valid install plan." + : "The proposed (invalid) plan contained the following problems:" + : problems + ++ "Proposed plan:" + : [SolverInstallPlan.showPlanIndex pkgs] + +data PlanPackageProblem + = InvalidConfiguredPackage + (SolverPackage UnresolvedPkgLoc) + [PackageProblem] + | DuplicatePackageSolverId SolverId [ResolverPackage UnresolvedPkgLoc] + +showPlanPackageProblem :: PlanPackageProblem -> String +showPlanPackageProblem (InvalidConfiguredPackage pkg packageProblems) = + "Package " + ++ prettyShow (packageId pkg) + ++ " has an invalid configuration, in particular:\n" + ++ unlines + [ " " ++ showPackageProblem problem + | problem <- packageProblems + ] +showPlanPackageProblem (DuplicatePackageSolverId pid dups) = + "Package " + ++ prettyShow (packageId pid) + ++ " has " + ++ show (length dups) + ++ " duplicate instances." + +planPackagesProblems + :: Platform + -> CompilerInfo + -> [ResolverPackage UnresolvedPkgLoc] + -> [PlanPackageProblem] +planPackagesProblems platform cinfo pkgs = + [ InvalidConfiguredPackage pkg packageProblems + | Configured pkg <- pkgs + , let packageProblems = configuredPackageProblems platform cinfo pkg + , not (null packageProblems) + ] + ++ [ DuplicatePackageSolverId (Graph.nodeKey (Unsafe.head dups)) dups + | dups <- duplicatesBy (comparing Graph.nodeKey) pkgs + ] + +data PackageProblem + = DuplicateFlag PD.FlagName + | MissingFlag PD.FlagName + | ExtraFlag PD.FlagName + | DuplicateDeps [PackageId] + | MissingDep Dependency + | ExtraDep PackageId + | InvalidDep Dependency PackageId + +showPackageProblem :: PackageProblem -> String +showPackageProblem (DuplicateFlag flag) = + "duplicate flag in the flag assignment: " ++ PD.unFlagName flag +showPackageProblem (MissingFlag flag) = + "missing an assignment for the flag: " ++ PD.unFlagName flag +showPackageProblem (ExtraFlag flag) = + "extra flag given that is not used by the package: " ++ PD.unFlagName flag +showPackageProblem (DuplicateDeps pkgids) = + "duplicate packages specified as selected dependencies: " + ++ intercalate ", " (map prettyShow pkgids) +showPackageProblem (MissingDep dep) = + "the package has a dependency " + ++ prettyShow dep + ++ " but no package has been selected to satisfy it." +showPackageProblem (ExtraDep pkgid) = + "the package configuration specifies " + ++ prettyShow pkgid + ++ " but (with the given flag assignment) the package does not actually" + ++ " depend on any version of that package." +showPackageProblem (InvalidDep dep pkgid) = + "the package depends on " + ++ prettyShow dep + ++ " but the configuration specifies " + ++ prettyShow pkgid + ++ " which does not satisfy the dependency." + +-- | A 'ConfiguredPackage' is valid if the flag assignment is total and if +-- in the configuration given by the flag assignment, all the package +-- dependencies are satisfied by the specified packages. +configuredPackageProblems + :: Platform + -> CompilerInfo + -> SolverPackage UnresolvedPkgLoc + -> [PackageProblem] +configuredPackageProblems + platform + cinfo + (SolverPackage pkg specifiedFlags stanzas specifiedDeps0 _specifiedExeDeps') = + [ DuplicateFlag flag + | flag <- PD.findDuplicateFlagAssignments specifiedFlags + ] + ++ [MissingFlag flag | OnlyInLeft flag <- mergedFlags] + ++ [ExtraFlag flag | OnlyInRight flag <- mergedFlags] + ++ [ DuplicateDeps pkgs + | pkgs <- + CD.nonSetupDeps + ( fmap + (duplicatesBy (comparing packageName)) + specifiedDeps1 + ) + ] + ++ [MissingDep dep | OnlyInLeft dep <- mergedDeps] + ++ [ExtraDep pkgid | OnlyInRight pkgid <- mergedDeps] + ++ [ InvalidDep dep pkgid | InBoth dep pkgid <- mergedDeps, not (packageSatisfiesDependency pkgid dep) + ] + where + -- TODO: sanity tests on executable deps + + thisPkgName :: PackageName + thisPkgName = packageName (srcpkgDescription pkg) + + specifiedDeps1 :: ComponentDeps [PackageId] + specifiedDeps1 = fmap (map solverSrcId) specifiedDeps0 + + specifiedDeps :: [PackageId] + specifiedDeps = CD.flatDeps specifiedDeps1 + + mergedFlags :: [MergeResult PD.FlagName PD.FlagName] + mergedFlags = + mergeBy + compare + (sort $ map PD.flagName (PD.genPackageFlags (srcpkgDescription pkg))) + (sort $ map fst (PD.unFlagAssignment specifiedFlags)) -- TODO + packageSatisfiesDependency :: PackageIdentifier -> Dependency -> Bool + packageSatisfiesDependency + (PackageIdentifier name version) + (Dependency name' versionRange _) = + assert (name == name') $ + version `withinRange` versionRange + + dependencyName (Dependency name _ _) = name + + mergedDeps :: [MergeResult Dependency PackageId] + mergedDeps = mergeDeps requiredDeps specifiedDeps + + mergeDeps + :: [Dependency] + -> [PackageId] + -> [MergeResult Dependency PackageId] + mergeDeps required specified = + let sortNubOn f = nubBy ((==) `on` f) . sortBy (compare `on` f) + in mergeBy + (\dep pkgid -> dependencyName dep `compare` packageName pkgid) + (sortNubOn dependencyName required) + (sortNubOn packageName specified) + + compSpec = enableStanzas stanzas + -- TODO: It would be nicer to use ComponentDeps here so we can be more + -- precise in our checks. In fact, this no longer relies on buildDepends and + -- thus should be easier to fix. As long as we _do_ use a flat list here, we + -- have to allow for duplicates when we fold specifiedDeps; once we have + -- proper ComponentDeps here we should get rid of the `nubOn` in + -- `mergeDeps`. + requiredDeps :: [Dependency] + requiredDeps = + -- TODO: use something lower level than finalizePD + case finalizePD + specifiedFlags + compSpec + (const True) + platform + cinfo + [] + (srcpkgDescription pkg) of + Right (resolvedPkg, _) -> + -- we filter self/internal dependencies. They are still there. + -- This is INCORRECT. + -- + -- If we had per-component solver, it would make this unnecessary, + -- but no finalizePDs picks components we are not building, eg. exes. + -- See #3775 + -- + filter + ((/= thisPkgName) . dependencyName) + (PD.enabledBuildDepends resolvedPkg compSpec) + ++ maybe [] PD.setupDepends (PD.setupBuildInfo resolvedPkg) + Left _ -> + error "configuredPackageInvalidDeps internal error" + +-- ------------------------------------------------------------ + +-- * Simple resolver that ignores dependencies + +-- ------------------------------------------------------------ + +-- | A simplistic method of resolving a list of target package names to +-- available packages. +-- +-- Specifically, it does not consider package dependencies at all. Unlike +-- 'resolveDependencies', no attempt is made to ensure that the selected +-- packages have dependencies that are satisfiable or consistent with +-- each other. +-- +-- It is suitable for tasks such as selecting packages to download for user +-- inspection. It is not suitable for selecting packages to install. +-- +-- Note: if no installed package index is available, it is OK to pass 'mempty'. +-- It simply means preferences for installed packages will be ignored. +resolveWithoutDependencies + :: DepResolverParams + -> Either [ResolveNoDepsError] [UnresolvedSourcePackage] +resolveWithoutDependencies + ( DepResolverParams + targets + constraints + prefs + defpref + installedPkgIndex + sourcePkgIndex + _reorderGoals + _countConflicts + _fineGrained + _minimizeConflictSet + _indGoals + _avoidReinstalls + _shadowing + _strFlags + _maxBjumps + _enableBj + _solveExes + _allowBootLibInstalls + _onlyConstrained + _order + _verbosity + ) = + collectEithers $ map selectPackage (Set.toList targets) + where + selectPackage :: PackageName -> Either ResolveNoDepsError UnresolvedSourcePackage + selectPackage pkgname + | null choices = Left $! ResolveUnsatisfiable pkgname requiredVersions + | otherwise = Right $! maximumBy bestByPrefs choices + where + -- Constraints + requiredVersions :: VersionRange + requiredVersions = packageConstraints pkgname + choices :: [UnresolvedSourcePackage] + choices = + PackageIndex.lookupDependency + sourcePkgIndex + pkgname + requiredVersions + + -- Preferences + PackagePreferences preferredVersions preferInstalled _ = + packagePreferences pkgname + + bestByPrefs :: UnresolvedSourcePackage -> UnresolvedSourcePackage -> Ordering + bestByPrefs = comparing $ \pkg -> + (installPref pkg, versionPref pkg, packageVersion pkg) + installPref :: UnresolvedSourcePackage -> Bool + installPref = case preferInstalled of + Preference.PreferLatest -> const False + Preference.PreferOldest -> const False + Preference.PreferInstalled -> + not + . null + . InstalledPackageIndex.lookupSourcePackageId + installedPkgIndex + . packageId + versionPref :: Package a => a -> Int + versionPref pkg = + length . filter (packageVersion pkg `withinRange`) $ + preferredVersions + + packageConstraints :: PackageName -> VersionRange + packageConstraints pkgname = + Map.findWithDefault anyVersion pkgname packageVersionConstraintMap + packageVersionConstraintMap :: Map PackageName VersionRange + packageVersionConstraintMap = + let pcs = map unlabelPackageConstraint constraints + in Map.fromList + [ (scopeToPackageName scope, range) + | PackageConstraint + scope + (PackagePropertyVersion range) <- + pcs + ] + + packagePreferences :: PackageName -> PackagePreferences + packagePreferences = interpretPackagesPreference targets defpref prefs + +collectEithers :: [Either a b] -> Either [a] [b] +collectEithers = collect . partitionEithers + where + collect ([], xs) = Right xs + collect (errs, _) = Left errs + +-- | Errors for 'resolveWithoutDependencies'. +data ResolveNoDepsError + = -- | A package name which cannot be resolved to a specific package. + -- Also gives the constraint on the version and whether there was + -- a constraint on the package being installed. + ResolveUnsatisfiable PackageName VersionRange + +instance Show ResolveNoDepsError where + show (ResolveUnsatisfiable name ver) = + "There is no available version of " + ++ prettyShow name + ++ " that satisfies " + ++ prettyShow (simplifyVersionRange ver) From 7c145334831425280de15805c8ec3495fa194b84 Mon Sep 17 00:00:00 2001 From: maralorn Date: Mon, 12 Jun 2023 15:11:03 +0200 Subject: [PATCH 4/9] Cabal: Trim Distribution.AllowNewer needed functions and fix build This module only contains values extracted from cabal-install Distribution.Client.Dependency. This diff should make this clear. --- Cabal/Cabal.cabal | 1 + Cabal/src/Distribution/AllowNewer.hs | 1177 +------------------------- 2 files changed, 7 insertions(+), 1171 deletions(-) diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 7aabe62356f..2815948e735 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -60,6 +60,7 @@ library ghc-options: -Wnoncanonical-monadfail-instances exposed-modules: + Distribution.AllowNewer Distribution.Backpack.Configure Distribution.Backpack.ComponentsGraph Distribution.Backpack.ConfiguredComponent diff --git a/Cabal/src/Distribution/AllowNewer.hs b/Cabal/src/Distribution/AllowNewer.hs index 5bc5ec51b86..f7d5fabaf04 100644 --- a/Cabal/src/Distribution/AllowNewer.hs +++ b/Cabal/src/Distribution/AllowNewer.hs @@ -1,552 +1,27 @@ ----------------------------------------------------------------------------- ------------------------------------------------------------------------------ - --- | --- Module : Distribution.Client.Dependency --- Copyright : (c) David Himmelstrup 2005, --- Bjorn Bringert 2007 --- Duncan Coutts 2008 --- License : BSD-like --- --- Maintainer : cabal-devel@gmail.com --- Stability : provisional --- Portability : portable --- --- Top level interface to dependency resolution. -module Distribution.Client.Dependency - ( -- * The main package dependency resolver - DepResolverParams - , chooseSolver - , resolveDependencies - , Progress (..) - , foldProgress - - -- * Alternate, simple resolver that does not do dependencies recursively - , resolveWithoutDependencies - - -- * Constructing resolver policies - , PackageProperty (..) - , PackageConstraint (..) - , scopeToplevel - , PackagesPreferenceDefault (..) - , PackagePreference (..) - - -- ** Standard policy - , basicInstallPolicy - , standardInstallPolicy - , PackageSpecifier (..) - - -- ** Extra policy options - , upgradeDependencies - , reinstallTargets - - -- ** Policy utils - , addConstraints - , addPreferences - , setPreferenceDefault - , setReorderGoals - , setCountConflicts - , setFineGrainedConflicts - , setMinimizeConflictSet - , setIndependentGoals - , setAvoidReinstalls - , setShadowPkgs - , setStrongFlags - , setAllowBootLibInstalls - , setOnlyConstrained - , setMaxBackjumps - , setEnableBackjumping - , setSolveExecutables - , setGoalOrder - , setSolverVerbosity - , removeLowerBounds - , removeUpperBounds - , addDefaultSetupDependencies - , addSetupCabalMinVersionConstraint - , addSetupCabalMaxVersionConstraint +-- | Utilities to relax version bounds on dependencies +module Distribution.AllowNewer + ( relaxPackageDeps + , RelaxKind (..) ) where -import Distribution.Client.Compat.Prelude -import qualified Prelude as Unsafe (head) +import Distribution.Compat.Prelude -import Distribution.Client.Dependency.Types - ( PackagesPreferenceDefault (..) - , PreSolver (..) - , Solver (..) - ) -import Distribution.Client.SolverInstallPlan (SolverInstallPlan) -import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan -import Distribution.Client.Types - ( AllowNewer (..) - , AllowOlder (..) - , PackageSpecifier (..) - , RelaxDepMod (..) - , RelaxDepScope (..) - , RelaxDepSubject (..) - , RelaxDeps (..) - , RelaxedDep (..) - , SourcePackageDb (SourcePackageDb) - , UnresolvedPkgLoc - , UnresolvedSourcePackage - , isRelaxDeps - , pkgSpecifierConstraints - , pkgSpecifierTarget - ) -import Distribution.Client.Utils - ( MergeResult (..) - , duplicatesBy - , mergeBy - ) -import qualified Distribution.Compat.Graph as Graph -import Distribution.Compiler - ( CompilerInfo (..) - ) import Distribution.Package ( Package (..) - , PackageId - , PackageIdentifier (PackageIdentifier) - , PackageName - , mkPackageName , packageName - , packageVersion ) import qualified Distribution.PackageDescription as PD -import Distribution.PackageDescription.Configuration - ( finalizePD - ) import qualified Distribution.PackageDescription.Configuration as PD -import Distribution.Simple.PackageIndex (InstalledPackageIndex) -import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex -import Distribution.Simple.Setup - ( asBool - ) -import Distribution.Solver.Modular - ( PruneAfterFirstSuccess (..) - , SolverConfig (..) - , modularResolver - ) -import Distribution.System - ( Platform - ) import Distribution.Types.Dependency -import Distribution.Verbosity - ( normal - ) import Distribution.Version -import Distribution.Solver.Types.ComponentDeps (ComponentDeps) -import qualified Distribution.Solver.Types.ComponentDeps as CD -import Distribution.Solver.Types.ConstraintSource -import Distribution.Solver.Types.DependencyResolver -import Distribution.Solver.Types.InstalledPreference as Preference -import Distribution.Solver.Types.LabeledPackageConstraint -import Distribution.Solver.Types.OptionalStanza -import Distribution.Solver.Types.PackageConstraint -import qualified Distribution.Solver.Types.PackageIndex as PackageIndex -import Distribution.Solver.Types.PackagePath -import Distribution.Solver.Types.PackagePreferences -import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb) -import Distribution.Solver.Types.Progress -import Distribution.Solver.Types.ResolverPackage -import Distribution.Solver.Types.Settings -import Distribution.Solver.Types.SolverId -import Distribution.Solver.Types.SolverPackage -import Distribution.Solver.Types.SourcePackage -import Distribution.Solver.Types.Variable - -import Control.Exception - ( assert - ) -import Data.List - ( maximumBy - ) import qualified Data.Map as Map -import qualified Data.Set as Set - --- ------------------------------------------------------------ - --- * High level planner policy - --- ------------------------------------------------------------ - --- | The set of parameters to the dependency resolver. These parameters are --- relatively low level but many kinds of high level policies can be --- implemented in terms of adjustments to the parameters. -data DepResolverParams = DepResolverParams - { depResolverTargets :: Set PackageName - , depResolverConstraints :: [LabeledPackageConstraint] - , depResolverPreferences :: [PackagePreference] - , depResolverPreferenceDefault :: PackagesPreferenceDefault - , depResolverInstalledPkgIndex :: InstalledPackageIndex - , depResolverSourcePkgIndex :: PackageIndex.PackageIndex UnresolvedSourcePackage - , depResolverReorderGoals :: ReorderGoals - , depResolverCountConflicts :: CountConflicts - , depResolverFineGrainedConflicts :: FineGrainedConflicts - , depResolverMinimizeConflictSet :: MinimizeConflictSet - , depResolverIndependentGoals :: IndependentGoals - , depResolverAvoidReinstalls :: AvoidReinstalls - , depResolverShadowPkgs :: ShadowPkgs - , depResolverStrongFlags :: StrongFlags - , depResolverAllowBootLibInstalls :: AllowBootLibInstalls - -- ^ Whether to allow base and its dependencies to be installed. - , depResolverOnlyConstrained :: OnlyConstrained - -- ^ Whether to only allow explicitly constrained packages plus - -- goals or to allow any package. - , depResolverMaxBackjumps :: Maybe Int - , depResolverEnableBackjumping :: EnableBackjumping - , depResolverSolveExecutables :: SolveExecutables - -- ^ Whether or not to solve for dependencies on executables. - -- This should be true, except in the legacy code path where - -- we can't tell if an executable has been installed or not, - -- so we shouldn't solve for them. See #3875. - , depResolverGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering) - -- ^ Function to override the solver's goal-ordering heuristics. - , depResolverVerbosity :: Verbosity - } - -showDepResolverParams :: DepResolverParams -> String -showDepResolverParams p = - "targets: " - ++ intercalate ", " (map prettyShow $ Set.toList (depResolverTargets p)) - ++ "\nconstraints: " - ++ concatMap - (("\n " ++) . showLabeledConstraint) - (depResolverConstraints p) - ++ "\npreferences: " - ++ concatMap - (("\n " ++) . showPackagePreference) - (depResolverPreferences p) - ++ "\nstrategy: " - ++ show (depResolverPreferenceDefault p) - ++ "\nreorder goals: " - ++ show (asBool (depResolverReorderGoals p)) - ++ "\ncount conflicts: " - ++ show (asBool (depResolverCountConflicts p)) - ++ "\nfine grained conflicts: " - ++ show (asBool (depResolverFineGrainedConflicts p)) - ++ "\nminimize conflict set: " - ++ show (asBool (depResolverMinimizeConflictSet p)) - ++ "\nindependent goals: " - ++ show (asBool (depResolverIndependentGoals p)) - ++ "\navoid reinstalls: " - ++ show (asBool (depResolverAvoidReinstalls p)) - ++ "\nshadow packages: " - ++ show (asBool (depResolverShadowPkgs p)) - ++ "\nstrong flags: " - ++ show (asBool (depResolverStrongFlags p)) - ++ "\nallow boot library installs: " - ++ show (asBool (depResolverAllowBootLibInstalls p)) - ++ "\nonly constrained packages: " - ++ show (depResolverOnlyConstrained p) - ++ "\nmax backjumps: " - ++ maybe - "infinite" - show - (depResolverMaxBackjumps p) - where - showLabeledConstraint :: LabeledPackageConstraint -> String - showLabeledConstraint (LabeledPackageConstraint pc src) = - showPackageConstraint pc ++ " (" ++ showConstraintSource src ++ ")" - --- | A package selection preference for a particular package. --- --- Preferences are soft constraints that the dependency resolver should try to --- respect where possible. It is not specified if preferences on some packages --- are more important than others. -data PackagePreference - = -- | A suggested constraint on the version number. - PackageVersionPreference PackageName VersionRange - | -- | If we prefer versions of packages that are already installed. - PackageInstalledPreference PackageName InstalledPreference - | -- | If we would prefer to enable these optional stanzas - -- (i.e. test suites and/or benchmarks) - PackageStanzasPreference PackageName [OptionalStanza] - --- | Provide a textual representation of a package preference --- for debugging purposes. -showPackagePreference :: PackagePreference -> String -showPackagePreference (PackageVersionPreference pn vr) = - prettyShow pn ++ " " ++ prettyShow (simplifyVersionRange vr) -showPackagePreference (PackageInstalledPreference pn ip) = - prettyShow pn ++ " " ++ show ip -showPackagePreference (PackageStanzasPreference pn st) = - prettyShow pn ++ " " ++ show st - -basicDepResolverParams - :: InstalledPackageIndex - -> PackageIndex.PackageIndex UnresolvedSourcePackage - -> DepResolverParams -basicDepResolverParams installedPkgIndex sourcePkgIndex = - DepResolverParams - { depResolverTargets = Set.empty - , depResolverConstraints = [] - , depResolverPreferences = [] - , depResolverPreferenceDefault = PreferLatestForSelected - , depResolverInstalledPkgIndex = installedPkgIndex - , depResolverSourcePkgIndex = sourcePkgIndex - , depResolverReorderGoals = ReorderGoals False - , depResolverCountConflicts = CountConflicts True - , depResolverFineGrainedConflicts = FineGrainedConflicts True - , depResolverMinimizeConflictSet = MinimizeConflictSet False - , depResolverIndependentGoals = IndependentGoals False - , depResolverAvoidReinstalls = AvoidReinstalls False - , depResolverShadowPkgs = ShadowPkgs False - , depResolverStrongFlags = StrongFlags False - , depResolverAllowBootLibInstalls = AllowBootLibInstalls False - , depResolverOnlyConstrained = OnlyConstrainedNone - , depResolverMaxBackjumps = Nothing - , depResolverEnableBackjumping = EnableBackjumping True - , depResolverSolveExecutables = SolveExecutables True - , depResolverGoalOrder = Nothing - , depResolverVerbosity = normal - } - -addTargets - :: [PackageName] - -> DepResolverParams - -> DepResolverParams -addTargets extraTargets params = - params - { depResolverTargets = Set.fromList extraTargets `Set.union` depResolverTargets params - } - -addConstraints - :: [LabeledPackageConstraint] - -> DepResolverParams - -> DepResolverParams -addConstraints extraConstraints params = - params - { depResolverConstraints = - extraConstraints - ++ depResolverConstraints params - } - -addPreferences - :: [PackagePreference] - -> DepResolverParams - -> DepResolverParams -addPreferences extraPreferences params = - params - { depResolverPreferences = - extraPreferences - ++ depResolverPreferences params - } - -setPreferenceDefault - :: PackagesPreferenceDefault - -> DepResolverParams - -> DepResolverParams -setPreferenceDefault preferenceDefault params = - params - { depResolverPreferenceDefault = preferenceDefault - } - -setReorderGoals :: ReorderGoals -> DepResolverParams -> DepResolverParams -setReorderGoals reorder params = - params - { depResolverReorderGoals = reorder - } - -setCountConflicts :: CountConflicts -> DepResolverParams -> DepResolverParams -setCountConflicts count params = - params - { depResolverCountConflicts = count - } - -setFineGrainedConflicts :: FineGrainedConflicts -> DepResolverParams -> DepResolverParams -setFineGrainedConflicts fineGrained params = - params - { depResolverFineGrainedConflicts = fineGrained - } - -setMinimizeConflictSet :: MinimizeConflictSet -> DepResolverParams -> DepResolverParams -setMinimizeConflictSet minimize params = - params - { depResolverMinimizeConflictSet = minimize - } - -setIndependentGoals :: IndependentGoals -> DepResolverParams -> DepResolverParams -setIndependentGoals indep params = - params - { depResolverIndependentGoals = indep - } - -setAvoidReinstalls :: AvoidReinstalls -> DepResolverParams -> DepResolverParams -setAvoidReinstalls avoid params = - params - { depResolverAvoidReinstalls = avoid - } - -setShadowPkgs :: ShadowPkgs -> DepResolverParams -> DepResolverParams -setShadowPkgs shadow params = - params - { depResolverShadowPkgs = shadow - } - -setStrongFlags :: StrongFlags -> DepResolverParams -> DepResolverParams -setStrongFlags sf params = - params - { depResolverStrongFlags = sf - } - -setAllowBootLibInstalls :: AllowBootLibInstalls -> DepResolverParams -> DepResolverParams -setAllowBootLibInstalls i params = - params - { depResolverAllowBootLibInstalls = i - } - -setOnlyConstrained :: OnlyConstrained -> DepResolverParams -> DepResolverParams -setOnlyConstrained i params = - params - { depResolverOnlyConstrained = i - } - -setMaxBackjumps :: Maybe Int -> DepResolverParams -> DepResolverParams -setMaxBackjumps n params = - params - { depResolverMaxBackjumps = n - } - -setEnableBackjumping :: EnableBackjumping -> DepResolverParams -> DepResolverParams -setEnableBackjumping b params = - params - { depResolverEnableBackjumping = b - } - -setSolveExecutables :: SolveExecutables -> DepResolverParams -> DepResolverParams -setSolveExecutables b params = - params - { depResolverSolveExecutables = b - } - -setGoalOrder - :: Maybe (Variable QPN -> Variable QPN -> Ordering) - -> DepResolverParams - -> DepResolverParams -setGoalOrder order params = - params - { depResolverGoalOrder = order - } - -setSolverVerbosity :: Verbosity -> DepResolverParams -> DepResolverParams -setSolverVerbosity verbosity params = - params - { depResolverVerbosity = verbosity - } - --- | Some packages are specific to a given compiler version and should never be --- upgraded. -dontUpgradeNonUpgradeablePackages :: DepResolverParams -> DepResolverParams -dontUpgradeNonUpgradeablePackages params = - addConstraints extraConstraints params - where - extraConstraints = - [ LabeledPackageConstraint - (PackageConstraint (ScopeAnyQualifier pkgname) PackagePropertyInstalled) - ConstraintSourceNonUpgradeablePackage - | Set.notMember (mkPackageName "base") (depResolverTargets params) - , pkgname <- nonUpgradeablePackages - , isInstalled pkgname - ] - - isInstalled = - not - . null - . InstalledPackageIndex.lookupPackageName - (depResolverInstalledPkgIndex params) - --- NOTE: the lists of non-upgradable and non-installable packages used to be --- respectively in this module and in `Distribution.Solver.Modular.Solver`. --- Since they were kept synced, they are now combined in the following list. --- --- See: https://github.com/haskell/cabal/issues/8581 -nonUpgradeablePackages :: [PackageName] -nonUpgradeablePackages = - [ mkPackageName "base" - , mkPackageName "ghc-bignum" - , mkPackageName "ghc-prim" - , mkPackageName "ghc-boot" - , mkPackageName "ghc" - , mkPackageName "ghci" - , mkPackageName "integer-gmp" - , mkPackageName "integer-simple" - , mkPackageName "template-haskell" - ] - -addSourcePackages - :: [UnresolvedSourcePackage] - -> DepResolverParams - -> DepResolverParams -addSourcePackages pkgs params = - params - { depResolverSourcePkgIndex = - foldl - (flip PackageIndex.insert) - (depResolverSourcePkgIndex params) - pkgs - } - -hideInstalledPackagesSpecificBySourcePackageId - :: [PackageId] - -> DepResolverParams - -> DepResolverParams -hideInstalledPackagesSpecificBySourcePackageId pkgids params = - -- TODO: this should work using exclude constraints instead - params - { depResolverInstalledPkgIndex = - foldl' - (flip InstalledPackageIndex.deleteSourcePackageId) - (depResolverInstalledPkgIndex params) - pkgids - } - -hideInstalledPackagesAllVersions - :: [PackageName] - -> DepResolverParams - -> DepResolverParams -hideInstalledPackagesAllVersions pkgnames params = - -- TODO: this should work using exclude constraints instead - params - { depResolverInstalledPkgIndex = - foldl' - (flip InstalledPackageIndex.deletePackageName) - (depResolverInstalledPkgIndex params) - pkgnames - } - --- | Remove upper bounds in dependencies using the policy specified by the --- 'AllowNewer' argument (all/some/none). --- --- Note: It's important to apply 'removeUpperBounds' after --- 'addSourcePackages'. Otherwise, the packages inserted by --- 'addSourcePackages' won't have upper bounds in dependencies relaxed. -removeUpperBounds :: AllowNewer -> DepResolverParams -> DepResolverParams -removeUpperBounds (AllowNewer relDeps) = removeBounds RelaxUpper relDeps - --- | Dual of 'removeUpperBounds' -removeLowerBounds :: AllowOlder -> DepResolverParams -> DepResolverParams -removeLowerBounds (AllowOlder relDeps) = removeBounds RelaxLower relDeps +import Distribution.Types.AllowNewer data RelaxKind = RelaxLower | RelaxUpper --- | Common internal implementation of 'removeLowerBounds'/'removeUpperBounds' -removeBounds :: RelaxKind -> RelaxDeps -> DepResolverParams -> DepResolverParams -removeBounds _ rd params | not (isRelaxDeps rd) = params -- no-op optimisation -removeBounds relKind relDeps params = - params - { depResolverSourcePkgIndex = sourcePkgIndex' - } - where - sourcePkgIndex' :: PackageIndex.PackageIndex UnresolvedSourcePackage - sourcePkgIndex' = relaxDeps <$> depResolverSourcePkgIndex params - - relaxDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage - relaxDeps srcPkg = - srcPkg - { srcpkgDescription = relaxPackageDeps relKind relDeps (srcpkgDescription srcPkg) - } - -- | Relax the dependencies of this package if needed. -- -- Helper function used by 'removeBounds' @@ -594,643 +69,3 @@ removeBound RelaxLower RelaxDepModNone = removeLowerBound removeBound RelaxUpper RelaxDepModNone = removeUpperBound removeBound RelaxLower RelaxDepModCaret = transformCaretLower removeBound RelaxUpper RelaxDepModCaret = transformCaretUpper - --- | Supply defaults for packages without explicit Setup dependencies --- --- Note: It's important to apply 'addDefaultSetupDepends' after --- 'addSourcePackages'. Otherwise, the packages inserted by --- 'addSourcePackages' won't have upper bounds in dependencies relaxed. -addDefaultSetupDependencies - :: (UnresolvedSourcePackage -> Maybe [Dependency]) - -> DepResolverParams - -> DepResolverParams -addDefaultSetupDependencies defaultSetupDeps params = - params - { depResolverSourcePkgIndex = - fmap applyDefaultSetupDeps (depResolverSourcePkgIndex params) - } - where - applyDefaultSetupDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage - applyDefaultSetupDeps srcpkg = - srcpkg - { srcpkgDescription = - gpkgdesc - { PD.packageDescription = - pkgdesc - { PD.setupBuildInfo = - case PD.setupBuildInfo pkgdesc of - Just sbi -> Just sbi - Nothing -> case defaultSetupDeps srcpkg of - Nothing -> Nothing - Just deps - | isCustom -> - Just - PD.SetupBuildInfo - { PD.defaultSetupDepends = True - , PD.setupDepends = deps - } - | otherwise -> Nothing - } - } - } - where - isCustom = PD.buildType pkgdesc == PD.Custom - gpkgdesc = srcpkgDescription srcpkg - pkgdesc = PD.packageDescription gpkgdesc - --- | If a package has a custom setup then we need to add a setup-depends --- on Cabal. -addSetupCabalMinVersionConstraint - :: Version - -> DepResolverParams - -> DepResolverParams -addSetupCabalMinVersionConstraint minVersion = - addConstraints - [ LabeledPackageConstraint - ( PackageConstraint - (ScopeAnySetupQualifier cabalPkgname) - (PackagePropertyVersion $ orLaterVersion minVersion) - ) - ConstraintSetupCabalMinVersion - ] - where - cabalPkgname = mkPackageName "Cabal" - --- | Variant of 'addSetupCabalMinVersionConstraint' which sets an --- upper bound on @setup.Cabal@ labeled with 'ConstraintSetupCabalMaxVersion'. -addSetupCabalMaxVersionConstraint - :: Version - -> DepResolverParams - -> DepResolverParams -addSetupCabalMaxVersionConstraint maxVersion = - addConstraints - [ LabeledPackageConstraint - ( PackageConstraint - (ScopeAnySetupQualifier cabalPkgname) - (PackagePropertyVersion $ earlierVersion maxVersion) - ) - ConstraintSetupCabalMaxVersion - ] - where - cabalPkgname = mkPackageName "Cabal" - -upgradeDependencies :: DepResolverParams -> DepResolverParams -upgradeDependencies = setPreferenceDefault PreferAllLatest - -reinstallTargets :: DepResolverParams -> DepResolverParams -reinstallTargets params = - hideInstalledPackagesAllVersions (Set.toList $ depResolverTargets params) params - --- | A basic solver policy on which all others are built. -basicInstallPolicy - :: InstalledPackageIndex - -> SourcePackageDb - -> [PackageSpecifier UnresolvedSourcePackage] - -> DepResolverParams -basicInstallPolicy - installedPkgIndex - (SourcePackageDb sourcePkgIndex sourcePkgPrefs) - pkgSpecifiers = - addPreferences - [ PackageVersionPreference name ver - | (name, ver) <- Map.toList sourcePkgPrefs - ] - . addConstraints - (concatMap pkgSpecifierConstraints pkgSpecifiers) - . addTargets - (map pkgSpecifierTarget pkgSpecifiers) - . hideInstalledPackagesSpecificBySourcePackageId - [packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers] - . addSourcePackages - [pkg | SpecificSourcePackage pkg <- pkgSpecifiers] - $ basicDepResolverParams - installedPkgIndex - sourcePkgIndex - --- | The policy used by all the standard commands, install, fetch, freeze etc --- (but not the v2-build and related commands). --- --- It extends the 'basicInstallPolicy' with a policy on setup deps. -standardInstallPolicy - :: InstalledPackageIndex - -> SourcePackageDb - -> [PackageSpecifier UnresolvedSourcePackage] - -> DepResolverParams -standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers = - addDefaultSetupDependencies mkDefaultSetupDeps $ - basicInstallPolicy - installedPkgIndex - sourcePkgDb - pkgSpecifiers - where - -- Force Cabal >= 1.24 dep when the package is affected by #3199. - mkDefaultSetupDeps :: UnresolvedSourcePackage -> Maybe [Dependency] - mkDefaultSetupDeps srcpkg - | affected = - Just [Dependency (mkPackageName "Cabal") (orLaterVersion $ mkVersion [1, 24]) mainLibSet] - | otherwise = Nothing - where - gpkgdesc = srcpkgDescription srcpkg - pkgdesc = PD.packageDescription gpkgdesc - bt = PD.buildType pkgdesc - affected = bt == PD.Custom && hasBuildableFalse gpkgdesc - - -- Does this package contain any components with non-empty 'build-depends' - -- and a 'buildable' field that could potentially be set to 'False'? False - -- positives are possible. - hasBuildableFalse :: PD.GenericPackageDescription -> Bool - hasBuildableFalse gpkg = - not (all alwaysTrue (zipWith PD.cOr buildableConditions noDepConditions)) - where - buildableConditions = PD.extractConditions PD.buildable gpkg - noDepConditions = - PD.extractConditions - (null . PD.targetBuildDepends) - gpkg - alwaysTrue (PD.Lit True) = True - alwaysTrue _ = False - --- ------------------------------------------------------------ - --- * Interface to the standard resolver - --- ------------------------------------------------------------ - -chooseSolver :: Verbosity -> PreSolver -> CompilerInfo -> IO Solver -chooseSolver _verbosity preSolver _cinfo = - case preSolver of - AlwaysModular -> do - return Modular - -runSolver :: Solver -> SolverConfig -> DependencyResolver UnresolvedPkgLoc -runSolver Modular = modularResolver - --- | Run the dependency solver. --- --- Since this is potentially an expensive operation, the result is wrapped in a --- a 'Progress' structure that can be unfolded to provide progress information, --- logging messages and the final result or an error. -resolveDependencies - :: Platform - -> CompilerInfo - -> PkgConfigDb - -> Solver - -> DepResolverParams - -> Progress String String SolverInstallPlan --- TODO: is this needed here? see dontUpgradeNonUpgradeablePackages -resolveDependencies platform comp _pkgConfigDB _solver params - | Set.null (depResolverTargets params) = - return (validateSolverResult platform comp indGoals []) - where - indGoals = depResolverIndependentGoals params -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 - -- See comment of nonUpgradeablePackages about - -- non-installable and non-upgradable packages. - nonUpgradeablePackages - onlyConstrained_ - maxBkjumps - enableBj - solveExes - order - verbosity - (PruneAfterFirstSuccess False) - ) - platform - comp - installedPkgIndex - sourcePkgIndex - pkgConfigDB - preferences - constraints - targets - where - finalparams@( DepResolverParams - targets - constraints - prefs - defpref - installedPkgIndex - sourcePkgIndex - reordGoals - cntConflicts - fineGrained - minimize - indGoals - noReinstalls - shadowing - strFlags - allowBootLibs - onlyConstrained_ - maxBkjumps - enableBj - solveExes - order - verbosity - ) = - if asBool (depResolverAllowBootLibInstalls params) - then params - else dontUpgradeNonUpgradeablePackages params - - preferences :: PackageName -> PackagePreferences - preferences = interpretPackagesPreference targets defpref prefs - --- | Give an interpretation to the global 'PackagesPreference' as --- specific per-package 'PackageVersionPreference'. -interpretPackagesPreference - :: Set PackageName - -> PackagesPreferenceDefault - -> [PackagePreference] - -> (PackageName -> PackagePreferences) -interpretPackagesPreference selected defaultPref prefs = - \pkgname -> - PackagePreferences - (versionPref pkgname) - (installPref pkgname) - (stanzasPref pkgname) - where - versionPref :: PackageName -> [VersionRange] - versionPref pkgname = - fromMaybe [anyVersion] (Map.lookup pkgname versionPrefs) - versionPrefs = - Map.fromListWith - (++) - [ (pkgname, [pref]) - | PackageVersionPreference pkgname pref <- prefs - ] - - installPref :: PackageName -> InstalledPreference - installPref pkgname = - fromMaybe (installPrefDefault pkgname) (Map.lookup pkgname installPrefs) - installPrefs = - Map.fromList - [ (pkgname, pref) - | PackageInstalledPreference pkgname pref <- prefs - ] - installPrefDefault = case defaultPref of - PreferAllLatest -> const Preference.PreferLatest - PreferAllOldest -> const Preference.PreferOldest - PreferAllInstalled -> const Preference.PreferInstalled - PreferLatestForSelected -> \pkgname -> - -- When you say cabal install foo, what you really mean is, prefer the - -- latest version of foo, but the installed version of everything else - if pkgname `Set.member` selected - then Preference.PreferLatest - else Preference.PreferInstalled - - stanzasPref :: PackageName -> [OptionalStanza] - stanzasPref pkgname = - fromMaybe [] (Map.lookup pkgname stanzasPrefs) - stanzasPrefs = - Map.fromListWith - (\a b -> nub (a ++ b)) - [ (pkgname, pref) - | PackageStanzasPreference pkgname pref <- prefs - ] - --- ------------------------------------------------------------ - --- * Checking the result of the solver - --- ------------------------------------------------------------ - --- | Make an install plan from the output of the dep resolver. --- It checks that the plan is valid, or it's an error in the dep resolver. -validateSolverResult - :: Platform - -> CompilerInfo - -> IndependentGoals - -> [ResolverPackage UnresolvedPkgLoc] - -> SolverInstallPlan -validateSolverResult platform comp indepGoals pkgs = - case planPackagesProblems platform comp pkgs of - [] -> case SolverInstallPlan.new indepGoals graph of - Right plan -> plan - Left problems -> error (formatPlanProblems problems) - problems -> error (formatPkgProblems problems) - where - graph :: Graph.Graph (ResolverPackage UnresolvedPkgLoc) - graph = Graph.fromDistinctList pkgs - - formatPkgProblems :: [PlanPackageProblem] -> String - formatPkgProblems = formatProblemMessage . map showPlanPackageProblem - formatPlanProblems :: [SolverInstallPlan.SolverPlanProblem] -> String - formatPlanProblems = formatProblemMessage . map SolverInstallPlan.showPlanProblem - - formatProblemMessage problems = - unlines $ - "internal error: could not construct a valid install plan." - : "The proposed (invalid) plan contained the following problems:" - : problems - ++ "Proposed plan:" - : [SolverInstallPlan.showPlanIndex pkgs] - -data PlanPackageProblem - = InvalidConfiguredPackage - (SolverPackage UnresolvedPkgLoc) - [PackageProblem] - | DuplicatePackageSolverId SolverId [ResolverPackage UnresolvedPkgLoc] - -showPlanPackageProblem :: PlanPackageProblem -> String -showPlanPackageProblem (InvalidConfiguredPackage pkg packageProblems) = - "Package " - ++ prettyShow (packageId pkg) - ++ " has an invalid configuration, in particular:\n" - ++ unlines - [ " " ++ showPackageProblem problem - | problem <- packageProblems - ] -showPlanPackageProblem (DuplicatePackageSolverId pid dups) = - "Package " - ++ prettyShow (packageId pid) - ++ " has " - ++ show (length dups) - ++ " duplicate instances." - -planPackagesProblems - :: Platform - -> CompilerInfo - -> [ResolverPackage UnresolvedPkgLoc] - -> [PlanPackageProblem] -planPackagesProblems platform cinfo pkgs = - [ InvalidConfiguredPackage pkg packageProblems - | Configured pkg <- pkgs - , let packageProblems = configuredPackageProblems platform cinfo pkg - , not (null packageProblems) - ] - ++ [ DuplicatePackageSolverId (Graph.nodeKey (Unsafe.head dups)) dups - | dups <- duplicatesBy (comparing Graph.nodeKey) pkgs - ] - -data PackageProblem - = DuplicateFlag PD.FlagName - | MissingFlag PD.FlagName - | ExtraFlag PD.FlagName - | DuplicateDeps [PackageId] - | MissingDep Dependency - | ExtraDep PackageId - | InvalidDep Dependency PackageId - -showPackageProblem :: PackageProblem -> String -showPackageProblem (DuplicateFlag flag) = - "duplicate flag in the flag assignment: " ++ PD.unFlagName flag -showPackageProblem (MissingFlag flag) = - "missing an assignment for the flag: " ++ PD.unFlagName flag -showPackageProblem (ExtraFlag flag) = - "extra flag given that is not used by the package: " ++ PD.unFlagName flag -showPackageProblem (DuplicateDeps pkgids) = - "duplicate packages specified as selected dependencies: " - ++ intercalate ", " (map prettyShow pkgids) -showPackageProblem (MissingDep dep) = - "the package has a dependency " - ++ prettyShow dep - ++ " but no package has been selected to satisfy it." -showPackageProblem (ExtraDep pkgid) = - "the package configuration specifies " - ++ prettyShow pkgid - ++ " but (with the given flag assignment) the package does not actually" - ++ " depend on any version of that package." -showPackageProblem (InvalidDep dep pkgid) = - "the package depends on " - ++ prettyShow dep - ++ " but the configuration specifies " - ++ prettyShow pkgid - ++ " which does not satisfy the dependency." - --- | A 'ConfiguredPackage' is valid if the flag assignment is total and if --- in the configuration given by the flag assignment, all the package --- dependencies are satisfied by the specified packages. -configuredPackageProblems - :: Platform - -> CompilerInfo - -> SolverPackage UnresolvedPkgLoc - -> [PackageProblem] -configuredPackageProblems - platform - cinfo - (SolverPackage pkg specifiedFlags stanzas specifiedDeps0 _specifiedExeDeps') = - [ DuplicateFlag flag - | flag <- PD.findDuplicateFlagAssignments specifiedFlags - ] - ++ [MissingFlag flag | OnlyInLeft flag <- mergedFlags] - ++ [ExtraFlag flag | OnlyInRight flag <- mergedFlags] - ++ [ DuplicateDeps pkgs - | pkgs <- - CD.nonSetupDeps - ( fmap - (duplicatesBy (comparing packageName)) - specifiedDeps1 - ) - ] - ++ [MissingDep dep | OnlyInLeft dep <- mergedDeps] - ++ [ExtraDep pkgid | OnlyInRight pkgid <- mergedDeps] - ++ [ InvalidDep dep pkgid | InBoth dep pkgid <- mergedDeps, not (packageSatisfiesDependency pkgid dep) - ] - where - -- TODO: sanity tests on executable deps - - thisPkgName :: PackageName - thisPkgName = packageName (srcpkgDescription pkg) - - specifiedDeps1 :: ComponentDeps [PackageId] - specifiedDeps1 = fmap (map solverSrcId) specifiedDeps0 - - specifiedDeps :: [PackageId] - specifiedDeps = CD.flatDeps specifiedDeps1 - - mergedFlags :: [MergeResult PD.FlagName PD.FlagName] - mergedFlags = - mergeBy - compare - (sort $ map PD.flagName (PD.genPackageFlags (srcpkgDescription pkg))) - (sort $ map fst (PD.unFlagAssignment specifiedFlags)) -- TODO - packageSatisfiesDependency :: PackageIdentifier -> Dependency -> Bool - packageSatisfiesDependency - (PackageIdentifier name version) - (Dependency name' versionRange _) = - assert (name == name') $ - version `withinRange` versionRange - - dependencyName (Dependency name _ _) = name - - mergedDeps :: [MergeResult Dependency PackageId] - mergedDeps = mergeDeps requiredDeps specifiedDeps - - mergeDeps - :: [Dependency] - -> [PackageId] - -> [MergeResult Dependency PackageId] - mergeDeps required specified = - let sortNubOn f = nubBy ((==) `on` f) . sortBy (compare `on` f) - in mergeBy - (\dep pkgid -> dependencyName dep `compare` packageName pkgid) - (sortNubOn dependencyName required) - (sortNubOn packageName specified) - - compSpec = enableStanzas stanzas - -- TODO: It would be nicer to use ComponentDeps here so we can be more - -- precise in our checks. In fact, this no longer relies on buildDepends and - -- thus should be easier to fix. As long as we _do_ use a flat list here, we - -- have to allow for duplicates when we fold specifiedDeps; once we have - -- proper ComponentDeps here we should get rid of the `nubOn` in - -- `mergeDeps`. - requiredDeps :: [Dependency] - requiredDeps = - -- TODO: use something lower level than finalizePD - case finalizePD - specifiedFlags - compSpec - (const True) - platform - cinfo - [] - (srcpkgDescription pkg) of - Right (resolvedPkg, _) -> - -- we filter self/internal dependencies. They are still there. - -- This is INCORRECT. - -- - -- If we had per-component solver, it would make this unnecessary, - -- but no finalizePDs picks components we are not building, eg. exes. - -- See #3775 - -- - filter - ((/= thisPkgName) . dependencyName) - (PD.enabledBuildDepends resolvedPkg compSpec) - ++ maybe [] PD.setupDepends (PD.setupBuildInfo resolvedPkg) - Left _ -> - error "configuredPackageInvalidDeps internal error" - --- ------------------------------------------------------------ - --- * Simple resolver that ignores dependencies - --- ------------------------------------------------------------ - --- | A simplistic method of resolving a list of target package names to --- available packages. --- --- Specifically, it does not consider package dependencies at all. Unlike --- 'resolveDependencies', no attempt is made to ensure that the selected --- packages have dependencies that are satisfiable or consistent with --- each other. --- --- It is suitable for tasks such as selecting packages to download for user --- inspection. It is not suitable for selecting packages to install. --- --- Note: if no installed package index is available, it is OK to pass 'mempty'. --- It simply means preferences for installed packages will be ignored. -resolveWithoutDependencies - :: DepResolverParams - -> Either [ResolveNoDepsError] [UnresolvedSourcePackage] -resolveWithoutDependencies - ( DepResolverParams - targets - constraints - prefs - defpref - installedPkgIndex - sourcePkgIndex - _reorderGoals - _countConflicts - _fineGrained - _minimizeConflictSet - _indGoals - _avoidReinstalls - _shadowing - _strFlags - _maxBjumps - _enableBj - _solveExes - _allowBootLibInstalls - _onlyConstrained - _order - _verbosity - ) = - collectEithers $ map selectPackage (Set.toList targets) - where - selectPackage :: PackageName -> Either ResolveNoDepsError UnresolvedSourcePackage - selectPackage pkgname - | null choices = Left $! ResolveUnsatisfiable pkgname requiredVersions - | otherwise = Right $! maximumBy bestByPrefs choices - where - -- Constraints - requiredVersions :: VersionRange - requiredVersions = packageConstraints pkgname - choices :: [UnresolvedSourcePackage] - choices = - PackageIndex.lookupDependency - sourcePkgIndex - pkgname - requiredVersions - - -- Preferences - PackagePreferences preferredVersions preferInstalled _ = - packagePreferences pkgname - - bestByPrefs :: UnresolvedSourcePackage -> UnresolvedSourcePackage -> Ordering - bestByPrefs = comparing $ \pkg -> - (installPref pkg, versionPref pkg, packageVersion pkg) - installPref :: UnresolvedSourcePackage -> Bool - installPref = case preferInstalled of - Preference.PreferLatest -> const False - Preference.PreferOldest -> const False - Preference.PreferInstalled -> - not - . null - . InstalledPackageIndex.lookupSourcePackageId - installedPkgIndex - . packageId - versionPref :: Package a => a -> Int - versionPref pkg = - length . filter (packageVersion pkg `withinRange`) $ - preferredVersions - - packageConstraints :: PackageName -> VersionRange - packageConstraints pkgname = - Map.findWithDefault anyVersion pkgname packageVersionConstraintMap - packageVersionConstraintMap :: Map PackageName VersionRange - packageVersionConstraintMap = - let pcs = map unlabelPackageConstraint constraints - in Map.fromList - [ (scopeToPackageName scope, range) - | PackageConstraint - scope - (PackagePropertyVersion range) <- - pcs - ] - - packagePreferences :: PackageName -> PackagePreferences - packagePreferences = interpretPackagesPreference targets defpref prefs - -collectEithers :: [Either a b] -> Either [a] [b] -collectEithers = collect . partitionEithers - where - collect ([], xs) = Right xs - collect (errs, _) = Left errs - --- | Errors for 'resolveWithoutDependencies'. -data ResolveNoDepsError - = -- | A package name which cannot be resolved to a specific package. - -- Also gives the constraint on the version and whether there was - -- a constraint on the package being installed. - ResolveUnsatisfiable PackageName VersionRange - -instance Show ResolveNoDepsError where - show (ResolveUnsatisfiable name ver) = - "There is no available version of " - ++ prettyShow name - ++ " that satisfies " - ++ prettyShow (simplifyVersionRange ver) From 23a0458cffaba7f41a73cd3453c71594f17da4e6 Mon Sep 17 00:00:00 2001 From: maralorn Date: Mon, 12 Jun 2023 19:37:22 +0200 Subject: [PATCH 5/9] Cabal: Expose --allow-{newer,older} for configure command --- Cabal/src/Distribution/Simple/Configure.hs | 11 +++- Cabal/src/Distribution/Simple/Setup/Config.hs | 61 +++++++++++++++++++ 2 files changed, 71 insertions(+), 1 deletion(-) diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index 82da0f29aac..e821c198180 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -162,9 +162,12 @@ import Text.PrettyPrint , ($+$) ) +import Data.Coerce (coerce) import qualified Data.Maybe as M import qualified Data.Set as Set +import Distribution.AllowNewer (RelaxKind (..), relaxPackageDeps) import qualified Distribution.Compat.NonEmptySet as NES +import Distribution.Types.AllowNewer (AllowNewer (..), AllowOlder (..)) import Distribution.Types.AnnotatedId type UseExternalInternalDeps = Bool @@ -1227,7 +1230,13 @@ configureFinalizedPackage satisfies comp compPlatform - pkg_descr0 = do + pkg_descr_before_relaxed_bounds = do + let + relax relax_kind getter = relaxPackageDeps relax_kind . fromMaybe mempty . coerce $ getter cfg + pkg_descr0 = + relax RelaxLower configAllowOlder + . relax RelaxUpper configAllowNewer + $ pkg_descr_before_relaxed_bounds (pkg_descr0', flags) <- case finalizePD (configConfigurationsFlags cfg) diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index a109a7502b9..6362a1706b3 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -62,6 +62,7 @@ import Distribution.Compat.Semigroup (Last' (..), Option' (..)) import Distribution.Compat.Stack import Distribution.Simple.Setup.Common +import Distribution.Types.AllowNewer (AllowNewer (..), AllowOlder (..), RelaxDeps (..)) -- ------------------------------------------------------------ @@ -220,6 +221,12 @@ data ConfigFlags = ConfigFlags -- ^ Allow depending on private sublibraries. This is used by external -- tools (like cabal-install) so they can add multiple-public-libraries -- compatibility to older ghcs by checking visibility externally. + , configAllowNewer :: Maybe AllowNewer + -- ^ Ignore upper bounds on all or some dependencies. + -- Nothing means option not set. + , configAllowOlder :: Maybe AllowOlder + -- ^ Ignore lower bounds on all or some dependencies. + -- Nothing means option not set. } deriving (Generic, Read, Show, Typeable) @@ -288,6 +295,8 @@ instance Eq ConfigFlags where && equal configDebugInfo && equal configDumpBuildInfo && equal configUseResponseFiles + && equal configAllowNewer + && equal configAllowOlder where equal f = on (==) f a b @@ -342,6 +351,8 @@ defaultConfigFlags progDb = , configDebugInfo = Flag NoDebugInfo , configDumpBuildInfo = NoFlag , configUseResponseFiles = NoFlag + , configAllowNewer = Nothing + , configAllowOlder = Nothing } {- FOURMOLU_ENABLE -} @@ -828,8 +839,58 @@ configureOptions showOrParseArgs = configAllowDependingOnPrivateLibs (\v flags -> flags{configAllowDependingOnPrivateLibs = v}) trueArg + , option + "" + ["allow-older"] + ( "Ignore lower bounds in all dependencies or for the given DEPS." + ++ " DEPS is a comma or space separated list of DEP or PKG:DEP," + ++ " where PKG or DEP can be *." + ) + configAllowOlder + (\v flags -> flags{configAllowOlder = v}) + ( optArg + "DEPS" + (fmap (Just . AllowOlder) parseRelaxDeps) + (Just $ AllowOlder RelaxDepsAll) + (relaxDepsPrinter . fmap unAllowOlder) + ) + , option + "" + ["allow-newer"] + ( "Ignore upper bounds in all dependencies or for the given DEPS." + ++ " DEPS is a comma or space separated list of DEP or PKG:DEP," + ++ " where PKG or DEP can be *." + ) + configAllowNewer + (\v flags -> flags{configAllowNewer = v}) + ( optArg + "DEPS" + (fmap (Just . AllowNewer) parseRelaxDeps) + (Just $ AllowNewer RelaxDepsAll) + (relaxDepsPrinter . fmap unAllowNewer) + ) ] where + relaxDepsParser :: CabalParsing m => m RelaxDeps + relaxDepsParser = do + rs <- parsecOptCommaList parsec + if null rs + then -- This error is not displayed by the argument parser, + -- but its nice to have anyway. + + fail $ + "empty argument list is not allowed. " + ++ "Note: use --allow-newer/--allow-older without the equals sign to permit all " + ++ "packages to use newer versions." + else return . RelaxDepsSome $ rs + + relaxDepsPrinter :: Maybe RelaxDeps -> [Maybe String] + relaxDepsPrinter Nothing = [] + relaxDepsPrinter (Just RelaxDepsAll) = [Nothing] + relaxDepsPrinter (Just (RelaxDepsSome pkgs)) = map (Just . prettyShow) pkgs + + parseRelaxDeps = parsecToReadE ("Not a valid list of DEPS: " ++) relaxDepsParser + liftInstallDirs = liftOption configInstallDirs (\v flags -> flags{configInstallDirs = v}) From ad4e118184b739fcbf3be7d2e7b04564895a8442 Mon Sep 17 00:00:00 2001 From: maralorn Date: Mon, 12 Jun 2023 15:54:23 +0200 Subject: [PATCH 6/9] cabal-install: Use AllowNewer from Cabal --- cabal-install/cabal-install.cabal | 1 - .../src/Distribution/Client/Config.hs | 34 ++- .../src/Distribution/Client/Configure.hs | 5 +- .../src/Distribution/Client/Dependency.hs | 63 +---- .../src/Distribution/Client/Install.hs | 5 +- .../src/Distribution/Client/ProjectConfig.hs | 1 + .../Client/ProjectConfig/Legacy.hs | 38 +-- .../Client/ProjectConfig/Types.hs | 2 +- .../Distribution/Client/ProjectPlanning.hs | 2 + .../src/Distribution/Client/Setup.hs | 49 +--- .../src/Distribution/Client/Types.hs | 4 +- .../Distribution/Client/Types/AllowNewer.hs | 244 ------------------ .../Distribution/Client/ArbitraryInstances.hs | 2 +- .../Distribution/Client/Described.hs | 2 +- .../Distribution/Client/DescribedInstances.hs | 2 +- .../Distribution/Client/ProjectConfig.hs | 1 + .../Distribution/Client/TreeDiffInstances.hs | 1 + 17 files changed, 62 insertions(+), 394 deletions(-) delete mode 100644 cabal-install/src/Distribution/Client/Types/AllowNewer.hs diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index f3f6be8a778..a3e53fa8452 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -179,7 +179,6 @@ library Distribution.Client.TargetSelector Distribution.Client.Targets Distribution.Client.Types - Distribution.Client.Types.AllowNewer Distribution.Client.Types.BuildResults Distribution.Client.Types.ConfiguredId Distribution.Client.Types.ConfiguredPackage diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index a40e31636cc..e6dfd39bfaf 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -84,15 +84,17 @@ import Distribution.Client.Setup , reportCommand , uploadCommand ) -import Distribution.Client.Types +import Distribution.Types.AllowNewer ( AllowNewer (..) , AllowOlder (..) - , LocalRepo (..) , RelaxDeps (..) + , isRelaxDeps + ) +import Distribution.Client.Types + ( LocalRepo (..) , RemoteRepo (..) , RepoName (..) , emptyRemoteRepo - , isRelaxDeps , unRepoName ) import Distribution.Client.Types.Credentials (Password (..), Username (..)) @@ -526,6 +528,8 @@ instance Semigroup SavedConfig where , configDumpBuildInfo = combine configDumpBuildInfo , configAllowDependingOnPrivateLibs = combine configAllowDependingOnPrivateLibs + , configAllowNewer = combineMonoid savedConfigureFlags configAllowNewer + , configAllowOlder = combineMonoid savedConfigureFlags configAllowOlder } where combine = combine' savedConfigureFlags @@ -543,10 +547,6 @@ instance Semigroup SavedConfig where , -- TODO: NubListify configPreferences = lastNonEmpty configPreferences , configSolver = combine configSolver - , configAllowNewer = - combineMonoid savedConfigureExFlags configAllowNewer - , configAllowOlder = - combineMonoid savedConfigureExFlags configAllowOlder , configWriteGhcEnvironmentFilesPolicy = combine configWriteGhcEnvironmentFilesPolicy } @@ -1103,14 +1103,12 @@ commentSavedConfig = do } , savedInstallFlags = defaultInstallFlags , savedClientInstallFlags = defaultClientInstallFlags - , savedConfigureExFlags = - defaultConfigExFlags - { configAllowNewer = Just (AllowNewer mempty) - , configAllowOlder = Just (AllowOlder mempty) - } + , savedConfigureExFlags = defaultConfigExFlags , savedConfigureFlags = (defaultConfigFlags defaultProgramDb) { configUserInstall = toFlag defaultUserInstall + , configAllowNewer = Just (AllowNewer mempty) + , configAllowOlder = Just (AllowOlder mempty) } , savedUserInstallDirs = fmap toFlag userInstallDirs , savedGlobalInstallDirs = fmap toFlag globalInstallDirs @@ -1231,12 +1229,7 @@ configFieldDescriptions src = ++ name ++ "' field is case sensitive, use 'True' or 'False'." ) - ] - ++ toSavedConfig - liftConfigExFlag - (configureExOptions ParseArgs src) - [] - [ let pkgs = + , let pkgs = (Just . AllowOlder . RelaxDepsSome) `fmap` parsecOptCommaList parsec parseAllowOlder = @@ -1265,6 +1258,11 @@ configFieldDescriptions src = configAllowNewer (\v flags -> flags{configAllowNewer = v}) ] + ++ toSavedConfig + liftConfigExFlag + (configureExOptions ParseArgs src) + [] + [] ++ toSavedConfig liftInstallFlag (installOptions ParseArgs) diff --git a/cabal-install/src/Distribution/Client/Configure.hs b/cabal-install/src/Distribution/Client/Configure.hs index d0abdac3430..a4a50c555d2 100644 --- a/cabal-install/src/Distribution/Client/Configure.hs +++ b/cabal-install/src/Distribution/Client/Configure.hs @@ -130,6 +130,7 @@ import Distribution.Version ) import System.FilePath (()) +import Distribution.Types.AllowNewer (AllowOlder(..), AllowNewer (..)) -- | Choose the Cabal version such that the setup scripts compiled against this -- version will support the given command-line flags. Currently, it implements no @@ -430,9 +431,9 @@ planLocalPackage resolverParams :: DepResolverParams resolverParams = removeLowerBounds - (fromMaybe (AllowOlder mempty) $ configAllowOlder configExFlags) + (fromMaybe (AllowOlder mempty) $ configAllowOlder configFlags) . removeUpperBounds - (fromMaybe (AllowNewer mempty) $ configAllowNewer configExFlags) + (fromMaybe (AllowNewer mempty) $ configAllowNewer configFlags) . addPreferences -- preferences from the config file or command line [ PackageVersionPreference name ver diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs index 5bc5ec51b86..69883d248c2 100644 --- a/cabal-install/src/Distribution/Client/Dependency.hs +++ b/cabal-install/src/Distribution/Client/Dependency.hs @@ -77,19 +77,17 @@ import Distribution.Client.Dependency.Types ) import Distribution.Client.SolverInstallPlan (SolverInstallPlan) import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan -import Distribution.Client.Types +import Distribution.Types.AllowNewer ( AllowNewer (..) , AllowOlder (..) - , PackageSpecifier (..) - , RelaxDepMod (..) - , RelaxDepScope (..) - , RelaxDepSubject (..) , RelaxDeps (..) - , RelaxedDep (..) + , isRelaxDeps + ) +import Distribution.Client.Types + ( PackageSpecifier (..) , SourcePackageDb (SourcePackageDb) , UnresolvedPkgLoc , UnresolvedSourcePackage - , isRelaxDeps , pkgSpecifierConstraints , pkgSpecifierTarget ) @@ -163,6 +161,7 @@ import Data.List ) import qualified Data.Map as Map import qualified Data.Set as Set +import Distribution.AllowNewer (RelaxKind (..), relaxPackageDeps) -- ------------------------------------------------------------ @@ -528,8 +527,6 @@ removeUpperBounds (AllowNewer relDeps) = removeBounds RelaxUpper relDeps removeLowerBounds :: AllowOlder -> DepResolverParams -> DepResolverParams removeLowerBounds (AllowOlder relDeps) = removeBounds RelaxLower relDeps -data RelaxKind = RelaxLower | RelaxUpper - -- | Common internal implementation of 'removeLowerBounds'/'removeUpperBounds' removeBounds :: RelaxKind -> RelaxDeps -> DepResolverParams -> DepResolverParams removeBounds _ rd params | not (isRelaxDeps rd) = params -- no-op optimisation @@ -547,54 +544,6 @@ removeBounds relKind relDeps params = { srcpkgDescription = relaxPackageDeps relKind relDeps (srcpkgDescription srcPkg) } --- | Relax the dependencies of this package if needed. --- --- Helper function used by 'removeBounds' -relaxPackageDeps - :: RelaxKind - -> RelaxDeps - -> PD.GenericPackageDescription - -> PD.GenericPackageDescription -relaxPackageDeps _ rd gpd | not (isRelaxDeps rd) = gpd -- subsumed by no-op case in 'removeBounds' -relaxPackageDeps relKind RelaxDepsAll gpd = PD.transformAllBuildDepends relaxAll gpd - where - relaxAll :: Dependency -> Dependency - relaxAll (Dependency pkgName verRange cs) = - Dependency pkgName (removeBound relKind RelaxDepModNone verRange) cs -relaxPackageDeps relKind (RelaxDepsSome depsToRelax0) gpd = - PD.transformAllBuildDepends relaxSome gpd - where - thisPkgName = packageName gpd - thisPkgId = packageId gpd - depsToRelax = Map.fromList $ mapMaybe f depsToRelax0 - - f :: RelaxedDep -> Maybe (RelaxDepSubject, RelaxDepMod) - f (RelaxedDep scope rdm p) = case scope of - RelaxDepScopeAll -> Just (p, rdm) - RelaxDepScopePackage p0 - | p0 == thisPkgName -> Just (p, rdm) - | otherwise -> Nothing - RelaxDepScopePackageId p0 - | p0 == thisPkgId -> Just (p, rdm) - | otherwise -> Nothing - - relaxSome :: Dependency -> Dependency - relaxSome d@(Dependency depName verRange cs) - | Just relMod <- Map.lookup RelaxDepSubjectAll depsToRelax = - -- a '*'-subject acts absorbing, for consistency with - -- the 'Semigroup RelaxDeps' instance - Dependency depName (removeBound relKind relMod verRange) cs - | Just relMod <- Map.lookup (RelaxDepSubjectPkg depName) depsToRelax = - Dependency depName (removeBound relKind relMod verRange) cs - | otherwise = d -- no-op - --- | Internal helper for 'relaxPackageDeps' -removeBound :: RelaxKind -> RelaxDepMod -> VersionRange -> VersionRange -removeBound RelaxLower RelaxDepModNone = removeLowerBound -removeBound RelaxUpper RelaxDepModNone = removeUpperBound -removeBound RelaxLower RelaxDepModCaret = transformCaretLower -removeBound RelaxUpper RelaxDepModCaret = transformCaretUpper - -- | Supply defaults for packages without explicit Setup dependencies -- -- Note: It's important to apply 'addDefaultSetupDepends' after diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs index 93ad8e5ae2e..9a4156a4ba0 100644 --- a/cabal-install/src/Distribution/Client/Install.hs +++ b/cabal-install/src/Distribution/Client/Install.hs @@ -267,6 +267,7 @@ import Distribution.Version ) import qualified Data.ByteString as BS +import Distribution.Types.AllowNewer (AllowOlder(..), AllowNewer (..)) -- TODO: @@ -678,11 +679,11 @@ planPackages allowOlder = fromMaybe (AllowOlder mempty) - (configAllowOlder configExFlags) + (configAllowOlder configFlags) allowNewer = fromMaybe (AllowNewer mempty) - (configAllowNewer configExFlags) + (configAllowNewer configFlags) -- | Remove the provided targets from the install plan. pruneInstallPlan diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 2a0f82215c2..2f137d173ae 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -221,6 +221,7 @@ import System.IO ( IOMode (ReadMode) , withBinaryFile ) +import Distribution.Types.AllowNewer (AllowOlder(..), AllowNewer (..)) ---------------------------------------- -- Resolving configuration to settings diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index cf39d2940ee..4985b197fc5 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -35,7 +35,7 @@ import Distribution.Client.Compat.Prelude import Distribution.Types.Flag (FlagName, parsecFlagAssignment) import Distribution.Client.ProjectConfig.Types -import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..)) +import Distribution.Types.AllowNewer (AllowNewer (..), AllowOlder (..)) import Distribution.Client.Types.Repo (LocalRepo (..), RemoteRepo (..), emptyRemoteRepo) import Distribution.Client.Types.RepoName (RepoName (..), unRepoName) import Distribution.Client.Types.SourceRepo (SourceRepoList, sourceRepositoryPackageGrammar) @@ -631,6 +631,8 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags , configHcFlavor = projectConfigHcFlavor , configHcPath = projectConfigHcPath , configHcPkg = projectConfigHcPkg + , configAllowOlder = projectConfigAllowOlder + , configAllowNewer = projectConfigAllowNewer , -- configProgramPathExtra = projectConfigProgPathExtra DELETE ME configInstallDirs = projectConfigInstallDirs , -- configUserInstall = projectConfigUserInstall, @@ -642,8 +644,6 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags , configExConstraints = projectConfigConstraints , configPreferences = projectConfigPreferences , configSolver = projectConfigSolver - , configAllowOlder = projectConfigAllowOlder - , configAllowNewer = projectConfigAllowNewer , configWriteGhcEnvironmentFilesPolicy = projectConfigWriteGhcEnvironmentFilesPolicy } = configExFlags @@ -901,6 +901,8 @@ convertToLegacySharedConfig , configDistPref = projectConfigDistDir , configPackageDBs = projectConfigPackageDBs , configInstallDirs = projectConfigInstallDirs + , configAllowOlder = projectConfigAllowOlder + , configAllowNewer = projectConfigAllowNewer } configExFlags = @@ -911,8 +913,6 @@ convertToLegacySharedConfig , configExConstraints = projectConfigConstraints , configPreferences = projectConfigPreferences , configSolver = projectConfigSolver - , configAllowOlder = projectConfigAllowOlder - , configAllowNewer = projectConfigAllowNewer , configWriteGhcEnvironmentFilesPolicy = projectConfigWriteGhcEnvironmentFilesPolicy } @@ -1035,6 +1035,8 @@ convertToLegacyAllPackageConfig , configUseResponseFiles = mempty , configDumpBuildInfo = mempty , configAllowDependingOnPrivateLibs = mempty + , configAllowNewer = Nothing + , configAllowOlder = Nothing } haddockFlags = @@ -1111,6 +1113,8 @@ convertToLegacyPerPackageConfig PackageConfig{..} = , configUseResponseFiles = mempty , configDumpBuildInfo = packageConfigDumpBuildInfo , configAllowDependingOnPrivateLibs = mempty + , configAllowNewer = Nothing + , configAllowOlder = Nothing } installFlags = @@ -1325,6 +1329,18 @@ legacySharedConfigFieldDescrs constraintSrc = (fmap readPackageDb parsecToken) configPackageDBs (\v conf -> conf{configPackageDBs = v}) + , monoidFieldParsec + "allow-older" + (maybe mempty pretty) + (fmap Just parsec) + (fmap unAllowOlder . configAllowOlder) + (\v conf -> conf{configAllowOlder = fmap AllowOlder v}) + , monoidFieldParsec + "allow-newer" + (maybe mempty pretty) + (fmap Just parsec) + (fmap unAllowNewer . configAllowNewer) + (\v conf -> conf{configAllowNewer = fmap AllowNewer v}) ] . filterFields (["verbose", "builddir"] ++ map optionName installDirsOptions) . commandOptionsToFields @@ -1345,18 +1361,6 @@ legacySharedConfigFieldDescrs constraintSrc = parsec configPreferences (\v conf -> conf{configPreferences = v}) - , monoidFieldParsec - "allow-older" - (maybe mempty pretty) - (fmap Just parsec) - (fmap unAllowOlder . configAllowOlder) - (\v conf -> conf{configAllowOlder = fmap AllowOlder v}) - , monoidFieldParsec - "allow-newer" - (maybe mempty pretty) - (fmap Just parsec) - (fmap unAllowNewer . configAllowNewer) - (\v conf -> conf{configAllowNewer = fmap AllowNewer v}) ] . filterFields [ "cabal-lib-version" diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs index 3ae80d86d31..57dfb9b8573 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs @@ -32,7 +32,7 @@ import Distribution.Client.Dependency.Types import Distribution.Client.Targets ( UserConstraint ) -import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..)) +import Distribution.Types.AllowNewer (AllowNewer (..), AllowOlder (..)) import Distribution.Client.Types.Repo (LocalRepo, RemoteRepo) import Distribution.Client.Types.SourceRepo (SourceRepoList) import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy (WriteGhcEnvironmentFilesPolicy) diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 7d7aaa9efa1..834074b63e6 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -4252,6 +4252,8 @@ setupHsConfigureFlags configPrograms_ = mempty -- never use, shouldn't exist configUseResponseFiles = mempty configAllowDependingOnPrivateLibs = Flag $ not $ libraryVisibilitySupported pkgConfigCompiler + configAllowNewer = Nothing + configAllowOlder = Nothing cidToGivenComponent :: ConfiguredId -> GivenComponent cidToGivenComponent (ConfiguredId srcid mb_cn cid) = GivenComponent (packageName srcid) ln cid diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 460decd55cd..f9987769381 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -92,7 +92,6 @@ module Distribution.Client.Setup import Distribution.Client.Compat.Prelude hiding (get) import Prelude () -import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..), RelaxDeps (..)) import Distribution.Client.Types.Credentials (Password (..), Username (..)) import Distribution.Client.Types.Repo (LocalRepo (..), RemoteRepo (..)) import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy @@ -148,9 +147,7 @@ import Distribution.Parsec import Distribution.ReadE ( ReadE (..) , parsecToReadE - , parsecToReadEErr , succeedReadE - , unexpectMsgString ) import Distribution.Simple.Command hiding (boolOpt, boolOpt') import qualified Distribution.Simple.Command as Command @@ -662,7 +659,9 @@ filterConfigureFlags flags cabalLibVersion -- Note: this is not in the wrong place. configConstraints gets -- repopulated in flags_1_19_1 but it needs to be set to empty for -- newer versions first. - configConstraints = [] + configConstraints = [], + configAllowNewer = Nothing, + configAllowOlder = Nothing } flags_3_11_0 = @@ -831,8 +830,6 @@ data ConfigExFlags = ConfigExFlags , configExConstraints :: [(UserConstraint, ConstraintSource)] , configPreferences :: [PackageVersionConstraint] , configSolver :: Flag PreSolver - , configAllowNewer :: Maybe AllowNewer - , configAllowOlder :: Maybe AllowOlder , configWriteGhcEnvironmentFilesPolicy :: Flag WriteGhcEnvironmentFilesPolicy } @@ -925,30 +922,6 @@ configureExOptions _showOrParseArgs src = (map prettyShow) ) , optionSolver configSolver (\v flags -> flags{configSolver = v}) - , option - [] - ["allow-older"] - ("Ignore lower bounds in all dependencies or DEPS") - (fmap unAllowOlder . configAllowOlder) - (\v flags -> flags{configAllowOlder = fmap AllowOlder v}) - ( optArg - "DEPS" - (parsecToReadEErr unexpectMsgString relaxDepsParser) - (Just RelaxDepsAll) - relaxDepsPrinter - ) - , option - [] - ["allow-newer"] - ("Ignore upper bounds in all dependencies or DEPS") - (fmap unAllowNewer . configAllowNewer) - (\v flags -> flags{configAllowNewer = fmap AllowNewer v}) - ( optArg - "DEPS" - (parsecToReadEErr unexpectMsgString relaxDepsParser) - (Just RelaxDepsAll) - relaxDepsPrinter - ) , option [] ["write-ghc-environment-files"] @@ -983,22 +956,6 @@ writeGhcEnvironmentFilesPolicyPrinter = \case (Flag WriteGhcEnvironmentFilesOnlyForGhc844AndNewer) -> ["ghc8.4.4+"] NoFlag -> [] -relaxDepsParser :: CabalParsing m => m (Maybe RelaxDeps) -relaxDepsParser = do - rs <- P.sepBy parsec (P.char ',') - if null rs - then - fail $ - "empty argument list is not allowed. " - ++ "Note: use --allow-newer without the equals sign to permit all " - ++ "packages to use newer versions." - else return . Just . RelaxDepsSome . toList $ rs - -relaxDepsPrinter :: (Maybe RelaxDeps) -> [Maybe String] -relaxDepsPrinter Nothing = [] -relaxDepsPrinter (Just RelaxDepsAll) = [Nothing] -relaxDepsPrinter (Just (RelaxDepsSome pkgs)) = map (Just . prettyShow) $ pkgs - instance Monoid ConfigExFlags where mempty = gmempty mappend = (<>) diff --git a/cabal-install/src/Distribution/Client/Types.hs b/cabal-install/src/Distribution/Client/Types.hs index 710960ee939..338932d1376 100644 --- a/cabal-install/src/Distribution/Client/Types.hs +++ b/cabal-install/src/Distribution/Client/Types.hs @@ -21,8 +21,7 @@ -- -- Various common data types for the entire cabal-install system module Distribution.Client.Types - ( module Distribution.Client.Types.AllowNewer - , module Distribution.Client.Types.ConfiguredId + ( module Distribution.Client.Types.ConfiguredId , module Distribution.Client.Types.ConfiguredPackage , module Distribution.Client.Types.BuildResults , module Distribution.Client.Types.PackageLocation @@ -34,7 +33,6 @@ module Distribution.Client.Types , module Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy ) where -import Distribution.Client.Types.AllowNewer import Distribution.Client.Types.BuildResults import Distribution.Client.Types.ConfiguredId import Distribution.Client.Types.ConfiguredPackage diff --git a/cabal-install/src/Distribution/Client/Types/AllowNewer.hs b/cabal-install/src/Distribution/Client/Types/AllowNewer.hs deleted file mode 100644 index 0a5700174b8..00000000000 --- a/cabal-install/src/Distribution/Client/Types/AllowNewer.hs +++ /dev/null @@ -1,244 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Distribution.Client.Types.AllowNewer - ( AllowNewer (..) - , AllowOlder (..) - , RelaxDeps (..) - , mkRelaxDepSome - , RelaxDepMod (..) - , RelaxDepScope (..) - , RelaxDepSubject (..) - , RelaxedDep (..) - , isRelaxDeps - ) where - -import Distribution.Client.Compat.Prelude -import Prelude () - -import Distribution.Parsec (parsecLeadingCommaNonEmpty) -import Distribution.Types.PackageId (PackageId, PackageIdentifier (..)) -import Distribution.Types.PackageName (PackageName, mkPackageName) -import Distribution.Types.Version (nullVersion) - -import qualified Distribution.Compat.CharParsing as P -import qualified Text.PrettyPrint as Disp - --- $setup --- >>> import Distribution.Parsec - --- TODO: When https://github.com/haskell/cabal/issues/4203 gets tackled, --- it may make sense to move these definitions to the Solver.Types --- module - --- | 'RelaxDeps' in the context of upper bounds (i.e. for @--allow-newer@ flag) -newtype AllowNewer = AllowNewer {unAllowNewer :: RelaxDeps} - deriving (Eq, Read, Show, Generic) - --- | 'RelaxDeps' in the context of lower bounds (i.e. for @--allow-older@ flag) -newtype AllowOlder = AllowOlder {unAllowOlder :: RelaxDeps} - deriving (Eq, Read, Show, Generic) - --- | Generic data type for policy when relaxing bounds in dependencies. --- Don't use this directly: use 'AllowOlder' or 'AllowNewer' depending --- on whether or not you are relaxing an lower or upper bound --- (respectively). -data RelaxDeps - = -- | Ignore upper (resp. lower) bounds in some (or no) dependencies on the given packages. - -- - -- @RelaxDepsSome []@ is the default, i.e. honor the bounds in all - -- dependencies, never choose versions newer (resp. older) than allowed. - RelaxDepsSome [RelaxedDep] - | -- | Ignore upper (resp. lower) bounds in dependencies on all packages. - -- - -- __Note__: This is should be semantically equivalent to - -- - -- > RelaxDepsSome [RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll] - -- - -- (TODO: consider normalising 'RelaxDeps' and/or 'RelaxedDep') - RelaxDepsAll - deriving (Eq, Read, Show, Generic) - --- | Dependencies can be relaxed either for all packages in the install plan, or --- only for some packages. -data RelaxedDep = RelaxedDep !RelaxDepScope !RelaxDepMod !RelaxDepSubject - deriving (Eq, Read, Show, Generic) - --- | Specify the scope of a relaxation, i.e. limit which depending --- packages are allowed to have their version constraints relaxed. -data RelaxDepScope - = -- | Apply relaxation in any package - RelaxDepScopeAll - | -- | Apply relaxation to in all versions of a package - RelaxDepScopePackage !PackageName - | -- | Apply relaxation to a specific version of a package only - RelaxDepScopePackageId !PackageId - deriving (Eq, Read, Show, Generic) - --- | Modifier for dependency relaxation -data RelaxDepMod - = -- | Default semantics - RelaxDepModNone - | -- | Apply relaxation only to @^>=@ constraints - RelaxDepModCaret - deriving (Eq, Read, Show, Generic) - --- | Express whether to relax bounds /on/ @all@ packages, or a single package -data RelaxDepSubject - = RelaxDepSubjectAll - | RelaxDepSubjectPkg !PackageName - deriving (Eq, Ord, Read, Show, Generic) - -instance Pretty RelaxedDep where - pretty (RelaxedDep scope rdmod subj) = case scope of - RelaxDepScopeAll -> Disp.text "*:" Disp.<> modDep - RelaxDepScopePackage p0 -> pretty p0 Disp.<> Disp.colon Disp.<> modDep - RelaxDepScopePackageId p0 -> pretty p0 Disp.<> Disp.colon Disp.<> modDep - where - modDep = case rdmod of - RelaxDepModNone -> pretty subj - RelaxDepModCaret -> Disp.char '^' Disp.<> pretty subj - -instance Parsec RelaxedDep where - parsec = P.char '*' *> relaxedDepStarP <|> (parsec >>= relaxedDepPkgidP) - --- continuation after * -relaxedDepStarP :: CabalParsing m => m RelaxedDep -relaxedDepStarP = - RelaxedDep RelaxDepScopeAll <$ P.char ':' <*> modP <*> parsec - <|> pure (RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll) - --- continuation after package identifier -relaxedDepPkgidP :: CabalParsing m => PackageIdentifier -> m RelaxedDep -relaxedDepPkgidP pid@(PackageIdentifier pn v) - | pn == mkPackageName "all" - , v == nullVersion = - RelaxedDep RelaxDepScopeAll <$ P.char ':' <*> modP <*> parsec - <|> pure (RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll) - | v == nullVersion = - RelaxedDep (RelaxDepScopePackage pn) <$ P.char ':' <*> modP <*> parsec - <|> pure (RelaxedDep RelaxDepScopeAll RelaxDepModNone (RelaxDepSubjectPkg pn)) - | otherwise = - RelaxedDep (RelaxDepScopePackageId pid) <$ P.char ':' <*> modP <*> parsec - -modP :: P.CharParsing m => m RelaxDepMod -modP = RelaxDepModCaret <$ P.char '^' <|> pure RelaxDepModNone - -instance Pretty RelaxDepSubject where - pretty RelaxDepSubjectAll = Disp.text "*" - pretty (RelaxDepSubjectPkg pn) = pretty pn - -instance Parsec RelaxDepSubject where - parsec = RelaxDepSubjectAll <$ P.char '*' <|> pkgn - where - pkgn = do - pn <- parsec - pure $ - if pn == mkPackageName "all" - then RelaxDepSubjectAll - else RelaxDepSubjectPkg pn - -instance Pretty RelaxDeps where - pretty rd | not (isRelaxDeps rd) = Disp.text "none" - pretty (RelaxDepsSome pkgs) = - Disp.fsep - . Disp.punctuate Disp.comma - . map pretty - $ pkgs - pretty RelaxDepsAll = Disp.text "all" - --- | --- --- >>> simpleParsec "all" :: Maybe RelaxDeps --- Just RelaxDepsAll --- --- >>> simpleParsec "none" :: Maybe RelaxDeps --- Just (RelaxDepsSome []) --- --- >>> simpleParsec "*, *" :: Maybe RelaxDeps --- Just RelaxDepsAll --- --- >>> simpleParsec "*:*" :: Maybe RelaxDeps --- Just RelaxDepsAll --- --- >>> simpleParsec "foo:bar, quu:puu" :: Maybe RelaxDeps --- Just (RelaxDepsSome [RelaxedDep (RelaxDepScopePackage (PackageName "foo")) RelaxDepModNone (RelaxDepSubjectPkg (PackageName "bar")),RelaxedDep (RelaxDepScopePackage (PackageName "quu")) RelaxDepModNone (RelaxDepSubjectPkg (PackageName "puu"))]) --- --- This is not a glitch, even it looks like: --- --- >>> simpleParsec ", all" :: Maybe RelaxDeps --- Just RelaxDepsAll --- --- >>> simpleParsec "" :: Maybe RelaxDeps --- Nothing -instance Parsec RelaxDeps where - parsec = do - xs <- parsecLeadingCommaNonEmpty parsec - pure $ case toList xs of - [RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll] -> - RelaxDepsAll - [RelaxedDep RelaxDepScopeAll RelaxDepModNone (RelaxDepSubjectPkg pn)] - | pn == mkPackageName "none" -> - mempty - xs' -> mkRelaxDepSome xs' - -instance Binary RelaxDeps -instance Binary RelaxDepMod -instance Binary RelaxDepScope -instance Binary RelaxDepSubject -instance Binary RelaxedDep -instance Binary AllowNewer -instance Binary AllowOlder - -instance Structured RelaxDeps -instance Structured RelaxDepMod -instance Structured RelaxDepScope -instance Structured RelaxDepSubject -instance Structured RelaxedDep -instance Structured AllowNewer -instance Structured AllowOlder - --- | Return 'True' if 'RelaxDeps' specifies a non-empty set of relaxations --- --- Equivalent to @isRelaxDeps = (/= 'mempty')@ -isRelaxDeps :: RelaxDeps -> Bool -isRelaxDeps (RelaxDepsSome []) = False -isRelaxDeps (RelaxDepsSome (_ : _)) = True -isRelaxDeps RelaxDepsAll = True - --- | A smarter 'RelaxedDepsSome', @*:*@ is the same as @all@. -mkRelaxDepSome :: [RelaxedDep] -> RelaxDeps -mkRelaxDepSome xs - | any (== RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll) xs = - RelaxDepsAll - | otherwise = - RelaxDepsSome xs - --- | 'RelaxDepsAll' is the /absorbing element/ -instance Semigroup RelaxDeps where - -- identity element - RelaxDepsSome [] <> r = r - l@(RelaxDepsSome _) <> RelaxDepsSome [] = l - -- absorbing element - l@RelaxDepsAll <> _ = l - (RelaxDepsSome _) <> r@RelaxDepsAll = r - -- combining non-{identity,absorbing} elements - (RelaxDepsSome a) <> (RelaxDepsSome b) = RelaxDepsSome (a ++ b) - --- | @'RelaxDepsSome' []@ is the /identity element/ -instance Monoid RelaxDeps where - mempty = RelaxDepsSome [] - mappend = (<>) - -instance Semigroup AllowNewer where - AllowNewer x <> AllowNewer y = AllowNewer (x <> y) - -instance Semigroup AllowOlder where - AllowOlder x <> AllowOlder y = AllowOlder (x <> y) - -instance Monoid AllowNewer where - mempty = AllowNewer mempty - mappend = (<>) - -instance Monoid AllowOlder where - mempty = AllowOlder mempty - mappend = (<>) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs index 0ff8e280823..cd085322cfb 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs @@ -38,7 +38,7 @@ import Distribution.Client.IndexUtils.IndexState (RepoIndexState (..), TotalInde import Distribution.Client.IndexUtils.Timestamp (Timestamp, epochTimeToTimestamp) import Distribution.Client.Targets import Distribution.Client.Types (RepoName (..), WriteGhcEnvironmentFilesPolicy) -import Distribution.Client.Types.AllowNewer +import Distribution.Types.AllowNewer import Distribution.Client.Types.OverwritePolicy (OverwritePolicy) import Distribution.Solver.Types.OptionalStanza (OptionalStanza (..), OptionalStanzaMap, OptionalStanzaSet, optStanzaSetFromList, optStanzaTabulate) import Distribution.Solver.Types.PackageConstraint (PackageProperty (..)) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Described.hs b/cabal-install/tests/UnitTests/Distribution/Client/Described.hs index fbd544a9a0b..c46a8ae880a 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Described.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Described.hs @@ -18,7 +18,7 @@ import Distribution.Client.IndexUtils.IndexState (RepoIndexState, TotalIndexStat import Distribution.Client.IndexUtils.Timestamp (Timestamp) import Distribution.Client.Targets (UserConstraint) import Distribution.Client.Types (RepoName) -import Distribution.Client.Types.AllowNewer (RelaxDepSubject, RelaxDeps, RelaxedDep) +import Distribution.Types.AllowNewer (RelaxDepSubject, RelaxDeps, RelaxedDep) tests :: TestTree tests = diff --git a/cabal-install/tests/UnitTests/Distribution/Client/DescribedInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/DescribedInstances.hs index 66b9649db11..45acfd00b92 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/DescribedInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/DescribedInstances.hs @@ -19,7 +19,7 @@ import Distribution.Client.IndexUtils.IndexState (RepoIndexState, TotalIndexStat import Distribution.Client.IndexUtils.Timestamp (Timestamp) import Distribution.Client.Targets (UserConstraint) import Distribution.Client.Types (RepoName) -import Distribution.Client.Types.AllowNewer (RelaxDepSubject, RelaxDeps, RelaxedDep) +import Distribution.Types.AllowNewer (RelaxDepSubject, RelaxDeps, RelaxedDep) ------------------------------------------------------------------------------- -- BuildReport diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index b1108d77701..94084e8fc80 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -66,6 +66,7 @@ import Data.TreeDiff.QuickCheck import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck +import Distribution.Types.AllowNewer tests :: [TestTree] tests = diff --git a/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs index 495c4cbf402..6a64934606c 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs @@ -20,6 +20,7 @@ import Distribution.Client.Types import Distribution.Client.Types.OverwritePolicy (OverwritePolicy) import Distribution.Client.Types.SourceRepo (SourceRepositoryPackage) +import Distribution.Types.AllowNewer import Distribution.Simple.Compiler (PackageDB) import Data.TreeDiff.Class From d98a950f4100073a7239e09f374253ccb4f3e5c9 Mon Sep 17 00:00:00 2001 From: maralorn Date: Tue, 13 Jun 2023 19:14:59 +0200 Subject: [PATCH 7/9] Cabal-tests: Fix Hash to account for changed data type --- Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index a396dea860c..4793c8650d7 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -29,8 +29,8 @@ tests = testGroup "Distribution.Utils.Structured" , testCase "GenericPackageDescription" $ md5Check (Proxy :: Proxy GenericPackageDescription) 0xc7d1064aaf2c9bcf92c3d7f23e6d7e94 , testCase "LocalBuildInfo" $ - md5Check (Proxy :: Proxy LocalBuildInfo) 0x0324f420f9fb98417098127a414cc7c0 -#endif + md5Check (Proxy :: Proxy LocalBuildInfo) 0xf6adad996a4bd3746405c2b7abf49fc6 +#endif ] -- -------------------------------------------------------------------- -- From 447d5a227f9db62dcd2af08242e09a41ff6ef5fc Mon Sep 17 00:00:00 2001 From: maralorn Date: Tue, 13 Jun 2023 22:07:34 +0200 Subject: [PATCH 8/9] docs: Add --allow-{newer,older} in ./Setup.hs docs --- doc/setup-commands.rst | 70 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) diff --git a/doc/setup-commands.rst b/doc/setup-commands.rst index 24016c2c267..30004dc822e 100644 --- a/doc/setup-commands.rst +++ b/doc/setup-commands.rst @@ -987,6 +987,76 @@ Miscellaneous options Windows the ``cabal`` should do the right thing and hence should normally not require this flag. +.. option:: --allow-newer[=pkgs], --allow-older[=pkgs] + + Selectively relax upper or lower bounds in dependencies without + editing the package description respectively. + + Note: These options work the same for ``./Setup.hs configure`` and + ``cabal``. Thus the following description uses the ``cabal`` command. + Some features of these options are only necessary for the ``cabal`` + command, but also exist in ``./Setup.hs configure`` for symmetry. + + The following description focuses on upper bounds and the + :option:`--allow-newer` flag, but applies analogously to + :option:`--allow-older` and lower bounds. :option:`--allow-newer` + and :option:`--allow-older` can be used at the same time. + + If you want to install a package A that depends on B >= 1.0 && < + 2.0, but you have the version 2.0 of B installed, you can compile A + against B 2.0 by using ``cabal install --allow-newer=B A``. This + works for the whole package index: if A also depends on C that in + turn depends on B < 2.0, C's dependency on B will be also relaxed. + + Example: + + :: + + $ cd foo + $ cabal configure + Resolving dependencies... + cabal: Could not resolve dependencies: + [...] + $ cabal configure --allow-newer + Resolving dependencies... + Configuring foo... + + Additional examples: + + :: + + # Relax upper bounds in all dependencies. + $ cabal install --allow-newer foo + + # Relax upper bounds only in dependencies on bar, baz and quux. + $ cabal install --allow-newer=bar,baz,quux foo + + # Relax the upper bound on bar and force bar==2.1. + $ cabal install --allow-newer=bar --constraint="bar==2.1" foo + + It's also possible to limit the scope of :option:`--allow-newer` to single + packages with the ``--allow-newer=scope:dep`` syntax. This means + that the dependency on ``dep`` will be relaxed only for the package + ``scope``. + + Example: + + :: + + # Relax upper bound in foo's dependency on base; also relax upper bound in + # every package's dependency on lens. + $ cabal install --allow-newer=foo:base,lens + + # Relax upper bounds in foo's dependency on base and bar's dependency + # on time; also relax the upper bound in the dependency on lens specified by + # any package. + $ cabal install --allow-newer=foo:base,lens --allow-newer=bar:time + + Finally, one can enable :option:`--allow-newer` permanently by setting + ``allow-newer: True`` in the :ref:`config file `. Enabling + 'allow-newer' selectively is also supported in the config file + (``allow-newer: foo, bar, baz:base``). + .. _setup-build: runhaskell Setup.hs build From 59370d0527504d775481c7c071d49e8cd707a937 Mon Sep 17 00:00:00 2001 From: maralorn Date: Tue, 13 Jun 2023 22:26:03 +0200 Subject: [PATCH 9/9] changelog.d: Add entry for --allow-newer and --allow-older in Cabal --- changelog.d/pr-9016 | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 changelog.d/pr-9016 diff --git a/changelog.d/pr-9016 b/changelog.d/pr-9016 new file mode 100644 index 00000000000..01dae4550aa --- /dev/null +++ b/changelog.d/pr-9016 @@ -0,0 +1,14 @@ +synopsis: Add --allow-newer and --allow-older to ./Setup.hs configure +packages: Cabal +prs: #9016 +issues: #7445 #5407 #7859 +significance: significant + +description: { + +- --allow-newer and --allow-older flag are now again supported by ./Setup.hs configure +- This feature can be used when dependencies have are provided externally, + it is desired to check if their versions match, but some checks should be ignored. +- Historical note: These options where moved to Cabal in 2016 (#3165) and removed again in 2017 (#4527). + +}