-----------------------------------------------------------------------------
-- |
-- 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.Solver.Modular
         ( modularResolver, SolverConfig(..), PruneAfterFirstSuccess(..) )
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
import Distribution.Client.Types
         ( SourcePackageDb(SourcePackageDb)
         , PackageSpecifier(..), pkgSpecifierTarget, pkgSpecifierConstraints
         , UnresolvedPkgLoc, UnresolvedSourcePackage
         , AllowNewer(..), AllowOlder(..), RelaxDeps(..), RelaxedDep(..)
         , RelaxDepScope(..), RelaxDepMod(..), RelaxDepSubject(..), isRelaxDeps
         )
import Distribution.Client.Dependency.Types
         ( PreSolver(..), Solver(..)
         , PackagesPreferenceDefault(..) )
import Distribution.Package
         ( PackageName, mkPackageName, PackageIdentifier(PackageIdentifier), PackageId
         , Package(..), packageName, packageVersion )
import Distribution.Types.Dependency
import qualified Distribution.PackageDescription as PD
import qualified Distribution.PackageDescription.Configuration as PD
import Distribution.PackageDescription.Configuration
         ( finalizePD )
import Distribution.Compiler
         ( CompilerInfo(..) )
import Distribution.System
         ( Platform )
import Distribution.Client.Utils
         ( duplicatesBy, mergeBy, MergeResult(..) )
import Distribution.Simple.Setup
         ( asBool )
import Distribution.Verbosity
         ( normal  )
import Distribution.Version
import qualified Distribution.Compat.Graph as Graph

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           Distribution.Solver.Types.PackagePath
import           Distribution.Solver.Types.PackagePreferences
import qualified Distribution.Solver.Types.PackageIndex as PackageIndex
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 Data.List
         ( maximumBy )
import qualified Data.Map as Map
import qualified Data.Set as Set
import Control.Exception
         ( assert )


-- ------------------------------------------------------------
-- * 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 {
       DepResolverParams -> Set PackageName
depResolverTargets           :: Set PackageName,
       DepResolverParams -> [LabeledPackageConstraint]
depResolverConstraints       :: [LabeledPackageConstraint],
       DepResolverParams -> [PackagePreference]
depResolverPreferences       :: [PackagePreference],
       DepResolverParams -> PackagesPreferenceDefault
depResolverPreferenceDefault :: PackagesPreferenceDefault,
       DepResolverParams -> InstalledPackageIndex
depResolverInstalledPkgIndex :: InstalledPackageIndex,
       DepResolverParams -> PackageIndex UnresolvedSourcePackage
depResolverSourcePkgIndex    :: PackageIndex.PackageIndex UnresolvedSourcePackage,
       DepResolverParams -> ReorderGoals
depResolverReorderGoals      :: ReorderGoals,
       DepResolverParams -> CountConflicts
depResolverCountConflicts    :: CountConflicts,
       DepResolverParams -> FineGrainedConflicts
depResolverFineGrainedConflicts :: FineGrainedConflicts,
       DepResolverParams -> MinimizeConflictSet
depResolverMinimizeConflictSet :: MinimizeConflictSet,
       DepResolverParams -> IndependentGoals
depResolverIndependentGoals  :: IndependentGoals,
       DepResolverParams -> AvoidReinstalls
depResolverAvoidReinstalls   :: AvoidReinstalls,
       DepResolverParams -> ShadowPkgs
depResolverShadowPkgs        :: ShadowPkgs,
       DepResolverParams -> StrongFlags
depResolverStrongFlags       :: StrongFlags,

       -- | Whether to allow base and its dependencies to be installed.
       DepResolverParams -> AllowBootLibInstalls
depResolverAllowBootLibInstalls :: AllowBootLibInstalls,

       -- | Whether to only allow explicitly constrained packages plus
       -- goals or to allow any package.
       DepResolverParams -> OnlyConstrained
depResolverOnlyConstrained   :: OnlyConstrained,

       DepResolverParams -> Maybe Int
depResolverMaxBackjumps      :: Maybe Int,
       DepResolverParams -> EnableBackjumping
depResolverEnableBackjumping :: EnableBackjumping,
       -- | 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.
       DepResolverParams -> SolveExecutables
depResolverSolveExecutables  :: SolveExecutables,

       -- | Function to override the solver's goal-ordering heuristics.
       DepResolverParams
-> Maybe (Variable QPN -> Variable QPN -> Ordering)
depResolverGoalOrder         :: Maybe (Variable QPN -> Variable QPN -> Ordering),
       DepResolverParams -> Verbosity
depResolverVerbosity         :: Verbosity
     }

showDepResolverParams :: DepResolverParams -> String
showDepResolverParams :: DepResolverParams -> String
showDepResolverParams DepResolverParams
p =
     String
"targets: " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList (DepResolverParams -> Set PackageName
depResolverTargets DepResolverParams
p))
  forall a. [a] -> [a] -> [a]
++ String
"\nconstraints: "
  forall a. [a] -> [a] -> [a]
++   forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String
"\n  " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabeledPackageConstraint -> String
showLabeledConstraint)
       (DepResolverParams -> [LabeledPackageConstraint]
depResolverConstraints DepResolverParams
p)
  forall a. [a] -> [a] -> [a]
++ String
"\npreferences: "
  forall a. [a] -> [a] -> [a]
++   forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String
"\n  " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackagePreference -> String
showPackagePreference)
       (DepResolverParams -> [PackagePreference]
depResolverPreferences DepResolverParams
p)
  forall a. [a] -> [a] -> [a]
++ String
"\nstrategy: "          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (DepResolverParams -> PackagesPreferenceDefault
depResolverPreferenceDefault        DepResolverParams
p)
  forall a. [a] -> [a] -> [a]
++ String
"\nreorder goals: "     forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. BooleanFlag a => a -> Bool
asBool (DepResolverParams -> ReorderGoals
depResolverReorderGoals     DepResolverParams
p))
  forall a. [a] -> [a] -> [a]
++ String
"\ncount conflicts: "   forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. BooleanFlag a => a -> Bool
asBool (DepResolverParams -> CountConflicts
depResolverCountConflicts   DepResolverParams
p))
  forall a. [a] -> [a] -> [a]
++ String
"\nfine grained conflicts: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. BooleanFlag a => a -> Bool
asBool (DepResolverParams -> FineGrainedConflicts
depResolverFineGrainedConflicts DepResolverParams
p))
  forall a. [a] -> [a] -> [a]
++ String
"\nminimize conflict set: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. BooleanFlag a => a -> Bool
asBool (DepResolverParams -> MinimizeConflictSet
depResolverMinimizeConflictSet DepResolverParams
p))
  forall a. [a] -> [a] -> [a]
++ String
"\nindependent goals: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. BooleanFlag a => a -> Bool
asBool (DepResolverParams -> IndependentGoals
depResolverIndependentGoals DepResolverParams
p))
  forall a. [a] -> [a] -> [a]
++ String
"\navoid reinstalls: "  forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. BooleanFlag a => a -> Bool
asBool (DepResolverParams -> AvoidReinstalls
depResolverAvoidReinstalls  DepResolverParams
p))
  forall a. [a] -> [a] -> [a]
++ String
"\nshadow packages: "   forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. BooleanFlag a => a -> Bool
asBool (DepResolverParams -> ShadowPkgs
depResolverShadowPkgs       DepResolverParams
p))
  forall a. [a] -> [a] -> [a]
++ String
"\nstrong flags: "      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. BooleanFlag a => a -> Bool
asBool (DepResolverParams -> StrongFlags
depResolverStrongFlags      DepResolverParams
p))
  forall a. [a] -> [a] -> [a]
++ String
"\nallow boot library installs: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. BooleanFlag a => a -> Bool
asBool (DepResolverParams -> AllowBootLibInstalls
depResolverAllowBootLibInstalls DepResolverParams
p))
  forall a. [a] -> [a] -> [a]
++ String
"\nonly constrained packages: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (DepResolverParams -> OnlyConstrained
depResolverOnlyConstrained DepResolverParams
p)
  forall a. [a] -> [a] -> [a]
++ String
"\nmax backjumps: "     forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"infinite" forall a. Show a => a -> String
show
                                     (DepResolverParams -> Maybe Int
depResolverMaxBackjumps             DepResolverParams
p)
  where
    showLabeledConstraint :: LabeledPackageConstraint -> String
    showLabeledConstraint :: LabeledPackageConstraint -> String
showLabeledConstraint (LabeledPackageConstraint PackageConstraint
pc ConstraintSource
src) =
        PackageConstraint -> String
showPackageConstraint PackageConstraint
pc forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ ConstraintSource -> String
showConstraintSource ConstraintSource
src forall a. [a] -> [a] -> [a]
++ String
")"

-- | 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 :: PackagePreference -> String
showPackagePreference (PackageVersionPreference   PackageName
pn VersionRange
vr) =
  forall a. Pretty a => a -> String
prettyShow PackageName
pn forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (VersionRange -> VersionRange
simplifyVersionRange VersionRange
vr)
showPackagePreference (PackageInstalledPreference PackageName
pn InstalledPreference
ip) =
  forall a. Pretty a => a -> String
prettyShow PackageName
pn forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show InstalledPreference
ip
showPackagePreference (PackageStanzasPreference PackageName
pn [OptionalStanza]
st) =
  forall a. Pretty a => a -> String
prettyShow PackageName
pn forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [OptionalStanza]
st

basicDepResolverParams :: InstalledPackageIndex
                       -> PackageIndex.PackageIndex UnresolvedSourcePackage
                       -> DepResolverParams
basicDepResolverParams :: InstalledPackageIndex
-> PackageIndex UnresolvedSourcePackage -> DepResolverParams
basicDepResolverParams InstalledPackageIndex
installedPkgIndex PackageIndex UnresolvedSourcePackage
sourcePkgIndex =
    DepResolverParams {
       depResolverTargets :: Set PackageName
depResolverTargets           = forall a. Set a
Set.empty,
       depResolverConstraints :: [LabeledPackageConstraint]
depResolverConstraints       = [],
       depResolverPreferences :: [PackagePreference]
depResolverPreferences       = [],
       depResolverPreferenceDefault :: PackagesPreferenceDefault
depResolverPreferenceDefault = PackagesPreferenceDefault
PreferLatestForSelected,
       depResolverInstalledPkgIndex :: InstalledPackageIndex
depResolverInstalledPkgIndex = InstalledPackageIndex
installedPkgIndex,
       depResolverSourcePkgIndex :: PackageIndex UnresolvedSourcePackage
depResolverSourcePkgIndex    = PackageIndex UnresolvedSourcePackage
sourcePkgIndex,
       depResolverReorderGoals :: ReorderGoals
depResolverReorderGoals      = Bool -> ReorderGoals
ReorderGoals Bool
False,
       depResolverCountConflicts :: CountConflicts
depResolverCountConflicts    = Bool -> CountConflicts
CountConflicts Bool
True,
       depResolverFineGrainedConflicts :: FineGrainedConflicts
depResolverFineGrainedConflicts = Bool -> FineGrainedConflicts
FineGrainedConflicts Bool
True,
       depResolverMinimizeConflictSet :: MinimizeConflictSet
depResolverMinimizeConflictSet = Bool -> MinimizeConflictSet
MinimizeConflictSet Bool
False,
       depResolverIndependentGoals :: IndependentGoals
depResolverIndependentGoals  = Bool -> IndependentGoals
IndependentGoals Bool
False,
       depResolverAvoidReinstalls :: AvoidReinstalls
depResolverAvoidReinstalls   = Bool -> AvoidReinstalls
AvoidReinstalls Bool
False,
       depResolverShadowPkgs :: ShadowPkgs
depResolverShadowPkgs        = Bool -> ShadowPkgs
ShadowPkgs Bool
False,
       depResolverStrongFlags :: StrongFlags
depResolverStrongFlags       = Bool -> StrongFlags
StrongFlags Bool
False,
       depResolverAllowBootLibInstalls :: AllowBootLibInstalls
depResolverAllowBootLibInstalls = Bool -> AllowBootLibInstalls
AllowBootLibInstalls Bool
False,
       depResolverOnlyConstrained :: OnlyConstrained
depResolverOnlyConstrained   = OnlyConstrained
OnlyConstrainedNone,
       depResolverMaxBackjumps :: Maybe Int
depResolverMaxBackjumps      = forall a. Maybe a
Nothing,
       depResolverEnableBackjumping :: EnableBackjumping
depResolverEnableBackjumping = Bool -> EnableBackjumping
EnableBackjumping Bool
True,
       depResolverSolveExecutables :: SolveExecutables
depResolverSolveExecutables  = Bool -> SolveExecutables
SolveExecutables Bool
True,
       depResolverGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering)
depResolverGoalOrder         = forall a. Maybe a
Nothing,
       depResolverVerbosity :: Verbosity
depResolverVerbosity         = Verbosity
normal
     }

addTargets :: [PackageName]
           -> DepResolverParams -> DepResolverParams
addTargets :: [PackageName] -> DepResolverParams -> DepResolverParams
addTargets [PackageName]
extraTargets DepResolverParams
params =
    DepResolverParams
params {
      depResolverTargets :: Set PackageName
depResolverTargets = forall a. Ord a => [a] -> Set a
Set.fromList [PackageName]
extraTargets forall a. Ord a => Set a -> Set a -> Set a
`Set.union` DepResolverParams -> Set PackageName
depResolverTargets DepResolverParams
params
    }

addConstraints :: [LabeledPackageConstraint]
               -> DepResolverParams -> DepResolverParams
addConstraints :: [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints [LabeledPackageConstraint]
extraConstraints DepResolverParams
params =
    DepResolverParams
params {
      depResolverConstraints :: [LabeledPackageConstraint]
depResolverConstraints = [LabeledPackageConstraint]
extraConstraints
                            forall a. [a] -> [a] -> [a]
++ DepResolverParams -> [LabeledPackageConstraint]
depResolverConstraints DepResolverParams
params
    }

addPreferences :: [PackagePreference]
               -> DepResolverParams -> DepResolverParams
addPreferences :: [PackagePreference] -> DepResolverParams -> DepResolverParams
addPreferences [PackagePreference]
extraPreferences DepResolverParams
params =
    DepResolverParams
params {
      depResolverPreferences :: [PackagePreference]
depResolverPreferences = [PackagePreference]
extraPreferences
                            forall a. [a] -> [a] -> [a]
++ DepResolverParams -> [PackagePreference]
depResolverPreferences DepResolverParams
params
    }

setPreferenceDefault :: PackagesPreferenceDefault
                     -> DepResolverParams -> DepResolverParams
setPreferenceDefault :: PackagesPreferenceDefault -> DepResolverParams -> DepResolverParams
setPreferenceDefault PackagesPreferenceDefault
preferenceDefault DepResolverParams
params =
    DepResolverParams
params {
      depResolverPreferenceDefault :: PackagesPreferenceDefault
depResolverPreferenceDefault = PackagesPreferenceDefault
preferenceDefault
    }

setReorderGoals :: ReorderGoals -> DepResolverParams -> DepResolverParams
setReorderGoals :: ReorderGoals -> DepResolverParams -> DepResolverParams
setReorderGoals ReorderGoals
reorder DepResolverParams
params =
    DepResolverParams
params {
      depResolverReorderGoals :: ReorderGoals
depResolverReorderGoals = ReorderGoals
reorder
    }

setCountConflicts :: CountConflicts -> DepResolverParams -> DepResolverParams
setCountConflicts :: CountConflicts -> DepResolverParams -> DepResolverParams
setCountConflicts CountConflicts
count DepResolverParams
params =
    DepResolverParams
params {
      depResolverCountConflicts :: CountConflicts
depResolverCountConflicts = CountConflicts
count
    }

setFineGrainedConflicts :: FineGrainedConflicts -> DepResolverParams -> DepResolverParams
setFineGrainedConflicts :: FineGrainedConflicts -> DepResolverParams -> DepResolverParams
setFineGrainedConflicts FineGrainedConflicts
fineGrained DepResolverParams
params =
    DepResolverParams
params {
      depResolverFineGrainedConflicts :: FineGrainedConflicts
depResolverFineGrainedConflicts = FineGrainedConflicts
fineGrained
    }

setMinimizeConflictSet :: MinimizeConflictSet -> DepResolverParams -> DepResolverParams
setMinimizeConflictSet :: MinimizeConflictSet -> DepResolverParams -> DepResolverParams
setMinimizeConflictSet MinimizeConflictSet
minimize DepResolverParams
params =
    DepResolverParams
params {
      depResolverMinimizeConflictSet :: MinimizeConflictSet
depResolverMinimizeConflictSet = MinimizeConflictSet
minimize
    }

setIndependentGoals :: IndependentGoals -> DepResolverParams -> DepResolverParams
setIndependentGoals :: IndependentGoals -> DepResolverParams -> DepResolverParams
setIndependentGoals IndependentGoals
indep DepResolverParams
params =
    DepResolverParams
params {
      depResolverIndependentGoals :: IndependentGoals
depResolverIndependentGoals = IndependentGoals
indep
    }

setAvoidReinstalls :: AvoidReinstalls -> DepResolverParams -> DepResolverParams
setAvoidReinstalls :: AvoidReinstalls -> DepResolverParams -> DepResolverParams
setAvoidReinstalls AvoidReinstalls
avoid DepResolverParams
params =
    DepResolverParams
params {
      depResolverAvoidReinstalls :: AvoidReinstalls
depResolverAvoidReinstalls = AvoidReinstalls
avoid
    }

setShadowPkgs :: ShadowPkgs -> DepResolverParams -> DepResolverParams
setShadowPkgs :: ShadowPkgs -> DepResolverParams -> DepResolverParams
setShadowPkgs ShadowPkgs
shadow DepResolverParams
params =
    DepResolverParams
params {
      depResolverShadowPkgs :: ShadowPkgs
depResolverShadowPkgs = ShadowPkgs
shadow
    }

setStrongFlags :: StrongFlags -> DepResolverParams -> DepResolverParams
setStrongFlags :: StrongFlags -> DepResolverParams -> DepResolverParams
setStrongFlags StrongFlags
sf DepResolverParams
params =
    DepResolverParams
params {
      depResolverStrongFlags :: StrongFlags
depResolverStrongFlags = StrongFlags
sf
    }

setAllowBootLibInstalls :: AllowBootLibInstalls -> DepResolverParams -> DepResolverParams
setAllowBootLibInstalls :: AllowBootLibInstalls -> DepResolverParams -> DepResolverParams
setAllowBootLibInstalls AllowBootLibInstalls
i DepResolverParams
params =
    DepResolverParams
params {
      depResolverAllowBootLibInstalls :: AllowBootLibInstalls
depResolverAllowBootLibInstalls = AllowBootLibInstalls
i
    }

setOnlyConstrained :: OnlyConstrained -> DepResolverParams -> DepResolverParams
setOnlyConstrained :: OnlyConstrained -> DepResolverParams -> DepResolverParams
setOnlyConstrained OnlyConstrained
i DepResolverParams
params =
  DepResolverParams
params {
    depResolverOnlyConstrained :: OnlyConstrained
depResolverOnlyConstrained = OnlyConstrained
i
  }

setMaxBackjumps :: Maybe Int -> DepResolverParams -> DepResolverParams
setMaxBackjumps :: Maybe Int -> DepResolverParams -> DepResolverParams
setMaxBackjumps Maybe Int
n DepResolverParams
params =
    DepResolverParams
params {
      depResolverMaxBackjumps :: Maybe Int
depResolverMaxBackjumps = Maybe Int
n
    }

setEnableBackjumping :: EnableBackjumping -> DepResolverParams -> DepResolverParams
setEnableBackjumping :: EnableBackjumping -> DepResolverParams -> DepResolverParams
setEnableBackjumping EnableBackjumping
b DepResolverParams
params =
    DepResolverParams
params {
      depResolverEnableBackjumping :: EnableBackjumping
depResolverEnableBackjumping = EnableBackjumping
b
    }

setSolveExecutables :: SolveExecutables -> DepResolverParams -> DepResolverParams
setSolveExecutables :: SolveExecutables -> DepResolverParams -> DepResolverParams
setSolveExecutables SolveExecutables
b DepResolverParams
params =
    DepResolverParams
params {
      depResolverSolveExecutables :: SolveExecutables
depResolverSolveExecutables = SolveExecutables
b
    }

setGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering)
             -> DepResolverParams
             -> DepResolverParams
setGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering)
-> DepResolverParams -> DepResolverParams
setGoalOrder Maybe (Variable QPN -> Variable QPN -> Ordering)
order DepResolverParams
params =
    DepResolverParams
params {
      depResolverGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering)
depResolverGoalOrder = Maybe (Variable QPN -> Variable QPN -> Ordering)
order
    }

setSolverVerbosity :: Verbosity -> DepResolverParams -> DepResolverParams
setSolverVerbosity :: Verbosity -> DepResolverParams -> DepResolverParams
setSolverVerbosity Verbosity
verbosity DepResolverParams
params =
    DepResolverParams
params {
      depResolverVerbosity :: Verbosity
depResolverVerbosity = Verbosity
verbosity
    }

-- | Some packages are specific to a given compiler version and should never be
-- upgraded.
dontUpgradeNonUpgradeablePackages :: DepResolverParams -> DepResolverParams
dontUpgradeNonUpgradeablePackages :: DepResolverParams -> DepResolverParams
dontUpgradeNonUpgradeablePackages DepResolverParams
params =
    [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints [LabeledPackageConstraint]
extraConstraints DepResolverParams
params
  where
    extraConstraints :: [LabeledPackageConstraint]
extraConstraints =
      [ PackageConstraint -> ConstraintSource -> LabeledPackageConstraint
LabeledPackageConstraint
        (ConstraintScope -> PackageProperty -> PackageConstraint
PackageConstraint (PackageName -> ConstraintScope
ScopeAnyQualifier PackageName
pkgname) PackageProperty
PackagePropertyInstalled)
        ConstraintSource
ConstraintSourceNonUpgradeablePackage
      | forall a. Ord a => a -> Set a -> Bool
Set.notMember (String -> PackageName
mkPackageName String
"base") (DepResolverParams -> Set PackageName
depResolverTargets DepResolverParams
params)
      -- If you change this enumeration, make sure to update the list in
      -- "Distribution.Solver.Modular.Solver" as well
      , PackageName
pkgname <- [ String -> PackageName
mkPackageName String
"base"
                   , String -> PackageName
mkPackageName String
"ghc-bignum"
                   , String -> PackageName
mkPackageName String
"ghc-prim"
                   , String -> PackageName
mkPackageName String
"ghc-boot"
                   , String -> PackageName
mkPackageName String
"ghc"
                   , String -> PackageName
mkPackageName String
"ghci"
                   , String -> PackageName
mkPackageName String
"integer-gmp"
                   , String -> PackageName
mkPackageName String
"integer-simple"
                   , String -> PackageName
mkPackageName String
"template-haskell"
                   ]
      , PackageName -> Bool
isInstalled PackageName
pkgname ]

    isInstalled :: PackageName -> Bool
isInstalled = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PackageIndex a -> PackageName -> [(Version, [a])]
InstalledPackageIndex.lookupPackageName
                                 (DepResolverParams -> InstalledPackageIndex
depResolverInstalledPkgIndex DepResolverParams
params)

addSourcePackages :: [UnresolvedSourcePackage]
                  -> DepResolverParams -> DepResolverParams
addSourcePackages :: [UnresolvedSourcePackage] -> DepResolverParams -> DepResolverParams
addSourcePackages [UnresolvedSourcePackage]
pkgs DepResolverParams
params =
    DepResolverParams
params {
      depResolverSourcePkgIndex :: PackageIndex UnresolvedSourcePackage
depResolverSourcePkgIndex =
        forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall pkg.
Package pkg =>
pkg -> PackageIndex pkg -> PackageIndex pkg
PackageIndex.insert)
              (DepResolverParams -> PackageIndex UnresolvedSourcePackage
depResolverSourcePkgIndex DepResolverParams
params) [UnresolvedSourcePackage]
pkgs
    }

hideInstalledPackagesSpecificBySourcePackageId :: [PackageId]
                                                  -> DepResolverParams
                                                  -> DepResolverParams
hideInstalledPackagesSpecificBySourcePackageId :: [PackageId] -> DepResolverParams -> DepResolverParams
hideInstalledPackagesSpecificBySourcePackageId [PackageId]
pkgids DepResolverParams
params =
    --TODO: this should work using exclude constraints instead
    DepResolverParams
params {
      depResolverInstalledPkgIndex :: InstalledPackageIndex
depResolverInstalledPkgIndex =
        forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip PackageId -> InstalledPackageIndex -> InstalledPackageIndex
InstalledPackageIndex.deleteSourcePackageId)
               (DepResolverParams -> InstalledPackageIndex
depResolverInstalledPkgIndex DepResolverParams
params) [PackageId]
pkgids
    }

hideInstalledPackagesAllVersions :: [PackageName]
                                 -> DepResolverParams -> DepResolverParams
hideInstalledPackagesAllVersions :: [PackageName] -> DepResolverParams -> DepResolverParams
hideInstalledPackagesAllVersions [PackageName]
pkgnames DepResolverParams
params =
    --TODO: this should work using exclude constraints instead
    DepResolverParams
params {
      depResolverInstalledPkgIndex :: InstalledPackageIndex
depResolverInstalledPkgIndex =
        forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip PackageName -> InstalledPackageIndex -> InstalledPackageIndex
InstalledPackageIndex.deletePackageName)
               (DepResolverParams -> InstalledPackageIndex
depResolverInstalledPkgIndex DepResolverParams
params) [PackageName]
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 -> DepResolverParams -> DepResolverParams
removeUpperBounds (AllowNewer RelaxDeps
relDeps) = RelaxKind -> RelaxDeps -> DepResolverParams -> DepResolverParams
removeBounds RelaxKind
RelaxUpper RelaxDeps
relDeps

-- | Dual of 'removeUpperBounds'
removeLowerBounds :: AllowOlder -> DepResolverParams -> DepResolverParams
removeLowerBounds :: AllowOlder -> DepResolverParams -> DepResolverParams
removeLowerBounds (AllowOlder RelaxDeps
relDeps) = RelaxKind -> RelaxDeps -> DepResolverParams -> DepResolverParams
removeBounds RelaxKind
RelaxLower RelaxDeps
relDeps

data RelaxKind = RelaxLower | RelaxUpper

-- | Common internal implementation of 'removeLowerBounds'/'removeUpperBounds'
removeBounds :: RelaxKind -> RelaxDeps -> DepResolverParams -> DepResolverParams
removeBounds :: RelaxKind -> RelaxDeps -> DepResolverParams -> DepResolverParams
removeBounds RelaxKind
_ RelaxDeps
rd DepResolverParams
params | Bool -> Bool
not (RelaxDeps -> Bool
isRelaxDeps RelaxDeps
rd) = DepResolverParams
params -- no-op optimisation
removeBounds  RelaxKind
relKind RelaxDeps
relDeps            DepResolverParams
params =
    DepResolverParams
params {
      depResolverSourcePkgIndex :: PackageIndex UnresolvedSourcePackage
depResolverSourcePkgIndex = PackageIndex UnresolvedSourcePackage
sourcePkgIndex'
    }
  where
    sourcePkgIndex' :: PackageIndex.PackageIndex UnresolvedSourcePackage
    sourcePkgIndex' :: PackageIndex UnresolvedSourcePackage
sourcePkgIndex' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnresolvedSourcePackage -> UnresolvedSourcePackage
relaxDeps forall a b. (a -> b) -> a -> b
$ DepResolverParams -> PackageIndex UnresolvedSourcePackage
depResolverSourcePkgIndex DepResolverParams
params

    relaxDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage
    relaxDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage
relaxDeps UnresolvedSourcePackage
srcPkg = UnresolvedSourcePackage
srcPkg
      { srcpkgDescription :: GenericPackageDescription
srcpkgDescription = RelaxKind
-> RelaxDeps
-> GenericPackageDescription
-> GenericPackageDescription
relaxPackageDeps RelaxKind
relKind RelaxDeps
relDeps (forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription UnresolvedSourcePackage
srcPkg)
      }

-- | Relax the dependencies of this package if needed.
--
-- Helper function used by 'removeBounds'
relaxPackageDeps :: RelaxKind
                 -> RelaxDeps
                 -> PD.GenericPackageDescription -> PD.GenericPackageDescription
relaxPackageDeps :: RelaxKind
-> RelaxDeps
-> GenericPackageDescription
-> GenericPackageDescription
relaxPackageDeps RelaxKind
_ RelaxDeps
rd GenericPackageDescription
gpd | Bool -> Bool
not (RelaxDeps -> Bool
isRelaxDeps RelaxDeps
rd) = GenericPackageDescription
gpd -- subsumed by no-op case in 'removeBounds'
relaxPackageDeps RelaxKind
relKind RelaxDeps
RelaxDepsAll  GenericPackageDescription
gpd = (Dependency -> Dependency)
-> GenericPackageDescription -> GenericPackageDescription
PD.transformAllBuildDepends Dependency -> Dependency
relaxAll GenericPackageDescription
gpd
  where
    relaxAll :: Dependency -> Dependency
    relaxAll :: Dependency -> Dependency
relaxAll (Dependency PackageName
pkgName VersionRange
verRange NonEmptySet LibraryName
cs) =
        PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
pkgName (RelaxKind -> RelaxDepMod -> VersionRange -> VersionRange
removeBound RelaxKind
relKind RelaxDepMod
RelaxDepModNone VersionRange
verRange) NonEmptySet LibraryName
cs

relaxPackageDeps RelaxKind
relKind (RelaxDepsSome [RelaxedDep]
depsToRelax0) GenericPackageDescription
gpd =
  (Dependency -> Dependency)
-> GenericPackageDescription -> GenericPackageDescription
PD.transformAllBuildDepends Dependency -> Dependency
relaxSome GenericPackageDescription
gpd
  where
    thisPkgName :: PackageName
thisPkgName    = forall pkg. Package pkg => pkg -> PackageName
packageName GenericPackageDescription
gpd
    thisPkgId :: PackageId
thisPkgId      = forall pkg. Package pkg => pkg -> PackageId
packageId   GenericPackageDescription
gpd
    depsToRelax :: Map RelaxDepSubject RelaxDepMod
depsToRelax    = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe RelaxedDep -> Maybe (RelaxDepSubject, RelaxDepMod)
f [RelaxedDep]
depsToRelax0

    f :: RelaxedDep -> Maybe (RelaxDepSubject,RelaxDepMod)
    f :: RelaxedDep -> Maybe (RelaxDepSubject, RelaxDepMod)
f (RelaxedDep RelaxDepScope
scope RelaxDepMod
rdm RelaxDepSubject
p) = case RelaxDepScope
scope of
      RelaxDepScope
RelaxDepScopeAll        -> forall a. a -> Maybe a
Just (RelaxDepSubject
p,RelaxDepMod
rdm)
      RelaxDepScopePackage PackageName
p0
          | PackageName
p0 forall a. Eq a => a -> a -> Bool
== PackageName
thisPkgName -> forall a. a -> Maybe a
Just (RelaxDepSubject
p,RelaxDepMod
rdm)
          | Bool
otherwise         -> forall a. Maybe a
Nothing
      RelaxDepScopePackageId PackageId
p0
          | PackageId
p0 forall a. Eq a => a -> a -> Bool
== PackageId
thisPkgId   -> forall a. a -> Maybe a
Just (RelaxDepSubject
p,RelaxDepMod
rdm)
          | Bool
otherwise         -> forall a. Maybe a
Nothing

    relaxSome :: Dependency -> Dependency
    relaxSome :: Dependency -> Dependency
relaxSome d :: Dependency
d@(Dependency PackageName
depName VersionRange
verRange NonEmptySet LibraryName
cs)
        | Just RelaxDepMod
relMod <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RelaxDepSubject
RelaxDepSubjectAll Map RelaxDepSubject RelaxDepMod
depsToRelax =
            -- a '*'-subject acts absorbing, for consistency with
            -- the 'Semigroup RelaxDeps' instance
            PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
depName (RelaxKind -> RelaxDepMod -> VersionRange -> VersionRange
removeBound RelaxKind
relKind RelaxDepMod
relMod VersionRange
verRange) NonEmptySet LibraryName
cs
        | Just RelaxDepMod
relMod <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName -> RelaxDepSubject
RelaxDepSubjectPkg PackageName
depName) Map RelaxDepSubject RelaxDepMod
depsToRelax =
            PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
depName (RelaxKind -> RelaxDepMod -> VersionRange -> VersionRange
removeBound RelaxKind
relKind RelaxDepMod
relMod VersionRange
verRange) NonEmptySet LibraryName
cs
        | Bool
otherwise = Dependency
d -- no-op

-- | Internal helper for 'relaxPackageDeps'
removeBound :: RelaxKind -> RelaxDepMod -> VersionRange -> VersionRange
removeBound :: RelaxKind -> RelaxDepMod -> VersionRange -> VersionRange
removeBound RelaxKind
RelaxLower RelaxDepMod
RelaxDepModNone  = VersionRange -> VersionRange
removeLowerBound
removeBound RelaxKind
RelaxUpper RelaxDepMod
RelaxDepModNone  = VersionRange -> VersionRange
removeUpperBound
removeBound RelaxKind
RelaxLower RelaxDepMod
RelaxDepModCaret = VersionRange -> VersionRange
transformCaretLower
removeBound RelaxKind
RelaxUpper RelaxDepMod
RelaxDepModCaret = VersionRange -> VersionRange
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 :: (UnresolvedSourcePackage -> Maybe [Dependency])
-> DepResolverParams -> DepResolverParams
addDefaultSetupDependencies UnresolvedSourcePackage -> Maybe [Dependency]
defaultSetupDeps DepResolverParams
params =
    DepResolverParams
params {
      depResolverSourcePkgIndex :: PackageIndex UnresolvedSourcePackage
depResolverSourcePkgIndex =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnresolvedSourcePackage -> UnresolvedSourcePackage
applyDefaultSetupDeps (DepResolverParams -> PackageIndex UnresolvedSourcePackage
depResolverSourcePkgIndex DepResolverParams
params)
    }
  where
    applyDefaultSetupDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage
    applyDefaultSetupDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage
applyDefaultSetupDeps UnresolvedSourcePackage
srcpkg =
        UnresolvedSourcePackage
srcpkg {
          srcpkgDescription :: GenericPackageDescription
srcpkgDescription = GenericPackageDescription
gpkgdesc {
            packageDescription :: PackageDescription
PD.packageDescription = PackageDescription
pkgdesc {
              setupBuildInfo :: Maybe SetupBuildInfo
PD.setupBuildInfo =
                case PackageDescription -> Maybe SetupBuildInfo
PD.setupBuildInfo PackageDescription
pkgdesc of
                  Just SetupBuildInfo
sbi -> forall a. a -> Maybe a
Just SetupBuildInfo
sbi
                  Maybe SetupBuildInfo
Nothing -> case UnresolvedSourcePackage -> Maybe [Dependency]
defaultSetupDeps UnresolvedSourcePackage
srcpkg of
                    Maybe [Dependency]
Nothing -> forall a. Maybe a
Nothing
                    Just [Dependency]
deps | Bool
isCustom -> forall a. a -> Maybe a
Just PD.SetupBuildInfo {
                                                defaultSetupDepends :: Bool
PD.defaultSetupDepends = Bool
True,
                                                setupDepends :: [Dependency]
PD.setupDepends        = [Dependency]
deps
                                            }
                              | Bool
otherwise -> forall a. Maybe a
Nothing
            }
          }
        }
      where
        isCustom :: Bool
isCustom = PackageDescription -> BuildType
PD.buildType PackageDescription
pkgdesc forall a. Eq a => a -> a -> Bool
== BuildType
PD.Custom
        gpkgdesc :: GenericPackageDescription
gpkgdesc = forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription UnresolvedSourcePackage
srcpkg
        pkgdesc :: PackageDescription
pkgdesc  = GenericPackageDescription -> PackageDescription
PD.packageDescription GenericPackageDescription
gpkgdesc

-- | If a package has a custom setup then we need to add a setup-depends
-- on Cabal.
--
addSetupCabalMinVersionConstraint :: Version
                                  -> DepResolverParams -> DepResolverParams
addSetupCabalMinVersionConstraint :: Version -> DepResolverParams -> DepResolverParams
addSetupCabalMinVersionConstraint Version
minVersion =
    [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints
      [ PackageConstraint -> ConstraintSource -> LabeledPackageConstraint
LabeledPackageConstraint
          (ConstraintScope -> PackageProperty -> PackageConstraint
PackageConstraint (PackageName -> ConstraintScope
ScopeAnySetupQualifier PackageName
cabalPkgname)
                             (VersionRange -> PackageProperty
PackagePropertyVersion forall a b. (a -> b) -> a -> b
$ Version -> VersionRange
orLaterVersion Version
minVersion))
          ConstraintSource
ConstraintSetupCabalMinVersion
      ]
  where
    cabalPkgname :: PackageName
cabalPkgname = String -> PackageName
mkPackageName String
"Cabal"

-- | Variant of 'addSetupCabalMinVersionConstraint' which sets an
-- upper bound on @setup.Cabal@ labeled with 'ConstraintSetupCabalMaxVersion'.
--
addSetupCabalMaxVersionConstraint :: Version
                                  -> DepResolverParams -> DepResolverParams
addSetupCabalMaxVersionConstraint :: Version -> DepResolverParams -> DepResolverParams
addSetupCabalMaxVersionConstraint Version
maxVersion =
    [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints
      [ PackageConstraint -> ConstraintSource -> LabeledPackageConstraint
LabeledPackageConstraint
          (ConstraintScope -> PackageProperty -> PackageConstraint
PackageConstraint (PackageName -> ConstraintScope
ScopeAnySetupQualifier PackageName
cabalPkgname)
                             (VersionRange -> PackageProperty
PackagePropertyVersion forall a b. (a -> b) -> a -> b
$ Version -> VersionRange
earlierVersion Version
maxVersion))
          ConstraintSource
ConstraintSetupCabalMaxVersion
      ]
  where
    cabalPkgname :: PackageName
cabalPkgname = String -> PackageName
mkPackageName String
"Cabal"


upgradeDependencies :: DepResolverParams -> DepResolverParams
upgradeDependencies :: DepResolverParams -> DepResolverParams
upgradeDependencies = PackagesPreferenceDefault -> DepResolverParams -> DepResolverParams
setPreferenceDefault PackagesPreferenceDefault
PreferAllLatest


reinstallTargets :: DepResolverParams -> DepResolverParams
reinstallTargets :: DepResolverParams -> DepResolverParams
reinstallTargets DepResolverParams
params =
    [PackageName] -> DepResolverParams -> DepResolverParams
hideInstalledPackagesAllVersions (forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ DepResolverParams -> Set PackageName
depResolverTargets DepResolverParams
params) DepResolverParams
params


-- | A basic solver policy on which all others are built.
--
basicInstallPolicy :: InstalledPackageIndex
                   -> SourcePackageDb
                   -> [PackageSpecifier UnresolvedSourcePackage]
                   -> DepResolverParams
basicInstallPolicy :: InstalledPackageIndex
-> SourcePackageDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> DepResolverParams
basicInstallPolicy
    InstalledPackageIndex
installedPkgIndex (SourcePackageDb PackageIndex UnresolvedSourcePackage
sourcePkgIndex Map PackageName VersionRange
sourcePkgPrefs)
    [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers

  = [PackagePreference] -> DepResolverParams -> DepResolverParams
addPreferences
      [ PackageName -> VersionRange -> PackagePreference
PackageVersionPreference PackageName
name VersionRange
ver
      | (PackageName
name, VersionRange
ver) <- forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName VersionRange
sourcePkgPrefs ]

  forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LabeledPackageConstraint]
-> DepResolverParams -> DepResolverParams
addConstraints
      (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall pkg.
Package pkg =>
PackageSpecifier pkg -> [LabeledPackageConstraint]
pkgSpecifierConstraints [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers)

  forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PackageName] -> DepResolverParams -> DepResolverParams
addTargets
      (forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => PackageSpecifier pkg -> PackageName
pkgSpecifierTarget [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers)

  forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PackageId] -> DepResolverParams -> DepResolverParams
hideInstalledPackagesSpecificBySourcePackageId
      [ forall pkg. Package pkg => pkg -> PackageId
packageId UnresolvedSourcePackage
pkg | SpecificSourcePackage UnresolvedSourcePackage
pkg <- [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers ]

  forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UnresolvedSourcePackage] -> DepResolverParams -> DepResolverParams
addSourcePackages
      [ UnresolvedSourcePackage
pkg  | SpecificSourcePackage UnresolvedSourcePackage
pkg <- [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers ]

  forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex
-> PackageIndex UnresolvedSourcePackage -> DepResolverParams
basicDepResolverParams
      InstalledPackageIndex
installedPkgIndex PackageIndex UnresolvedSourcePackage
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 :: InstalledPackageIndex
-> SourcePackageDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> DepResolverParams
standardInstallPolicy InstalledPackageIndex
installedPkgIndex SourcePackageDb
sourcePkgDb [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers

  = (UnresolvedSourcePackage -> Maybe [Dependency])
-> DepResolverParams -> DepResolverParams
addDefaultSetupDependencies UnresolvedSourcePackage -> Maybe [Dependency]
mkDefaultSetupDeps

  forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex
-> SourcePackageDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> DepResolverParams
basicInstallPolicy
      InstalledPackageIndex
installedPkgIndex SourcePackageDb
sourcePkgDb [PackageSpecifier UnresolvedSourcePackage]
pkgSpecifiers

    where
      -- Force Cabal >= 1.24 dep when the package is affected by #3199.
      mkDefaultSetupDeps :: UnresolvedSourcePackage -> Maybe [Dependency]
      mkDefaultSetupDeps :: UnresolvedSourcePackage -> Maybe [Dependency]
mkDefaultSetupDeps UnresolvedSourcePackage
srcpkg | Bool
affected        =
        forall a. a -> Maybe a
Just [PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency (String -> PackageName
mkPackageName String
"Cabal") (Version -> VersionRange
orLaterVersion forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion [Int
1,Int
24]) NonEmptySet LibraryName
mainLibSet]
                                | Bool
otherwise       = forall a. Maybe a
Nothing
        where
          gpkgdesc :: GenericPackageDescription
gpkgdesc = forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription UnresolvedSourcePackage
srcpkg
          pkgdesc :: PackageDescription
pkgdesc  = GenericPackageDescription -> PackageDescription
PD.packageDescription GenericPackageDescription
gpkgdesc
          bt :: BuildType
bt       = PackageDescription -> BuildType
PD.buildType PackageDescription
pkgdesc
          affected :: Bool
affected = BuildType
bt forall a. Eq a => a -> a -> Bool
== BuildType
PD.Custom Bool -> Bool -> Bool
&& GenericPackageDescription -> Bool
hasBuildableFalse GenericPackageDescription
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 :: GenericPackageDescription -> Bool
hasBuildableFalse GenericPackageDescription
gpkg =
        Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {c}. Condition c -> Bool
alwaysTrue (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall v. Eq v => Condition v -> Condition v -> Condition v
PD.cOr [Condition ConfVar]
buildableConditions [Condition ConfVar]
noDepConditions))
        where
          buildableConditions :: [Condition ConfVar]
buildableConditions      = (BuildInfo -> Bool)
-> GenericPackageDescription -> [Condition ConfVar]
PD.extractConditions BuildInfo -> Bool
PD.buildable GenericPackageDescription
gpkg
          noDepConditions :: [Condition ConfVar]
noDepConditions          = (BuildInfo -> Bool)
-> GenericPackageDescription -> [Condition ConfVar]
PD.extractConditions
                                     (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [Dependency]
PD.targetBuildDepends)    GenericPackageDescription
gpkg
          alwaysTrue :: Condition c -> Bool
alwaysTrue (PD.Lit Bool
True) = Bool
True
          alwaysTrue Condition c
_             = Bool
False

-- ------------------------------------------------------------
-- * Interface to the standard resolver
-- ------------------------------------------------------------

chooseSolver :: Verbosity -> PreSolver -> CompilerInfo -> IO Solver
chooseSolver :: Verbosity -> PreSolver -> CompilerInfo -> IO Solver
chooseSolver Verbosity
_verbosity PreSolver
preSolver CompilerInfo
_cinfo =
    case PreSolver
preSolver of
      PreSolver
AlwaysModular -> do
        forall (m :: * -> *) a. Monad m => a -> m a
return Solver
Modular

runSolver :: Solver -> SolverConfig -> DependencyResolver UnresolvedPkgLoc
runSolver :: Solver -> SolverConfig -> DependencyResolver UnresolvedPkgLoc
runSolver Solver
Modular = forall loc. SolverConfig -> DependencyResolver loc
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
-> CompilerInfo
-> PkgConfigDb
-> Solver
-> DepResolverParams
-> Progress String String SolverInstallPlan
resolveDependencies Platform
platform CompilerInfo
comp PkgConfigDb
_pkgConfigDB Solver
_solver DepResolverParams
params
  | forall a. Set a -> Bool
Set.null (DepResolverParams -> Set PackageName
depResolverTargets DepResolverParams
params)
  = forall (m :: * -> *) a. Monad m => a -> m a
return (Platform
-> CompilerInfo
-> IndependentGoals
-> [ResolverPackage UnresolvedPkgLoc]
-> SolverInstallPlan
validateSolverResult Platform
platform CompilerInfo
comp IndependentGoals
indGoals [])
  where
    indGoals :: IndependentGoals
indGoals = DepResolverParams -> IndependentGoals
depResolverIndependentGoals DepResolverParams
params

resolveDependencies Platform
platform CompilerInfo
comp PkgConfigDb
pkgConfigDB Solver
solver DepResolverParams
params =

    forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (DepResolverParams -> String
showDepResolverParams DepResolverParams
finalparams)
  forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Platform
-> CompilerInfo
-> IndependentGoals
-> [ResolverPackage UnresolvedPkgLoc]
-> SolverInstallPlan
validateSolverResult Platform
platform CompilerInfo
comp IndependentGoals
indGoals)
  forall a b. (a -> b) -> a -> b
$ Solver -> SolverConfig -> DependencyResolver UnresolvedPkgLoc
runSolver Solver
solver (ReorderGoals
-> CountConflicts
-> FineGrainedConflicts
-> MinimizeConflictSet
-> IndependentGoals
-> AvoidReinstalls
-> ShadowPkgs
-> StrongFlags
-> AllowBootLibInstalls
-> OnlyConstrained
-> Maybe Int
-> EnableBackjumping
-> SolveExecutables
-> Maybe (Variable QPN -> Variable QPN -> Ordering)
-> Verbosity
-> PruneAfterFirstSuccess
-> SolverConfig
SolverConfig ReorderGoals
reordGoals CountConflicts
cntConflicts FineGrainedConflicts
fineGrained MinimizeConflictSet
minimize
                      IndependentGoals
indGoals AvoidReinstalls
noReinstalls
                      ShadowPkgs
shadowing StrongFlags
strFlags AllowBootLibInstalls
allowBootLibs OnlyConstrained
onlyConstrained_ Maybe Int
maxBkjumps EnableBackjumping
enableBj
                      SolveExecutables
solveExes Maybe (Variable QPN -> Variable QPN -> Ordering)
order Verbosity
verbosity (Bool -> PruneAfterFirstSuccess
PruneAfterFirstSuccess Bool
False))
                     Platform
platform CompilerInfo
comp InstalledPackageIndex
installedPkgIndex PackageIndex UnresolvedSourcePackage
sourcePkgIndex
                     PkgConfigDb
pkgConfigDB PackageName -> PackagePreferences
preferences [LabeledPackageConstraint]
constraints Set PackageName
targets
  where

    finalparams :: DepResolverParams
finalparams@(DepResolverParams
      Set PackageName
targets [LabeledPackageConstraint]
constraints
      [PackagePreference]
prefs PackagesPreferenceDefault
defpref
      InstalledPackageIndex
installedPkgIndex
      PackageIndex UnresolvedSourcePackage
sourcePkgIndex
      ReorderGoals
reordGoals
      CountConflicts
cntConflicts
      FineGrainedConflicts
fineGrained
      MinimizeConflictSet
minimize
      IndependentGoals
indGoals
      AvoidReinstalls
noReinstalls
      ShadowPkgs
shadowing
      StrongFlags
strFlags
      AllowBootLibInstalls
allowBootLibs
      OnlyConstrained
onlyConstrained_
      Maybe Int
maxBkjumps
      EnableBackjumping
enableBj
      SolveExecutables
solveExes
      Maybe (Variable QPN -> Variable QPN -> Ordering)
order
      Verbosity
verbosity) =
        if forall a. BooleanFlag a => a -> Bool
asBool (DepResolverParams -> AllowBootLibInstalls
depResolverAllowBootLibInstalls DepResolverParams
params)
        then DepResolverParams
params
        else DepResolverParams -> DepResolverParams
dontUpgradeNonUpgradeablePackages DepResolverParams
params

    preferences :: PackageName -> PackagePreferences
    preferences :: PackageName -> PackagePreferences
preferences = Set PackageName
-> PackagesPreferenceDefault
-> [PackagePreference]
-> PackageName
-> PackagePreferences
interpretPackagesPreference Set PackageName
targets PackagesPreferenceDefault
defpref [PackagePreference]
prefs


-- | Give an interpretation to the global 'PackagesPreference' as
--  specific per-package 'PackageVersionPreference'.
--
interpretPackagesPreference :: Set PackageName
                            -> PackagesPreferenceDefault
                            -> [PackagePreference]
                            -> (PackageName -> PackagePreferences)
interpretPackagesPreference :: Set PackageName
-> PackagesPreferenceDefault
-> [PackagePreference]
-> PackageName
-> PackagePreferences
interpretPackagesPreference Set PackageName
selected PackagesPreferenceDefault
defaultPref [PackagePreference]
prefs =
  \PackageName
pkgname -> [VersionRange]
-> InstalledPreference -> [OptionalStanza] -> PackagePreferences
PackagePreferences (PackageName -> [VersionRange]
versionPref PackageName
pkgname)
                                 (PackageName -> InstalledPreference
installPref PackageName
pkgname)
                                 (PackageName -> [OptionalStanza]
stanzasPref PackageName
pkgname)
  where
    versionPref :: PackageName -> [VersionRange]
    versionPref :: PackageName -> [VersionRange]
versionPref PackageName
pkgname =
      forall a. a -> Maybe a -> a
fromMaybe [VersionRange
anyVersion] (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pkgname Map PackageName [VersionRange]
versionPrefs)
    versionPrefs :: Map PackageName [VersionRange]
versionPrefs = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++)
                   [(PackageName
pkgname, [VersionRange
pref])
                   | PackageVersionPreference PackageName
pkgname VersionRange
pref <- [PackagePreference]
prefs]

    installPref :: PackageName -> InstalledPreference
    installPref :: PackageName -> InstalledPreference
installPref PackageName
pkgname =
      forall a. a -> Maybe a -> a
fromMaybe (PackageName -> InstalledPreference
installPrefDefault PackageName
pkgname) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pkgname Map PackageName InstalledPreference
installPrefs)
    installPrefs :: Map PackageName InstalledPreference
installPrefs = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (PackageName
pkgname, InstalledPreference
pref)
      | PackageInstalledPreference PackageName
pkgname InstalledPreference
pref <- [PackagePreference]
prefs ]
    installPrefDefault :: PackageName -> InstalledPreference
installPrefDefault = case PackagesPreferenceDefault
defaultPref of
      PackagesPreferenceDefault
PreferAllLatest         -> forall a b. a -> b -> a
const InstalledPreference
Preference.PreferLatest
      PackagesPreferenceDefault
PreferAllOldest         -> forall a b. a -> b -> a
const InstalledPreference
Preference.PreferOldest
      PackagesPreferenceDefault
PreferAllInstalled      -> forall a b. a -> b -> a
const InstalledPreference
Preference.PreferInstalled
      PackagesPreferenceDefault
PreferLatestForSelected -> \PackageName
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 PackageName
pkgname forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageName
selected then InstalledPreference
Preference.PreferLatest
                                         else InstalledPreference
Preference.PreferInstalled

    stanzasPref :: PackageName -> [OptionalStanza]
    stanzasPref :: PackageName -> [OptionalStanza]
stanzasPref PackageName
pkgname =
      forall a. a -> Maybe a -> a
fromMaybe [] (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pkgname Map PackageName [OptionalStanza]
stanzasPrefs)
    stanzasPrefs :: Map PackageName [OptionalStanza]
stanzasPrefs = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (\[OptionalStanza]
a [OptionalStanza]
b -> forall a. Eq a => [a] -> [a]
nub ([OptionalStanza]
a forall a. [a] -> [a] -> [a]
++ [OptionalStanza]
b))
      [ (PackageName
pkgname, [OptionalStanza]
pref)
      | PackageStanzasPreference PackageName
pkgname [OptionalStanza]
pref <- [PackagePreference]
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
-> CompilerInfo
-> IndependentGoals
-> [ResolverPackage UnresolvedPkgLoc]
-> SolverInstallPlan
validateSolverResult Platform
platform CompilerInfo
comp IndependentGoals
indepGoals [ResolverPackage UnresolvedPkgLoc]
pkgs =
    case Platform
-> CompilerInfo
-> [ResolverPackage UnresolvedPkgLoc]
-> [PlanPackageProblem]
planPackagesProblems Platform
platform CompilerInfo
comp [ResolverPackage UnresolvedPkgLoc]
pkgs of
      [] -> case IndependentGoals
-> SolverPlanIndex -> Either [SolverPlanProblem] SolverInstallPlan
SolverInstallPlan.new IndependentGoals
indepGoals SolverPlanIndex
graph of
              Right SolverInstallPlan
plan     -> SolverInstallPlan
plan
              Left  [SolverPlanProblem]
problems -> forall a. (?callStack::CallStack) => String -> a
error ([SolverPlanProblem] -> String
formatPlanProblems [SolverPlanProblem]
problems)
      [PlanPackageProblem]
problems               -> forall a. (?callStack::CallStack) => String -> a
error ([PlanPackageProblem] -> String
formatPkgProblems [PlanPackageProblem]
problems)

  where
    graph :: Graph.Graph (ResolverPackage UnresolvedPkgLoc)
    graph :: SolverPlanIndex
graph = forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList [ResolverPackage UnresolvedPkgLoc]
pkgs

    formatPkgProblems :: [PlanPackageProblem] -> String
    formatPkgProblems :: [PlanPackageProblem] -> String
formatPkgProblems  = [String] -> String
formatProblemMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map PlanPackageProblem -> String
showPlanPackageProblem
    formatPlanProblems :: [SolverInstallPlan.SolverPlanProblem] -> String
    formatPlanProblems :: [SolverPlanProblem] -> String
formatPlanProblems = [String] -> String
formatProblemMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map SolverPlanProblem -> String
SolverInstallPlan.showPlanProblem

    formatProblemMessage :: [String] -> String
formatProblemMessage [String]
problems =
      [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
        String
"internal error: could not construct a valid install plan."
      forall a. a -> [a] -> [a]
: String
"The proposed (invalid) plan contained the following problems:"
      forall a. a -> [a] -> [a]
: [String]
problems
      forall a. [a] -> [a] -> [a]
++ String
"Proposed plan:"
      forall a. a -> [a] -> [a]
: [[ResolverPackage UnresolvedPkgLoc] -> String
SolverInstallPlan.showPlanIndex [ResolverPackage UnresolvedPkgLoc]
pkgs]


data PlanPackageProblem =
       InvalidConfiguredPackage (SolverPackage UnresolvedPkgLoc)
                                [PackageProblem]
     | DuplicatePackageSolverId SolverId [ResolverPackage UnresolvedPkgLoc]

showPlanPackageProblem :: PlanPackageProblem -> String
showPlanPackageProblem :: PlanPackageProblem -> String
showPlanPackageProblem (InvalidConfiguredPackage SolverPackage UnresolvedPkgLoc
pkg [PackageProblem]
packageProblems) =
     String
"Package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageId
packageId SolverPackage UnresolvedPkgLoc
pkg)
  forall a. [a] -> [a] -> [a]
++ String
" has an invalid configuration, in particular:\n"
  forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [ String
"  " forall a. [a] -> [a] -> [a]
++ PackageProblem -> String
showPackageProblem PackageProblem
problem
             | PackageProblem
problem <- [PackageProblem]
packageProblems ]
showPlanPackageProblem (DuplicatePackageSolverId SolverId
pid [ResolverPackage UnresolvedPkgLoc]
dups) =
     String
"Package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageId
packageId SolverId
pid) forall a. [a] -> [a] -> [a]
++ String
" has "
  forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ResolverPackage UnresolvedPkgLoc]
dups) forall a. [a] -> [a] -> [a]
++ String
" duplicate instances."

planPackagesProblems :: Platform -> CompilerInfo
                     -> [ResolverPackage UnresolvedPkgLoc]
                     -> [PlanPackageProblem]
planPackagesProblems :: Platform
-> CompilerInfo
-> [ResolverPackage UnresolvedPkgLoc]
-> [PlanPackageProblem]
planPackagesProblems Platform
platform CompilerInfo
cinfo [ResolverPackage UnresolvedPkgLoc]
pkgs =
     [ SolverPackage UnresolvedPkgLoc
-> [PackageProblem] -> PlanPackageProblem
InvalidConfiguredPackage SolverPackage UnresolvedPkgLoc
pkg [PackageProblem]
packageProblems
     | Configured SolverPackage UnresolvedPkgLoc
pkg <- [ResolverPackage UnresolvedPkgLoc]
pkgs
     , let packageProblems :: [PackageProblem]
packageProblems = Platform
-> CompilerInfo
-> SolverPackage UnresolvedPkgLoc
-> [PackageProblem]
configuredPackageProblems Platform
platform CompilerInfo
cinfo SolverPackage UnresolvedPkgLoc
pkg
     , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageProblem]
packageProblems) ]
  forall a. [a] -> [a] -> [a]
++ [ SolverId
-> [ResolverPackage UnresolvedPkgLoc] -> PlanPackageProblem
DuplicatePackageSolverId (forall a. IsNode a => a -> Key a
Graph.nodeKey (forall a. [a] -> a
Unsafe.head [ResolverPackage UnresolvedPkgLoc]
dups)) [ResolverPackage UnresolvedPkgLoc]
dups
     | [ResolverPackage UnresolvedPkgLoc]
dups <- forall a. (a -> a -> Ordering) -> [a] -> [[a]]
duplicatesBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a. IsNode a => a -> Key a
Graph.nodeKey) [ResolverPackage UnresolvedPkgLoc]
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 :: PackageProblem -> String
showPackageProblem (DuplicateFlag FlagName
flag) =
  String
"duplicate flag in the flag assignment: " forall a. [a] -> [a] -> [a]
++ FlagName -> String
PD.unFlagName FlagName
flag

showPackageProblem (MissingFlag FlagName
flag) =
  String
"missing an assignment for the flag: " forall a. [a] -> [a] -> [a]
++ FlagName -> String
PD.unFlagName FlagName
flag

showPackageProblem (ExtraFlag FlagName
flag) =
  String
"extra flag given that is not used by the package: " forall a. [a] -> [a] -> [a]
++ FlagName -> String
PD.unFlagName FlagName
flag

showPackageProblem (DuplicateDeps [PackageId]
pkgids) =
     String
"duplicate packages specified as selected dependencies: "
  forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [PackageId]
pkgids)

showPackageProblem (MissingDep Dependency
dep) =
     String
"the package has a dependency " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Dependency
dep
  forall a. [a] -> [a] -> [a]
++ String
" but no package has been selected to satisfy it."

showPackageProblem (ExtraDep PackageId
pkgid) =
     String
"the package configuration specifies " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow PackageId
pkgid
  forall a. [a] -> [a] -> [a]
++ String
" but (with the given flag assignment) the package does not actually"
  forall a. [a] -> [a] -> [a]
++ String
" depend on any version of that package."

showPackageProblem (InvalidDep Dependency
dep PackageId
pkgid) =
     String
"the package depends on " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Dependency
dep
  forall a. [a] -> [a] -> [a]
++ String
" but the configuration specifies " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow PackageId
pkgid
  forall a. [a] -> [a] -> [a]
++ String
" 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
-> CompilerInfo
-> SolverPackage UnresolvedPkgLoc
-> [PackageProblem]
configuredPackageProblems Platform
platform CompilerInfo
cinfo
  (SolverPackage UnresolvedSourcePackage
pkg FlagAssignment
specifiedFlags OptionalStanzaSet
stanzas ComponentDeps [SolverId]
specifiedDeps0  ComponentDeps [SolverId]
_specifiedExeDeps') =
     [ FlagName -> PackageProblem
DuplicateFlag FlagName
flag
     | FlagName
flag <- FlagAssignment -> [FlagName]
PD.findDuplicateFlagAssignments FlagAssignment
specifiedFlags ]
  forall a. [a] -> [a] -> [a]
++ [ FlagName -> PackageProblem
MissingFlag FlagName
flag | OnlyInLeft  FlagName
flag <- [MergeResult FlagName FlagName]
mergedFlags ]
  forall a. [a] -> [a] -> [a]
++ [ FlagName -> PackageProblem
ExtraFlag   FlagName
flag | OnlyInRight FlagName
flag <- [MergeResult FlagName FlagName]
mergedFlags ]
  forall a. [a] -> [a] -> [a]
++ [ [PackageId] -> PackageProblem
DuplicateDeps [PackageId]
pkgs
     | [PackageId]
pkgs <- forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. (a -> a -> Ordering) -> [a] -> [[a]]
duplicatesBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall pkg. Package pkg => pkg -> PackageName
packageName))
                                ComponentDeps [PackageId]
specifiedDeps1) ]
  forall a. [a] -> [a] -> [a]
++ [ Dependency -> PackageProblem
MissingDep Dependency
dep       | OnlyInLeft  Dependency
dep       <- [MergeResult Dependency PackageId]
mergedDeps ]
  forall a. [a] -> [a] -> [a]
++ [ PackageId -> PackageProblem
ExtraDep       PackageId
pkgid | OnlyInRight     PackageId
pkgid <- [MergeResult Dependency PackageId]
mergedDeps ]
  forall a. [a] -> [a] -> [a]
++ [ Dependency -> PackageId -> PackageProblem
InvalidDep Dependency
dep PackageId
pkgid | InBoth      Dependency
dep PackageId
pkgid <- [MergeResult Dependency PackageId]
mergedDeps
                            , Bool -> Bool
not (PackageId -> Dependency -> Bool
packageSatisfiesDependency PackageId
pkgid Dependency
dep) ]
  -- TODO: sanity tests on executable deps
  where
    thisPkgName :: PackageName
    thisPkgName :: PackageName
thisPkgName = forall pkg. Package pkg => pkg -> PackageName
packageName (forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription UnresolvedSourcePackage
pkg)

    specifiedDeps1 :: ComponentDeps [PackageId]
    specifiedDeps1 :: ComponentDeps [PackageId]
specifiedDeps1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map SolverId -> PackageId
solverSrcId) ComponentDeps [SolverId]
specifiedDeps0

    specifiedDeps :: [PackageId]
    specifiedDeps :: [PackageId]
specifiedDeps = forall a. Monoid a => ComponentDeps a -> a
CD.flatDeps ComponentDeps [PackageId]
specifiedDeps1

    mergedFlags :: [MergeResult PD.FlagName PD.FlagName]
    mergedFlags :: [MergeResult FlagName FlagName]
mergedFlags = forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy forall a. Ord a => a -> a -> Ordering
compare
      (forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> FlagName
PD.flagName (GenericPackageDescription -> [PackageFlag]
PD.genPackageFlags (forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription UnresolvedSourcePackage
pkg)))
      (forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (FlagAssignment -> [(FlagName, Bool)]
PD.unFlagAssignment FlagAssignment
specifiedFlags)) -- TODO

    packageSatisfiesDependency :: PackageIdentifier -> Dependency -> Bool
    packageSatisfiesDependency :: PackageId -> Dependency -> Bool
packageSatisfiesDependency
      (PackageIdentifier PackageName
name  Version
version)
      (Dependency        PackageName
name' VersionRange
versionRange NonEmptySet LibraryName
_) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PackageName
name forall a. Eq a => a -> a -> Bool
== PackageName
name') forall a b. (a -> b) -> a -> b
$
        Version
version Version -> VersionRange -> Bool
`withinRange` VersionRange
versionRange

    dependencyName :: Dependency -> PackageName
dependencyName (Dependency PackageName
name VersionRange
_ NonEmptySet LibraryName
_) = PackageName
name

    mergedDeps :: [MergeResult Dependency PackageId]
    mergedDeps :: [MergeResult Dependency PackageId]
mergedDeps = [Dependency] -> [PackageId] -> [MergeResult Dependency PackageId]
mergeDeps [Dependency]
requiredDeps [PackageId]
specifiedDeps

    mergeDeps :: [Dependency] -> [PackageId]
              -> [MergeResult Dependency PackageId]
    mergeDeps :: [Dependency] -> [PackageId] -> [MergeResult Dependency PackageId]
mergeDeps [Dependency]
required [PackageId]
specified =
      let sortNubOn :: (a -> b) -> [a] -> [a]
sortNubOn a -> b
f = forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f) in
      forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy
        (\Dependency
dep PackageId
pkgid -> Dependency -> PackageName
dependencyName Dependency
dep forall a. Ord a => a -> a -> Ordering
`compare` forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pkgid)
        (forall {b} {a}. Ord b => (a -> b) -> [a] -> [a]
sortNubOn Dependency -> PackageName
dependencyName [Dependency]
required)
        (forall {b} {a}. Ord b => (a -> b) -> [a] -> [a]
sortNubOn forall pkg. Package pkg => pkg -> PackageName
packageName    [PackageId]
specified)

    compSpec :: ComponentRequestedSpec
compSpec = OptionalStanzaSet -> ComponentRequestedSpec
enableStanzas OptionalStanzaSet
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 :: [Dependency]
requiredDeps =
      --TODO: use something lower level than finalizePD
      case FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD FlagAssignment
specifiedFlags
         ComponentRequestedSpec
compSpec
         (forall a b. a -> b -> a
const Bool
True)
         Platform
platform CompilerInfo
cinfo
         []
         (forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription UnresolvedSourcePackage
pkg) of
        Right (PackageDescription
resolvedPkg, FlagAssignment
_) ->
            -- 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
            --
            forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= PackageName
thisPkgName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> PackageName
dependencyName)
                (PackageDescription -> ComponentRequestedSpec -> [Dependency]
PD.enabledBuildDepends PackageDescription
resolvedPkg ComponentRequestedSpec
compSpec)
          forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] SetupBuildInfo -> [Dependency]
PD.setupDepends (PackageDescription -> Maybe SetupBuildInfo
PD.setupBuildInfo PackageDescription
resolvedPkg)
        Left  [Dependency]
_ ->
          forall a. (?callStack::CallStack) => String -> a
error String
"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
-> Either [ResolveNoDepsError] [UnresolvedSourcePackage]
resolveWithoutDependencies (DepResolverParams Set PackageName
targets [LabeledPackageConstraint]
constraints
                              [PackagePreference]
prefs PackagesPreferenceDefault
defpref InstalledPackageIndex
installedPkgIndex PackageIndex UnresolvedSourcePackage
sourcePkgIndex
                              ReorderGoals
_reorderGoals CountConflicts
_countConflicts FineGrainedConflicts
_fineGrained
                              MinimizeConflictSet
_minimizeConflictSet IndependentGoals
_indGoals AvoidReinstalls
_avoidReinstalls
                              ShadowPkgs
_shadowing StrongFlags
_strFlags AllowBootLibInstalls
_maxBjumps OnlyConstrained
_enableBj Maybe Int
_solveExes
                              EnableBackjumping
_allowBootLibInstalls SolveExecutables
_onlyConstrained Maybe (Variable QPN -> Variable QPN -> Ordering)
_order Verbosity
_verbosity) =
    forall a b. [Either a b] -> Either [a] [b]
collectEithers forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PackageName -> Either ResolveNoDepsError UnresolvedSourcePackage
selectPackage (forall a. Set a -> [a]
Set.toList Set PackageName
targets)
  where
    selectPackage :: PackageName -> Either ResolveNoDepsError UnresolvedSourcePackage
    selectPackage :: PackageName -> Either ResolveNoDepsError UnresolvedSourcePackage
selectPackage PackageName
pkgname
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnresolvedSourcePackage]
choices = forall a b. a -> Either a b
Left  forall a b. (a -> b) -> a -> b
$! PackageName -> VersionRange -> ResolveNoDepsError
ResolveUnsatisfiable PackageName
pkgname VersionRange
requiredVersions
      | Bool
otherwise    = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy UnresolvedSourcePackage -> UnresolvedSourcePackage -> Ordering
bestByPrefs [UnresolvedSourcePackage]
choices

      where
        -- Constraints
        requiredVersions :: VersionRange
        requiredVersions :: VersionRange
requiredVersions = PackageName -> VersionRange
packageConstraints PackageName
pkgname
        choices          :: [UnresolvedSourcePackage]
        choices :: [UnresolvedSourcePackage]
choices          = forall pkg.
Package pkg =>
PackageIndex pkg -> PackageName -> VersionRange -> [pkg]
PackageIndex.lookupDependency PackageIndex UnresolvedSourcePackage
sourcePkgIndex
                                                         PackageName
pkgname
                                                         VersionRange
requiredVersions

        -- Preferences
        PackagePreferences [VersionRange]
preferredVersions InstalledPreference
preferInstalled [OptionalStanza]
_
          = PackageName -> PackagePreferences
packagePreferences PackageName
pkgname

        bestByPrefs   :: UnresolvedSourcePackage -> UnresolvedSourcePackage -> Ordering
        bestByPrefs :: UnresolvedSourcePackage -> UnresolvedSourcePackage -> Ordering
bestByPrefs   = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a -> b) -> a -> b
$ \UnresolvedSourcePackage
pkg ->
                          (UnresolvedSourcePackage -> Bool
installPref UnresolvedSourcePackage
pkg, forall a. Package a => a -> Int
versionPref UnresolvedSourcePackage
pkg, forall pkg. Package pkg => pkg -> Version
packageVersion UnresolvedSourcePackage
pkg)
        installPref   :: UnresolvedSourcePackage -> Bool
        installPref :: UnresolvedSourcePackage -> Bool
installPref   = case InstalledPreference
preferInstalled of
          InstalledPreference
Preference.PreferLatest    -> forall a b. a -> b -> a
const Bool
False
          InstalledPreference
Preference.PreferOldest    -> forall a b. a -> b -> a
const Bool
False
          InstalledPreference
Preference.PreferInstalled -> Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null
                           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PackageIndex a -> PackageId -> [a]
InstalledPackageIndex.lookupSourcePackageId
                                                     InstalledPackageIndex
installedPkgIndex
                           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageId
packageId
        versionPref     :: Package a => a -> Int
        versionPref :: forall a. Package a => a -> Int
versionPref a
pkg = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall pkg. Package pkg => pkg -> Version
packageVersion a
pkg Version -> VersionRange -> Bool
`withinRange`) forall a b. (a -> b) -> a -> b
$
                          [VersionRange]
preferredVersions

    packageConstraints :: PackageName -> VersionRange
    packageConstraints :: PackageName -> VersionRange
packageConstraints PackageName
pkgname =
      forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault VersionRange
anyVersion PackageName
pkgname Map PackageName VersionRange
packageVersionConstraintMap
    packageVersionConstraintMap :: Map PackageName VersionRange
    packageVersionConstraintMap :: Map PackageName VersionRange
packageVersionConstraintMap =
      let pcs :: [PackageConstraint]
pcs = forall a b. (a -> b) -> [a] -> [b]
map LabeledPackageConstraint -> PackageConstraint
unlabelPackageConstraint [LabeledPackageConstraint]
constraints
      in forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (ConstraintScope -> PackageName
scopeToPackageName ConstraintScope
scope, VersionRange
range)
                      | PackageConstraint
                          ConstraintScope
scope (PackagePropertyVersion VersionRange
range) <- [PackageConstraint]
pcs ]

    packagePreferences :: PackageName -> PackagePreferences
    packagePreferences :: PackageName -> PackagePreferences
packagePreferences = Set PackageName
-> PackagesPreferenceDefault
-> [PackagePreference]
-> PackageName
-> PackagePreferences
interpretPackagesPreference Set PackageName
targets PackagesPreferenceDefault
defpref [PackagePreference]
prefs


collectEithers :: [Either a b] -> Either [a] [b]
collectEithers :: forall a b. [Either a b] -> Either [a] [b]
collectEithers = forall {a} {b}. ([a], b) -> Either [a] b
collect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> ([a], [b])
partitionEithers
  where
    collect :: ([a], b) -> Either [a] b
collect ([], b
xs) = forall a b. b -> Either a b
Right b
xs
    collect ([a]
errs,b
_) = forall a b. a -> Either a b
Left [a]
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 :: ResolveNoDepsError -> String
show (ResolveUnsatisfiable PackageName
name VersionRange
ver) =
       String
"There is no available version of " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow PackageName
name
    forall a. [a] -> [a] -> [a]
++ String
" that satisfies " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (VersionRange -> VersionRange
simplifyVersionRange VersionRange
ver)