1----------------------------------------------------------------------------- 2-- | 3-- Module : Distribution.Client.Dependency 4-- Copyright : (c) David Himmelstrup 2005, 5-- Bjorn Bringert 2007 6-- Duncan Coutts 2008 7-- License : BSD-like 8-- 9-- Maintainer : cabal-devel@gmail.com 10-- Stability : provisional 11-- Portability : portable 12-- 13-- Top level interface to dependency resolution. 14----------------------------------------------------------------------------- 15module Distribution.Client.Dependency ( 16 -- * The main package dependency resolver 17 chooseSolver, 18 resolveDependencies, 19 Progress(..), 20 foldProgress, 21 22 -- * Alternate, simple resolver that does not do dependencies recursively 23 resolveWithoutDependencies, 24 25 -- * Constructing resolver policies 26 PackageProperty(..), 27 PackageConstraint(..), 28 scopeToplevel, 29 PackagesPreferenceDefault(..), 30 PackagePreference(..), 31 32 -- ** Standard policy 33 basicInstallPolicy, 34 standardInstallPolicy, 35 PackageSpecifier(..), 36 37 -- ** Sandbox policy 38 applySandboxInstallPolicy, 39 40 -- ** Extra policy options 41 upgradeDependencies, 42 reinstallTargets, 43 44 -- ** Policy utils 45 addConstraints, 46 addPreferences, 47 setPreferenceDefault, 48 setReorderGoals, 49 setCountConflicts, 50 setFineGrainedConflicts, 51 setMinimizeConflictSet, 52 setIndependentGoals, 53 setAvoidReinstalls, 54 setShadowPkgs, 55 setStrongFlags, 56 setAllowBootLibInstalls, 57 setOnlyConstrained, 58 setMaxBackjumps, 59 setEnableBackjumping, 60 setSolveExecutables, 61 setGoalOrder, 62 setSolverVerbosity, 63 removeLowerBounds, 64 removeUpperBounds, 65 addDefaultSetupDependencies, 66 addSetupCabalMinVersionConstraint, 67 addSetupCabalMaxVersionConstraint, 68 ) where 69 70import Distribution.Solver.Modular 71 ( modularResolver, SolverConfig(..), PruneAfterFirstSuccess(..) ) 72import Distribution.Simple.PackageIndex (InstalledPackageIndex) 73import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex 74import Distribution.Client.SolverInstallPlan (SolverInstallPlan) 75import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan 76import Distribution.Client.Types 77 ( SourcePackageDb(SourcePackageDb) 78 , PackageSpecifier(..), pkgSpecifierTarget, pkgSpecifierConstraints 79 , UnresolvedPkgLoc, UnresolvedSourcePackage 80 , AllowNewer(..), AllowOlder(..), RelaxDeps(..), RelaxedDep(..) 81 , RelaxDepScope(..), RelaxDepMod(..), RelaxDepSubject(..), isRelaxDeps 82 ) 83import Distribution.Client.Dependency.Types 84 ( PreSolver(..), Solver(..) 85 , PackagesPreferenceDefault(..) ) 86import Distribution.Client.Sandbox.Types 87 ( SandboxPackageInfo(..) ) 88import Distribution.Package 89 ( PackageName, mkPackageName, PackageIdentifier(PackageIdentifier), PackageId 90 , Package(..), packageName, packageVersion ) 91import Distribution.Types.Dependency 92import qualified Distribution.PackageDescription as PD 93import qualified Distribution.PackageDescription.Configuration as PD 94import Distribution.PackageDescription.Configuration 95 ( finalizePD ) 96import Distribution.Client.PackageUtils 97 ( externalBuildDepends ) 98import Distribution.Compiler 99 ( CompilerInfo(..) ) 100import Distribution.System 101 ( Platform ) 102import Distribution.Client.Utils 103 ( duplicatesBy, mergeBy, MergeResult(..) ) 104import Distribution.Simple.Utils 105 ( comparing ) 106import Distribution.Simple.Setup 107 ( asBool ) 108import Distribution.Deprecated.Text 109 ( display ) 110import Distribution.Verbosity 111 ( normal, Verbosity ) 112import Distribution.Version 113import qualified Distribution.Compat.Graph as Graph 114 115import Distribution.Solver.Types.ComponentDeps (ComponentDeps) 116import qualified Distribution.Solver.Types.ComponentDeps as CD 117import Distribution.Solver.Types.ConstraintSource 118import Distribution.Solver.Types.DependencyResolver 119import Distribution.Solver.Types.InstalledPreference 120import Distribution.Solver.Types.LabeledPackageConstraint 121import Distribution.Solver.Types.OptionalStanza 122import Distribution.Solver.Types.PackageConstraint 123import Distribution.Solver.Types.PackagePath 124import Distribution.Solver.Types.PackagePreferences 125import qualified Distribution.Solver.Types.PackageIndex as PackageIndex 126import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb) 127import Distribution.Solver.Types.Progress 128import Distribution.Solver.Types.ResolverPackage 129import Distribution.Solver.Types.Settings 130import Distribution.Solver.Types.SolverId 131import Distribution.Solver.Types.SolverPackage 132import Distribution.Solver.Types.SourcePackage 133import Distribution.Solver.Types.Variable 134 135import Data.List 136 ( foldl', sort, sortBy, nubBy, maximumBy, intercalate, nub ) 137import Data.Function (on) 138import Data.Maybe (fromMaybe, mapMaybe) 139import qualified Data.Map as Map 140import qualified Data.Set as Set 141import Data.Set (Set) 142import Control.Exception 143 ( assert ) 144 145 146-- ------------------------------------------------------------ 147-- * High level planner policy 148-- ------------------------------------------------------------ 149 150-- | The set of parameters to the dependency resolver. These parameters are 151-- relatively low level but many kinds of high level policies can be 152-- implemented in terms of adjustments to the parameters. 153-- 154data DepResolverParams = DepResolverParams { 155 depResolverTargets :: Set PackageName, 156 depResolverConstraints :: [LabeledPackageConstraint], 157 depResolverPreferences :: [PackagePreference], 158 depResolverPreferenceDefault :: PackagesPreferenceDefault, 159 depResolverInstalledPkgIndex :: InstalledPackageIndex, 160 depResolverSourcePkgIndex :: PackageIndex.PackageIndex UnresolvedSourcePackage, 161 depResolverReorderGoals :: ReorderGoals, 162 depResolverCountConflicts :: CountConflicts, 163 depResolverFineGrainedConflicts :: FineGrainedConflicts, 164 depResolverMinimizeConflictSet :: MinimizeConflictSet, 165 depResolverIndependentGoals :: IndependentGoals, 166 depResolverAvoidReinstalls :: AvoidReinstalls, 167 depResolverShadowPkgs :: ShadowPkgs, 168 depResolverStrongFlags :: StrongFlags, 169 170 -- | Whether to allow base and its dependencies to be installed. 171 depResolverAllowBootLibInstalls :: AllowBootLibInstalls, 172 173 -- | Whether to only allow explicitly constrained packages plus 174 -- goals or to allow any package. 175 depResolverOnlyConstrained :: OnlyConstrained, 176 177 depResolverMaxBackjumps :: Maybe Int, 178 depResolverEnableBackjumping :: EnableBackjumping, 179 -- | Whether or not to solve for dependencies on executables. 180 -- This should be true, except in the legacy code path where 181 -- we can't tell if an executable has been installed or not, 182 -- so we shouldn't solve for them. See #3875. 183 depResolverSolveExecutables :: SolveExecutables, 184 185 -- | Function to override the solver's goal-ordering heuristics. 186 depResolverGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering), 187 depResolverVerbosity :: Verbosity 188 } 189 190showDepResolverParams :: DepResolverParams -> String 191showDepResolverParams p = 192 "targets: " ++ intercalate ", " (map display $ Set.toList (depResolverTargets p)) 193 ++ "\nconstraints: " 194 ++ concatMap (("\n " ++) . showLabeledConstraint) 195 (depResolverConstraints p) 196 ++ "\npreferences: " 197 ++ concatMap (("\n " ++) . showPackagePreference) 198 (depResolverPreferences p) 199 ++ "\nstrategy: " ++ show (depResolverPreferenceDefault p) 200 ++ "\nreorder goals: " ++ show (asBool (depResolverReorderGoals p)) 201 ++ "\ncount conflicts: " ++ show (asBool (depResolverCountConflicts p)) 202 ++ "\nfine grained conflicts: " ++ show (asBool (depResolverFineGrainedConflicts p)) 203 ++ "\nminimize conflict set: " ++ show (asBool (depResolverMinimizeConflictSet p)) 204 ++ "\nindependent goals: " ++ show (asBool (depResolverIndependentGoals p)) 205 ++ "\navoid reinstalls: " ++ show (asBool (depResolverAvoidReinstalls p)) 206 ++ "\nshadow packages: " ++ show (asBool (depResolverShadowPkgs p)) 207 ++ "\nstrong flags: " ++ show (asBool (depResolverStrongFlags p)) 208 ++ "\nallow boot library installs: " ++ show (asBool (depResolverAllowBootLibInstalls p)) 209 ++ "\nonly constrained packages: " ++ show (depResolverOnlyConstrained p) 210 ++ "\nmax backjumps: " ++ maybe "infinite" show 211 (depResolverMaxBackjumps p) 212 where 213 showLabeledConstraint :: LabeledPackageConstraint -> String 214 showLabeledConstraint (LabeledPackageConstraint pc src) = 215 showPackageConstraint pc ++ " (" ++ showConstraintSource src ++ ")" 216 217-- | A package selection preference for a particular package. 218-- 219-- Preferences are soft constraints that the dependency resolver should try to 220-- respect where possible. It is not specified if preferences on some packages 221-- are more important than others. 222-- 223data PackagePreference = 224 225 -- | A suggested constraint on the version number. 226 PackageVersionPreference PackageName VersionRange 227 228 -- | If we prefer versions of packages that are already installed. 229 | PackageInstalledPreference PackageName InstalledPreference 230 231 -- | If we would prefer to enable these optional stanzas 232 -- (i.e. test suites and/or benchmarks) 233 | PackageStanzasPreference PackageName [OptionalStanza] 234 235 236-- | Provide a textual representation of a package preference 237-- for debugging purposes. 238-- 239showPackagePreference :: PackagePreference -> String 240showPackagePreference (PackageVersionPreference pn vr) = 241 display pn ++ " " ++ display (simplifyVersionRange vr) 242showPackagePreference (PackageInstalledPreference pn ip) = 243 display pn ++ " " ++ show ip 244showPackagePreference (PackageStanzasPreference pn st) = 245 display pn ++ " " ++ show st 246 247basicDepResolverParams :: InstalledPackageIndex 248 -> PackageIndex.PackageIndex UnresolvedSourcePackage 249 -> DepResolverParams 250basicDepResolverParams installedPkgIndex sourcePkgIndex = 251 DepResolverParams { 252 depResolverTargets = Set.empty, 253 depResolverConstraints = [], 254 depResolverPreferences = [], 255 depResolverPreferenceDefault = PreferLatestForSelected, 256 depResolverInstalledPkgIndex = installedPkgIndex, 257 depResolverSourcePkgIndex = sourcePkgIndex, 258 depResolverReorderGoals = ReorderGoals False, 259 depResolverCountConflicts = CountConflicts True, 260 depResolverFineGrainedConflicts = FineGrainedConflicts True, 261 depResolverMinimizeConflictSet = MinimizeConflictSet False, 262 depResolverIndependentGoals = IndependentGoals False, 263 depResolverAvoidReinstalls = AvoidReinstalls False, 264 depResolverShadowPkgs = ShadowPkgs False, 265 depResolverStrongFlags = StrongFlags False, 266 depResolverAllowBootLibInstalls = AllowBootLibInstalls False, 267 depResolverOnlyConstrained = OnlyConstrainedNone, 268 depResolverMaxBackjumps = Nothing, 269 depResolverEnableBackjumping = EnableBackjumping True, 270 depResolverSolveExecutables = SolveExecutables True, 271 depResolverGoalOrder = Nothing, 272 depResolverVerbosity = normal 273 } 274 275addTargets :: [PackageName] 276 -> DepResolverParams -> DepResolverParams 277addTargets extraTargets params = 278 params { 279 depResolverTargets = Set.fromList extraTargets `Set.union` depResolverTargets params 280 } 281 282addConstraints :: [LabeledPackageConstraint] 283 -> DepResolverParams -> DepResolverParams 284addConstraints extraConstraints params = 285 params { 286 depResolverConstraints = extraConstraints 287 ++ depResolverConstraints params 288 } 289 290addPreferences :: [PackagePreference] 291 -> DepResolverParams -> DepResolverParams 292addPreferences extraPreferences params = 293 params { 294 depResolverPreferences = extraPreferences 295 ++ depResolverPreferences params 296 } 297 298setPreferenceDefault :: PackagesPreferenceDefault 299 -> DepResolverParams -> DepResolverParams 300setPreferenceDefault preferenceDefault params = 301 params { 302 depResolverPreferenceDefault = preferenceDefault 303 } 304 305setReorderGoals :: ReorderGoals -> DepResolverParams -> DepResolverParams 306setReorderGoals reorder params = 307 params { 308 depResolverReorderGoals = reorder 309 } 310 311setCountConflicts :: CountConflicts -> DepResolverParams -> DepResolverParams 312setCountConflicts count params = 313 params { 314 depResolverCountConflicts = count 315 } 316 317setFineGrainedConflicts :: FineGrainedConflicts -> DepResolverParams -> DepResolverParams 318setFineGrainedConflicts fineGrained params = 319 params { 320 depResolverFineGrainedConflicts = fineGrained 321 } 322 323setMinimizeConflictSet :: MinimizeConflictSet -> DepResolverParams -> DepResolverParams 324setMinimizeConflictSet minimize params = 325 params { 326 depResolverMinimizeConflictSet = minimize 327 } 328 329setIndependentGoals :: IndependentGoals -> DepResolverParams -> DepResolverParams 330setIndependentGoals indep params = 331 params { 332 depResolverIndependentGoals = indep 333 } 334 335setAvoidReinstalls :: AvoidReinstalls -> DepResolverParams -> DepResolverParams 336setAvoidReinstalls avoid params = 337 params { 338 depResolverAvoidReinstalls = avoid 339 } 340 341setShadowPkgs :: ShadowPkgs -> DepResolverParams -> DepResolverParams 342setShadowPkgs shadow params = 343 params { 344 depResolverShadowPkgs = shadow 345 } 346 347setStrongFlags :: StrongFlags -> DepResolverParams -> DepResolverParams 348setStrongFlags sf params = 349 params { 350 depResolverStrongFlags = sf 351 } 352 353setAllowBootLibInstalls :: AllowBootLibInstalls -> DepResolverParams -> DepResolverParams 354setAllowBootLibInstalls i params = 355 params { 356 depResolverAllowBootLibInstalls = i 357 } 358 359setOnlyConstrained :: OnlyConstrained -> DepResolverParams -> DepResolverParams 360setOnlyConstrained i params = 361 params { 362 depResolverOnlyConstrained = i 363 } 364 365setMaxBackjumps :: Maybe Int -> DepResolverParams -> DepResolverParams 366setMaxBackjumps n params = 367 params { 368 depResolverMaxBackjumps = n 369 } 370 371setEnableBackjumping :: EnableBackjumping -> DepResolverParams -> DepResolverParams 372setEnableBackjumping b params = 373 params { 374 depResolverEnableBackjumping = b 375 } 376 377setSolveExecutables :: SolveExecutables -> DepResolverParams -> DepResolverParams 378setSolveExecutables b params = 379 params { 380 depResolverSolveExecutables = b 381 } 382 383setGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering) 384 -> DepResolverParams 385 -> DepResolverParams 386setGoalOrder order params = 387 params { 388 depResolverGoalOrder = order 389 } 390 391setSolverVerbosity :: Verbosity -> DepResolverParams -> DepResolverParams 392setSolverVerbosity verbosity params = 393 params { 394 depResolverVerbosity = verbosity 395 } 396 397-- | Some packages are specific to a given compiler version and should never be 398-- upgraded. 399dontUpgradeNonUpgradeablePackages :: DepResolverParams -> DepResolverParams 400dontUpgradeNonUpgradeablePackages params = 401 addConstraints extraConstraints params 402 where 403 extraConstraints = 404 [ LabeledPackageConstraint 405 (PackageConstraint (ScopeAnyQualifier pkgname) PackagePropertyInstalled) 406 ConstraintSourceNonUpgradeablePackage 407 | Set.notMember (mkPackageName "base") (depResolverTargets params) 408 -- If you change this enumeration, make sure to update the list in 409 -- "Distribution.Solver.Modular.Solver" as well 410 , pkgname <- [ mkPackageName "base" 411 , mkPackageName "ghc-prim" 412 , mkPackageName "integer-gmp" 413 , mkPackageName "integer-simple" 414 , mkPackageName "template-haskell" 415 ] 416 , isInstalled pkgname ] 417 418 isInstalled = not . null 419 . InstalledPackageIndex.lookupPackageName 420 (depResolverInstalledPkgIndex params) 421 422addSourcePackages :: [UnresolvedSourcePackage] 423 -> DepResolverParams -> DepResolverParams 424addSourcePackages pkgs params = 425 params { 426 depResolverSourcePkgIndex = 427 foldl (flip PackageIndex.insert) 428 (depResolverSourcePkgIndex params) pkgs 429 } 430 431hideInstalledPackagesSpecificBySourcePackageId :: [PackageId] 432 -> DepResolverParams 433 -> DepResolverParams 434hideInstalledPackagesSpecificBySourcePackageId pkgids params = 435 --TODO: this should work using exclude constraints instead 436 params { 437 depResolverInstalledPkgIndex = 438 foldl' (flip InstalledPackageIndex.deleteSourcePackageId) 439 (depResolverInstalledPkgIndex params) pkgids 440 } 441 442hideInstalledPackagesAllVersions :: [PackageName] 443 -> DepResolverParams -> DepResolverParams 444hideInstalledPackagesAllVersions pkgnames params = 445 --TODO: this should work using exclude constraints instead 446 params { 447 depResolverInstalledPkgIndex = 448 foldl' (flip InstalledPackageIndex.deletePackageName) 449 (depResolverInstalledPkgIndex params) pkgnames 450 } 451 452 453-- | Remove upper bounds in dependencies using the policy specified by the 454-- 'AllowNewer' argument (all/some/none). 455-- 456-- Note: It's important to apply 'removeUpperBounds' after 457-- 'addSourcePackages'. Otherwise, the packages inserted by 458-- 'addSourcePackages' won't have upper bounds in dependencies relaxed. 459-- 460removeUpperBounds :: AllowNewer -> DepResolverParams -> DepResolverParams 461removeUpperBounds (AllowNewer relDeps) = removeBounds RelaxUpper relDeps 462 463-- | Dual of 'removeUpperBounds' 464removeLowerBounds :: AllowOlder -> DepResolverParams -> DepResolverParams 465removeLowerBounds (AllowOlder relDeps) = removeBounds RelaxLower relDeps 466 467data RelaxKind = RelaxLower | RelaxUpper 468 469-- | Common internal implementation of 'removeLowerBounds'/'removeUpperBounds' 470removeBounds :: RelaxKind -> RelaxDeps -> DepResolverParams -> DepResolverParams 471removeBounds _ rd params | not (isRelaxDeps rd) = params -- no-op optimisation 472removeBounds relKind relDeps params = 473 params { 474 depResolverSourcePkgIndex = sourcePkgIndex' 475 } 476 where 477 sourcePkgIndex' = fmap relaxDeps $ depResolverSourcePkgIndex params 478 479 relaxDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage 480 relaxDeps srcPkg = srcPkg { 481 packageDescription = relaxPackageDeps relKind relDeps 482 (packageDescription srcPkg) 483 } 484 485-- | Relax the dependencies of this package if needed. 486-- 487-- Helper function used by 'removeBounds' 488relaxPackageDeps :: RelaxKind 489 -> RelaxDeps 490 -> PD.GenericPackageDescription -> PD.GenericPackageDescription 491relaxPackageDeps _ rd gpd | not (isRelaxDeps rd) = gpd -- subsumed by no-op case in 'removeBounds' 492relaxPackageDeps relKind RelaxDepsAll gpd = PD.transformAllBuildDepends relaxAll gpd 493 where 494 relaxAll :: Dependency -> Dependency 495 relaxAll (Dependency pkgName verRange cs) = 496 Dependency pkgName (removeBound relKind RelaxDepModNone verRange) cs 497 498relaxPackageDeps relKind (RelaxDepsSome depsToRelax0) gpd = 499 PD.transformAllBuildDepends relaxSome gpd 500 where 501 thisPkgName = packageName gpd 502 thisPkgId = packageId gpd 503 depsToRelax = Map.fromList $ mapMaybe f depsToRelax0 504 505 f :: RelaxedDep -> Maybe (RelaxDepSubject,RelaxDepMod) 506 f (RelaxedDep scope rdm p) = case scope of 507 RelaxDepScopeAll -> Just (p,rdm) 508 RelaxDepScopePackage p0 509 | p0 == thisPkgName -> Just (p,rdm) 510 | otherwise -> Nothing 511 RelaxDepScopePackageId p0 512 | p0 == thisPkgId -> Just (p,rdm) 513 | otherwise -> Nothing 514 515 relaxSome :: Dependency -> Dependency 516 relaxSome d@(Dependency depName verRange cs) 517 | Just relMod <- Map.lookup RelaxDepSubjectAll depsToRelax = 518 -- a '*'-subject acts absorbing, for consistency with 519 -- the 'Semigroup RelaxDeps' instance 520 Dependency depName (removeBound relKind relMod verRange) cs 521 | Just relMod <- Map.lookup (RelaxDepSubjectPkg depName) depsToRelax = 522 Dependency depName (removeBound relKind relMod verRange) cs 523 | otherwise = d -- no-op 524 525-- | Internal helper for 'relaxPackageDeps' 526removeBound :: RelaxKind -> RelaxDepMod -> VersionRange -> VersionRange 527removeBound RelaxLower RelaxDepModNone = removeLowerBound 528removeBound RelaxUpper RelaxDepModNone = removeUpperBound 529removeBound relKind RelaxDepModCaret = hyloVersionRange embed projectVersionRange 530 where 531 embed (MajorBoundVersionF v) = caretTransformation v (majorUpperBound v) 532 embed vr = embedVersionRange vr 533 534 -- This function is the interesting part as it defines the meaning 535 -- of 'RelaxDepModCaret', i.e. to transform only @^>=@ constraints; 536 caretTransformation l u = case relKind of 537 RelaxUpper -> orLaterVersion l -- rewrite @^>= x.y.z@ into @>= x.y.z@ 538 RelaxLower -> earlierVersion u -- rewrite @^>= x.y.z@ into @< x.(y+1)@ 539 540-- | Supply defaults for packages without explicit Setup dependencies 541-- 542-- Note: It's important to apply 'addDefaultSetupDepends' after 543-- 'addSourcePackages'. Otherwise, the packages inserted by 544-- 'addSourcePackages' won't have upper bounds in dependencies relaxed. 545-- 546addDefaultSetupDependencies :: (UnresolvedSourcePackage -> Maybe [Dependency]) 547 -> DepResolverParams -> DepResolverParams 548addDefaultSetupDependencies defaultSetupDeps params = 549 params { 550 depResolverSourcePkgIndex = 551 fmap applyDefaultSetupDeps (depResolverSourcePkgIndex params) 552 } 553 where 554 applyDefaultSetupDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage 555 applyDefaultSetupDeps srcpkg = 556 srcpkg { 557 packageDescription = gpkgdesc { 558 PD.packageDescription = pkgdesc { 559 PD.setupBuildInfo = 560 case PD.setupBuildInfo pkgdesc of 561 Just sbi -> Just sbi 562 Nothing -> case defaultSetupDeps srcpkg of 563 Nothing -> Nothing 564 Just deps | isCustom -> Just PD.SetupBuildInfo { 565 PD.defaultSetupDepends = True, 566 PD.setupDepends = deps 567 } 568 | otherwise -> Nothing 569 } 570 } 571 } 572 where 573 isCustom = PD.buildType pkgdesc == PD.Custom 574 gpkgdesc = packageDescription srcpkg 575 pkgdesc = PD.packageDescription gpkgdesc 576 577-- | If a package has a custom setup then we need to add a setup-depends 578-- on Cabal. 579-- 580addSetupCabalMinVersionConstraint :: Version 581 -> DepResolverParams -> DepResolverParams 582addSetupCabalMinVersionConstraint minVersion = 583 addConstraints 584 [ LabeledPackageConstraint 585 (PackageConstraint (ScopeAnySetupQualifier cabalPkgname) 586 (PackagePropertyVersion $ orLaterVersion minVersion)) 587 ConstraintSetupCabalMinVersion 588 ] 589 where 590 cabalPkgname = mkPackageName "Cabal" 591 592-- | Variant of 'addSetupCabalMinVersionConstraint' which sets an 593-- upper bound on @setup.Cabal@ labeled with 'ConstraintSetupCabalMaxVersion'. 594-- 595addSetupCabalMaxVersionConstraint :: Version 596 -> DepResolverParams -> DepResolverParams 597addSetupCabalMaxVersionConstraint maxVersion = 598 addConstraints 599 [ LabeledPackageConstraint 600 (PackageConstraint (ScopeAnySetupQualifier cabalPkgname) 601 (PackagePropertyVersion $ earlierVersion maxVersion)) 602 ConstraintSetupCabalMaxVersion 603 ] 604 where 605 cabalPkgname = mkPackageName "Cabal" 606 607 608upgradeDependencies :: DepResolverParams -> DepResolverParams 609upgradeDependencies = setPreferenceDefault PreferAllLatest 610 611 612reinstallTargets :: DepResolverParams -> DepResolverParams 613reinstallTargets params = 614 hideInstalledPackagesAllVersions (Set.toList $ depResolverTargets params) params 615 616 617-- | A basic solver policy on which all others are built. 618-- 619basicInstallPolicy :: InstalledPackageIndex 620 -> SourcePackageDb 621 -> [PackageSpecifier UnresolvedSourcePackage] 622 -> DepResolverParams 623basicInstallPolicy 624 installedPkgIndex (SourcePackageDb sourcePkgIndex sourcePkgPrefs) 625 pkgSpecifiers 626 627 = addPreferences 628 [ PackageVersionPreference name ver 629 | (name, ver) <- Map.toList sourcePkgPrefs ] 630 631 . addConstraints 632 (concatMap pkgSpecifierConstraints pkgSpecifiers) 633 634 . addTargets 635 (map pkgSpecifierTarget pkgSpecifiers) 636 637 . hideInstalledPackagesSpecificBySourcePackageId 638 [ packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers ] 639 640 . addSourcePackages 641 [ pkg | SpecificSourcePackage pkg <- pkgSpecifiers ] 642 643 $ basicDepResolverParams 644 installedPkgIndex sourcePkgIndex 645 646 647-- | The policy used by all the standard commands, install, fetch, freeze etc 648-- (but not the v2-build and related commands). 649-- 650-- It extends the 'basicInstallPolicy' with a policy on setup deps. 651-- 652standardInstallPolicy :: InstalledPackageIndex 653 -> SourcePackageDb 654 -> [PackageSpecifier UnresolvedSourcePackage] 655 -> DepResolverParams 656standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers 657 658 = addDefaultSetupDependencies mkDefaultSetupDeps 659 660 $ basicInstallPolicy 661 installedPkgIndex sourcePkgDb pkgSpecifiers 662 663 where 664 -- Force Cabal >= 1.24 dep when the package is affected by #3199. 665 mkDefaultSetupDeps :: UnresolvedSourcePackage -> Maybe [Dependency] 666 mkDefaultSetupDeps srcpkg | affected = 667 Just [Dependency (mkPackageName "Cabal") 668 (orLaterVersion $ mkVersion [1,24]) (Set.singleton PD.LMainLibName)] 669 | otherwise = Nothing 670 where 671 gpkgdesc = packageDescription srcpkg 672 pkgdesc = PD.packageDescription gpkgdesc 673 bt = PD.buildType pkgdesc 674 affected = bt == PD.Custom && hasBuildableFalse gpkgdesc 675 676 -- Does this package contain any components with non-empty 'build-depends' 677 -- and a 'buildable' field that could potentially be set to 'False'? False 678 -- positives are possible. 679 hasBuildableFalse :: PD.GenericPackageDescription -> Bool 680 hasBuildableFalse gpkg = 681 not (all alwaysTrue (zipWith PD.cOr buildableConditions noDepConditions)) 682 where 683 buildableConditions = PD.extractConditions PD.buildable gpkg 684 noDepConditions = PD.extractConditions 685 (null . PD.targetBuildDepends) gpkg 686 alwaysTrue (PD.Lit True) = True 687 alwaysTrue _ = False 688 689 690applySandboxInstallPolicy :: SandboxPackageInfo 691 -> DepResolverParams 692 -> DepResolverParams 693applySandboxInstallPolicy 694 (SandboxPackageInfo modifiedDeps otherDeps allSandboxPkgs _allDeps) 695 params 696 697 = addPreferences [ PackageInstalledPreference n PreferInstalled 698 | n <- installedNotModified ] 699 700 . addTargets installedNotModified 701 702 . addPreferences 703 [ PackageVersionPreference (packageName pkg) 704 (thisVersion (packageVersion pkg)) | pkg <- otherDeps ] 705 706 . addConstraints 707 [ let pc = PackageConstraint 708 (scopeToplevel $ packageName pkg) 709 (PackagePropertyVersion $ thisVersion (packageVersion pkg)) 710 in LabeledPackageConstraint pc ConstraintSourceModifiedAddSourceDep 711 | pkg <- modifiedDeps ] 712 713 . addTargets [ packageName pkg | pkg <- modifiedDeps ] 714 715 . hideInstalledPackagesSpecificBySourcePackageId 716 [ packageId pkg | pkg <- modifiedDeps ] 717 718 -- We don't need to add source packages for add-source deps to the 719 -- 'installedPkgIndex' since 'getSourcePackages' did that for us. 720 721 $ params 722 723 where 724 installedPkgIds = 725 map fst . InstalledPackageIndex.allPackagesBySourcePackageId 726 $ allSandboxPkgs 727 modifiedPkgIds = map packageId modifiedDeps 728 installedNotModified = [ packageName pkg | pkg <- installedPkgIds, 729 pkg `notElem` modifiedPkgIds ] 730 731-- ------------------------------------------------------------ 732-- * Interface to the standard resolver 733-- ------------------------------------------------------------ 734 735chooseSolver :: Verbosity -> PreSolver -> CompilerInfo -> IO Solver 736chooseSolver _verbosity preSolver _cinfo = 737 case preSolver of 738 AlwaysModular -> do 739 return Modular 740 741runSolver :: Solver -> SolverConfig -> DependencyResolver UnresolvedPkgLoc 742runSolver Modular = modularResolver 743 744-- | Run the dependency solver. 745-- 746-- Since this is potentially an expensive operation, the result is wrapped in a 747-- a 'Progress' structure that can be unfolded to provide progress information, 748-- logging messages and the final result or an error. 749-- 750resolveDependencies :: Platform 751 -> CompilerInfo 752 -> PkgConfigDb 753 -> Solver 754 -> DepResolverParams 755 -> Progress String String SolverInstallPlan 756 757 --TODO: is this needed here? see dontUpgradeNonUpgradeablePackages 758resolveDependencies platform comp _pkgConfigDB _solver params 759 | Set.null (depResolverTargets params) 760 = return (validateSolverResult platform comp indGoals []) 761 where 762 indGoals = depResolverIndependentGoals params 763 764resolveDependencies platform comp pkgConfigDB solver params = 765 766 Step (showDepResolverParams finalparams) 767 $ fmap (validateSolverResult platform comp indGoals) 768 $ runSolver solver (SolverConfig reordGoals cntConflicts fineGrained minimize 769 indGoals noReinstalls 770 shadowing strFlags allowBootLibs onlyConstrained_ maxBkjumps enableBj 771 solveExes order verbosity (PruneAfterFirstSuccess False)) 772 platform comp installedPkgIndex sourcePkgIndex 773 pkgConfigDB preferences constraints targets 774 where 775 776 finalparams @ (DepResolverParams 777 targets constraints 778 prefs defpref 779 installedPkgIndex 780 sourcePkgIndex 781 reordGoals 782 cntConflicts 783 fineGrained 784 minimize 785 indGoals 786 noReinstalls 787 shadowing 788 strFlags 789 allowBootLibs 790 onlyConstrained_ 791 maxBkjumps 792 enableBj 793 solveExes 794 order 795 verbosity) = 796 if asBool (depResolverAllowBootLibInstalls params) 797 then params 798 else dontUpgradeNonUpgradeablePackages params 799 800 preferences = interpretPackagesPreference targets defpref prefs 801 802 803-- | Give an interpretation to the global 'PackagesPreference' as 804-- specific per-package 'PackageVersionPreference'. 805-- 806interpretPackagesPreference :: Set PackageName 807 -> PackagesPreferenceDefault 808 -> [PackagePreference] 809 -> (PackageName -> PackagePreferences) 810interpretPackagesPreference selected defaultPref prefs = 811 \pkgname -> PackagePreferences (versionPref pkgname) 812 (installPref pkgname) 813 (stanzasPref pkgname) 814 where 815 versionPref pkgname = 816 fromMaybe [anyVersion] (Map.lookup pkgname versionPrefs) 817 versionPrefs = Map.fromListWith (++) 818 [(pkgname, [pref]) 819 | PackageVersionPreference pkgname pref <- prefs] 820 821 installPref pkgname = 822 fromMaybe (installPrefDefault pkgname) (Map.lookup pkgname installPrefs) 823 installPrefs = Map.fromList 824 [ (pkgname, pref) 825 | PackageInstalledPreference pkgname pref <- prefs ] 826 installPrefDefault = case defaultPref of 827 PreferAllLatest -> const PreferLatest 828 PreferAllInstalled -> const PreferInstalled 829 PreferLatestForSelected -> \pkgname -> 830 -- When you say cabal install foo, what you really mean is, prefer the 831 -- latest version of foo, but the installed version of everything else 832 if pkgname `Set.member` selected then PreferLatest 833 else PreferInstalled 834 835 stanzasPref pkgname = 836 fromMaybe [] (Map.lookup pkgname stanzasPrefs) 837 stanzasPrefs = Map.fromListWith (\a b -> nub (a ++ b)) 838 [ (pkgname, pref) 839 | PackageStanzasPreference pkgname pref <- prefs ] 840 841 842-- ------------------------------------------------------------ 843-- * Checking the result of the solver 844-- ------------------------------------------------------------ 845 846-- | Make an install plan from the output of the dep resolver. 847-- It checks that the plan is valid, or it's an error in the dep resolver. 848-- 849validateSolverResult :: Platform 850 -> CompilerInfo 851 -> IndependentGoals 852 -> [ResolverPackage UnresolvedPkgLoc] 853 -> SolverInstallPlan 854validateSolverResult platform comp indepGoals pkgs = 855 case planPackagesProblems platform comp pkgs of 856 [] -> case SolverInstallPlan.new indepGoals graph of 857 Right plan -> plan 858 Left problems -> error (formatPlanProblems problems) 859 problems -> error (formatPkgProblems problems) 860 861 where 862 graph = Graph.fromDistinctList pkgs 863 864 formatPkgProblems = formatProblemMessage . map showPlanPackageProblem 865 formatPlanProblems = formatProblemMessage . map SolverInstallPlan.showPlanProblem 866 867 formatProblemMessage problems = 868 unlines $ 869 "internal error: could not construct a valid install plan." 870 : "The proposed (invalid) plan contained the following problems:" 871 : problems 872 ++ "Proposed plan:" 873 : [SolverInstallPlan.showPlanIndex pkgs] 874 875 876data PlanPackageProblem = 877 InvalidConfiguredPackage (SolverPackage UnresolvedPkgLoc) 878 [PackageProblem] 879 | DuplicatePackageSolverId SolverId [ResolverPackage UnresolvedPkgLoc] 880 881showPlanPackageProblem :: PlanPackageProblem -> String 882showPlanPackageProblem (InvalidConfiguredPackage pkg packageProblems) = 883 "Package " ++ display (packageId pkg) 884 ++ " has an invalid configuration, in particular:\n" 885 ++ unlines [ " " ++ showPackageProblem problem 886 | problem <- packageProblems ] 887showPlanPackageProblem (DuplicatePackageSolverId pid dups) = 888 "Package " ++ display (packageId pid) ++ " has " 889 ++ show (length dups) ++ " duplicate instances." 890 891planPackagesProblems :: Platform -> CompilerInfo 892 -> [ResolverPackage UnresolvedPkgLoc] 893 -> [PlanPackageProblem] 894planPackagesProblems platform cinfo pkgs = 895 [ InvalidConfiguredPackage pkg packageProblems 896 | Configured pkg <- pkgs 897 , let packageProblems = configuredPackageProblems platform cinfo pkg 898 , not (null packageProblems) ] 899 ++ [ DuplicatePackageSolverId (Graph.nodeKey (head dups)) dups 900 | dups <- duplicatesBy (comparing Graph.nodeKey) pkgs ] 901 902data PackageProblem = DuplicateFlag PD.FlagName 903 | MissingFlag PD.FlagName 904 | ExtraFlag PD.FlagName 905 | DuplicateDeps [PackageId] 906 | MissingDep Dependency 907 | ExtraDep PackageId 908 | InvalidDep Dependency PackageId 909 910showPackageProblem :: PackageProblem -> String 911showPackageProblem (DuplicateFlag flag) = 912 "duplicate flag in the flag assignment: " ++ PD.unFlagName flag 913 914showPackageProblem (MissingFlag flag) = 915 "missing an assignment for the flag: " ++ PD.unFlagName flag 916 917showPackageProblem (ExtraFlag flag) = 918 "extra flag given that is not used by the package: " ++ PD.unFlagName flag 919 920showPackageProblem (DuplicateDeps pkgids) = 921 "duplicate packages specified as selected dependencies: " 922 ++ intercalate ", " (map display pkgids) 923 924showPackageProblem (MissingDep dep) = 925 "the package has a dependency " ++ display dep 926 ++ " but no package has been selected to satisfy it." 927 928showPackageProblem (ExtraDep pkgid) = 929 "the package configuration specifies " ++ display pkgid 930 ++ " but (with the given flag assignment) the package does not actually" 931 ++ " depend on any version of that package." 932 933showPackageProblem (InvalidDep dep pkgid) = 934 "the package depends on " ++ display dep 935 ++ " but the configuration specifies " ++ display pkgid 936 ++ " which does not satisfy the dependency." 937 938-- | A 'ConfiguredPackage' is valid if the flag assignment is total and if 939-- in the configuration given by the flag assignment, all the package 940-- dependencies are satisfied by the specified packages. 941-- 942configuredPackageProblems :: Platform -> CompilerInfo 943 -> SolverPackage UnresolvedPkgLoc -> [PackageProblem] 944configuredPackageProblems platform cinfo 945 (SolverPackage pkg specifiedFlags stanzas specifiedDeps' _specifiedExeDeps') = 946 [ DuplicateFlag flag 947 | flag <- PD.findDuplicateFlagAssignments specifiedFlags ] 948 ++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ] 949 ++ [ ExtraFlag flag | OnlyInRight flag <- mergedFlags ] 950 ++ [ DuplicateDeps pkgs 951 | pkgs <- CD.nonSetupDeps (fmap (duplicatesBy (comparing packageName)) 952 specifiedDeps) ] 953 ++ [ MissingDep dep | OnlyInLeft dep <- mergedDeps ] 954 ++ [ ExtraDep pkgid | OnlyInRight pkgid <- mergedDeps ] 955 ++ [ InvalidDep dep pkgid | InBoth dep pkgid <- mergedDeps 956 , not (packageSatisfiesDependency pkgid dep) ] 957 -- TODO: sanity tests on executable deps 958 where 959 specifiedDeps :: ComponentDeps [PackageId] 960 specifiedDeps = fmap (map solverSrcId) specifiedDeps' 961 962 mergedFlags = mergeBy compare 963 (sort $ map PD.flagName (PD.genPackageFlags (packageDescription pkg))) 964 (sort $ map fst (PD.unFlagAssignment specifiedFlags)) -- TODO 965 966 packageSatisfiesDependency 967 (PackageIdentifier name version) 968 (Dependency name' versionRange _) = assert (name == name') $ 969 version `withinRange` versionRange 970 971 dependencyName (Dependency name _ _) = name 972 973 mergedDeps :: [MergeResult Dependency PackageId] 974 mergedDeps = mergeDeps requiredDeps (CD.flatDeps specifiedDeps) 975 976 mergeDeps :: [Dependency] -> [PackageId] 977 -> [MergeResult Dependency PackageId] 978 mergeDeps required specified = 979 let sortNubOn f = nubBy ((==) `on` f) . sortBy (compare `on` f) in 980 mergeBy 981 (\dep pkgid -> dependencyName dep `compare` packageName pkgid) 982 (sortNubOn dependencyName required) 983 (sortNubOn packageName specified) 984 985 compSpec = enableStanzas stanzas 986 -- TODO: It would be nicer to use ComponentDeps here so we can be more 987 -- precise in our checks. In fact, this no longer relies on buildDepends and 988 -- thus should be easier to fix. As long as we _do_ use a flat list here, we 989 -- have to allow for duplicates when we fold specifiedDeps; once we have 990 -- proper ComponentDeps here we should get rid of the `nubOn` in 991 -- `mergeDeps`. 992 requiredDeps :: [Dependency] 993 requiredDeps = 994 --TODO: use something lower level than finalizePD 995 case finalizePD specifiedFlags 996 compSpec 997 (const True) 998 platform cinfo 999 [] 1000 (packageDescription pkg) of 1001 Right (resolvedPkg, _) -> 1002 externalBuildDepends resolvedPkg compSpec 1003 ++ maybe [] PD.setupDepends (PD.setupBuildInfo resolvedPkg) 1004 Left _ -> 1005 error "configuredPackageInvalidDeps internal error" 1006 1007 1008-- ------------------------------------------------------------ 1009-- * Simple resolver that ignores dependencies 1010-- ------------------------------------------------------------ 1011 1012-- | A simplistic method of resolving a list of target package names to 1013-- available packages. 1014-- 1015-- Specifically, it does not consider package dependencies at all. Unlike 1016-- 'resolveDependencies', no attempt is made to ensure that the selected 1017-- packages have dependencies that are satisfiable or consistent with 1018-- each other. 1019-- 1020-- It is suitable for tasks such as selecting packages to download for user 1021-- inspection. It is not suitable for selecting packages to install. 1022-- 1023-- Note: if no installed package index is available, it is OK to pass 'mempty'. 1024-- It simply means preferences for installed packages will be ignored. 1025-- 1026resolveWithoutDependencies :: DepResolverParams 1027 -> Either [ResolveNoDepsError] [UnresolvedSourcePackage] 1028resolveWithoutDependencies (DepResolverParams targets constraints 1029 prefs defpref installedPkgIndex sourcePkgIndex 1030 _reorderGoals _countConflicts _fineGrained 1031 _minimizeConflictSet _indGoals _avoidReinstalls 1032 _shadowing _strFlags _maxBjumps _enableBj _solveExes 1033 _allowBootLibInstalls _onlyConstrained _order _verbosity) = 1034 collectEithers $ map selectPackage (Set.toList targets) 1035 where 1036 selectPackage :: PackageName -> Either ResolveNoDepsError UnresolvedSourcePackage 1037 selectPackage pkgname 1038 | null choices = Left $! ResolveUnsatisfiable pkgname requiredVersions 1039 | otherwise = Right $! maximumBy bestByPrefs choices 1040 1041 where 1042 -- Constraints 1043 requiredVersions = packageConstraints pkgname 1044 choices = PackageIndex.lookupDependency sourcePkgIndex 1045 pkgname 1046 requiredVersions 1047 1048 -- Preferences 1049 PackagePreferences preferredVersions preferInstalled _ 1050 = packagePreferences pkgname 1051 1052 bestByPrefs = comparing $ \pkg -> 1053 (installPref pkg, versionPref pkg, packageVersion pkg) 1054 installPref = case preferInstalled of 1055 PreferLatest -> const False 1056 PreferInstalled -> not . null 1057 . InstalledPackageIndex.lookupSourcePackageId 1058 installedPkgIndex 1059 . packageId 1060 versionPref pkg = length . filter (packageVersion pkg `withinRange`) $ 1061 preferredVersions 1062 1063 packageConstraints :: PackageName -> VersionRange 1064 packageConstraints pkgname = 1065 Map.findWithDefault anyVersion pkgname packageVersionConstraintMap 1066 packageVersionConstraintMap = 1067 let pcs = map unlabelPackageConstraint constraints 1068 in Map.fromList [ (scopeToPackageName scope, range) 1069 | PackageConstraint 1070 scope (PackagePropertyVersion range) <- pcs ] 1071 1072 packagePreferences :: PackageName -> PackagePreferences 1073 packagePreferences = interpretPackagesPreference targets defpref prefs 1074 1075 1076collectEithers :: [Either a b] -> Either [a] [b] 1077collectEithers = collect . partitionEithers 1078 where 1079 collect ([], xs) = Right xs 1080 collect (errs,_) = Left errs 1081 partitionEithers :: [Either a b] -> ([a],[b]) 1082 partitionEithers = foldr (either left right) ([],[]) 1083 where 1084 left a (l, r) = (a:l, r) 1085 right a (l, r) = (l, a:r) 1086 1087-- | Errors for 'resolveWithoutDependencies'. 1088-- 1089data ResolveNoDepsError = 1090 1091 -- | A package name which cannot be resolved to a specific package. 1092 -- Also gives the constraint on the version and whether there was 1093 -- a constraint on the package being installed. 1094 ResolveUnsatisfiable PackageName VersionRange 1095 1096instance Show ResolveNoDepsError where 1097 show (ResolveUnsatisfiable name ver) = 1098 "There is no available version of " ++ display name 1099 ++ " that satisfies " ++ display (simplifyVersionRange ver) 1100