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