cabal-install-solver/src/Distribution/Solver/Modular/Dependency.hs

   1 {-# LANGUAGE DeriveFunctor #-}
   2 {-# LANGUAGE RecordWildCards #-}
   3 module Distribution.Solver.Modular.Dependency (
   4     -- * Variables
   5     Var(..)
   6   , showVar
   7   , varPN
   8     -- * Conflict sets
   9   , ConflictSet
  10   , ConflictMap
  11   , CS.showConflictSet
  12     -- * Constrained instances
  13   , CI(..)
  14     -- * Flagged dependencies
  15   , FlaggedDeps
  16   , FlaggedDep(..)
  17   , LDep(..)
  18   , Dep(..)
  19   , PkgComponent(..)
  20   , ExposedComponent(..)
  21   , DependencyReason(..)
  22   , showDependencyReason
  23   , flattenFlaggedDeps
  24   , QualifyOptions(..)
  25   , qualifyDeps
  26   , unqualifyDeps
  27     -- * Reverse dependency map
  28   , RevDepMap
  29     -- * Goals
  30   , Goal(..)
  31   , GoalReason(..)
  32   , QGoalReason
  33   , goalToVar
  34   , varToConflictSet
  35   , goalReasonToConflictSet
  36   , goalReasonToConflictSetWithConflict
  37   , dependencyReasonToConflictSet
  38   , dependencyReasonToConflictSetWithVersionConstraintConflict
  39   , dependencyReasonToConflictSetWithVersionConflict
  40   ) where
  41
  42 import Prelude ()
  43 import qualified Data.Map as M
  44 import qualified Data.Set as S
  45 import Distribution.Solver.Compat.Prelude hiding (pi)
  46
  47 import Language.Haskell.Extension (Extension(..), Language(..))
  48
  49 import Distribution.Solver.Modular.ConflictSet (ConflictSet, ConflictMap)
  50 import Distribution.Solver.Modular.Flag
  51 import Distribution.Solver.Modular.Package
  52 import Distribution.Solver.Modular.Var
  53 import Distribution.Solver.Modular.Version
  54 import qualified Distribution.Solver.Modular.ConflictSet as CS
  55
  56 import Distribution.Solver.Types.ComponentDeps (Component(..))
  57 import Distribution.Solver.Types.PackagePath
  58 import Distribution.Types.LibraryName
  59 import Distribution.Types.PkgconfigVersionRange
  60 import Distribution.Types.UnqualComponentName
  61
  62 {-------------------------------------------------------------------------------
  63   Constrained instances
  64 -------------------------------------------------------------------------------}
  65
  66 -- | Constrained instance. It represents the allowed instances for a package,
  67 -- which can be either a fixed instance or a version range.
  68 data CI = Fixed I | Constrained VR
  69   deriving (Eq, Show)
  70
  71 {-------------------------------------------------------------------------------
  72   Flagged dependencies
  73 -------------------------------------------------------------------------------}
  74
  75 -- | Flagged dependencies
  76 --
  77 -- 'FlaggedDeps' is the modular solver's view of a packages dependencies:
  78 -- rather than having the dependencies indexed by component, each dependency
  79 -- defines what component it is in.
  80 --
  81 -- Note that each dependency is associated with a Component. We must know what
  82 -- component the dependencies belong to, or else we won't be able to construct
  83 -- fine-grained reverse dependencies.
  84 type FlaggedDeps qpn = [FlaggedDep qpn]
  85
  86 -- | Flagged dependencies can either be plain dependency constraints,
  87 -- or flag-dependent dependency trees.
  88 data FlaggedDep qpn =
  89     -- | Dependencies which are conditional on a flag choice.
  90     Flagged (FN qpn) FInfo (TrueFlaggedDeps qpn) (FalseFlaggedDeps qpn)
  91     -- | Dependencies which are conditional on whether or not a stanza
  92     -- (e.g., a test suite or benchmark) is enabled.
  93   | Stanza  (SN qpn)       (TrueFlaggedDeps qpn)
  94     -- | Dependencies which are always enabled, for the component 'comp'.
  95   | Simple (LDep qpn) Component
  96
  97 -- | Conservatively flatten out flagged dependencies
  98 --
  99 -- NOTE: We do not filter out duplicates.
 100 flattenFlaggedDeps :: FlaggedDeps qpn -> [(LDep qpn, Component)]
 101 flattenFlaggedDeps = concatMap aux
 102   where
 103     aux :: FlaggedDep qpn -> [(LDep qpn, Component)]
 104     aux (Flagged _ _ t f) = flattenFlaggedDeps t ++ flattenFlaggedDeps f
 105     aux (Stanza  _   t)   = flattenFlaggedDeps t
 106     aux (Simple d c)      = [(d, c)]
 107
 108 type TrueFlaggedDeps  qpn = FlaggedDeps qpn
 109 type FalseFlaggedDeps qpn = FlaggedDeps qpn
 110
 111 -- | A 'Dep' labeled with the reason it was introduced.
 112 --
 113 -- 'LDep' intentionally has no 'Functor' instance because the type variable
 114 -- is used both to record the dependencies as well as who's doing the
 115 -- depending; having a 'Functor' instance makes bugs where we don't distinguish
 116 -- these two far too likely. (By rights 'LDep' ought to have two type variables.)
 117 data LDep qpn = LDep (DependencyReason qpn) (Dep qpn)
 118
 119 -- | A dependency (constraint) associates a package name with a constrained
 120 -- instance. It can also represent other types of dependencies, such as
 121 -- dependencies on language extensions.
 122 data Dep qpn = Dep (PkgComponent qpn) CI  -- ^ dependency on a package component
 123              | Ext Extension              -- ^ dependency on a language extension
 124              | Lang Language              -- ^ dependency on a language version
 125              | Pkg PkgconfigName PkgconfigVersionRange  -- ^ dependency on a pkg-config package
 126   deriving Functor
 127
 128 -- | An exposed component within a package. This type is used to represent
 129 -- build-depends and build-tool-depends dependencies.
 130 data PkgComponent qpn = PkgComponent qpn ExposedComponent
 131   deriving (Eq, Ord, Functor, Show)
 132
 133 -- | A component that can be depended upon by another package, i.e., a library
 134 -- or an executable.
 135 data ExposedComponent =
 136     ExposedLib LibraryName
 137   | ExposedExe UnqualComponentName
 138   deriving (Eq, Ord, Show)
 139
 140 -- | The reason that a dependency is active. It identifies the package and any
 141 -- flag and stanza choices that introduced the dependency. It contains
 142 -- everything needed for creating ConflictSets or describing conflicts in solver
 143 -- log messages.
 144 data DependencyReason qpn = DependencyReason qpn (Map Flag FlagValue) (S.Set Stanza)
 145   deriving (Functor, Eq, Show)
 146
 147 -- | Print the reason that a dependency was introduced.
 148 showDependencyReason :: DependencyReason QPN -> String
 149 showDependencyReason (DependencyReason qpn flags stanzas) =
 150     intercalate " " $
 151         showQPN qpn
 152       : map (uncurry showFlagValue) (M.toList flags)
 153      ++ map (\s -> showSBool s True) (S.toList stanzas)
 154
 155 -- | Options for goal qualification (used in 'qualifyDeps')
 156 --
 157 -- See also 'defaultQualifyOptions'
 158 data QualifyOptions = QO {
 159     -- | Do we have a version of base relying on another version of base?
 160     qoBaseShim :: Bool
 161
 162     -- Should dependencies of the setup script be treated as independent?
 163   , qoSetupIndependent :: Bool
 164   }
 165   deriving Show
 166
 167 -- | Apply built-in rules for package qualifiers
 168 --
 169 -- Although the behaviour of 'qualifyDeps' depends on the 'QualifyOptions',
 170 -- it is important that these 'QualifyOptions' are _static_. Qualification
 171 -- does NOT depend on flag assignment; in other words, it behaves the same no
 172 -- matter which choices the solver makes (modulo the global 'QualifyOptions');
 173 -- we rely on this in 'linkDeps' (see comment there).
 174 --
 175 -- NOTE: It's the _dependencies_ of a package that may or may not be independent
 176 -- from the package itself. Package flag choices must of course be consistent.
 177 qualifyDeps :: QualifyOptions -> QPN -> FlaggedDeps PN -> FlaggedDeps QPN
 178 qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
 179   where
 180     go :: FlaggedDeps PN -> FlaggedDeps QPN
 181     go = map go1
 182
 183     go1 :: FlaggedDep PN -> FlaggedDep QPN
 184     go1 (Flagged fn nfo t f) = Flagged (fmap (Q pp) fn) nfo (go t) (go f)
 185     go1 (Stanza  sn     t)   = Stanza  (fmap (Q pp) sn)     (go t)
 186     go1 (Simple dep comp)    = Simple (goLDep dep comp) comp
 187
 188     -- Suppose package B has a setup dependency on package A.
 189     -- This will be recorded as something like
 190     --
 191     -- > LDep (DependencyReason "B") (Dep (PkgComponent "A" (ExposedLib LMainLibName)) (Constrained AnyVersion))
 192     --
 193     -- Observe that when we qualify this dependency, we need to turn that
 194     -- @"A"@ into @"B-setup.A"@, but we should not apply that same qualifier
 195     -- to the DependencyReason.
 196     goLDep :: LDep PN -> Component -> LDep QPN
 197     goLDep (LDep dr dep) comp = LDep (fmap (Q pp) dr) (goD dep comp)
 198
 199     goD :: Dep PN -> Component -> Dep QPN
 200     goD (Ext  ext)    _    = Ext  ext
 201     goD (Lang lang)   _    = Lang lang
 202     goD (Pkg pkn vr)  _    = Pkg pkn vr
 203     goD (Dep dep@(PkgComponent qpn (ExposedExe _)) ci) _ =
 204         Dep (Q (PackagePath ns (QualExe pn qpn)) <$> dep) ci
 205     goD (Dep dep@(PkgComponent qpn (ExposedLib _)) ci) comp
 206       | qBase qpn   = Dep (Q (PackagePath ns (QualBase  pn)) <$> dep) ci
 207       | qSetup comp = Dep (Q (PackagePath ns (QualSetup pn)) <$> dep) ci
 208       | otherwise   = Dep (Q (PackagePath ns inheritedQ    ) <$> dep) ci
 209
 210     -- If P has a setup dependency on Q, and Q has a regular dependency on R, then
 211     -- we say that the 'Setup' qualifier is inherited: P has an (indirect) setup
 212     -- dependency on R. We do not do this for the base qualifier however.
 213     --
 214     -- The inherited qualifier is only used for regular dependencies; for setup
 215     -- and base dependencies we override the existing qualifier. See #3160 for
 216     -- a detailed discussion.
 217     inheritedQ :: Qualifier
 218     inheritedQ = case q of
 219                    QualSetup _  -> q
 220                    QualExe _ _  -> q
 221                    QualToplevel -> q
 222                    QualBase _   -> QualToplevel
 223
 224     -- Should we qualify this goal with the 'Base' package path?
 225     qBase :: PN -> Bool
 226     qBase dep = qoBaseShim && unPackageName dep == "base"
 227
 228     -- Should we qualify this goal with the 'Setup' package path?
 229     qSetup :: Component -> Bool
 230     qSetup comp = qoSetupIndependent && comp == ComponentSetup
 231
 232 -- | Remove qualifiers from set of dependencies
 233 --
 234 -- This is used during link validation: when we link package @Q.A@ to @Q'.A@,
 235 -- then all dependencies @Q.B@ need to be linked to @Q'.B@. In order to compute
 236 -- what to link these dependencies to, we need to requalify @Q.B@ to become
 237 -- @Q'.B@; we do this by first removing all qualifiers and then calling
 238 -- 'qualifyDeps' again.
 239 unqualifyDeps :: FlaggedDeps QPN -> FlaggedDeps PN
 240 unqualifyDeps = go
 241   where
 242     go :: FlaggedDeps QPN -> FlaggedDeps PN
 243     go = map go1
 244
 245     go1 :: FlaggedDep QPN -> FlaggedDep PN
 246     go1 (Flagged fn nfo t f) = Flagged (fmap unq fn) nfo (go t) (go f)
 247     go1 (Stanza  sn     t)   = Stanza  (fmap unq sn)     (go t)
 248     go1 (Simple dep comp)    = Simple (goLDep dep) comp
 249
 250     goLDep :: LDep QPN -> LDep PN
 251     goLDep (LDep dr dep) = LDep (fmap unq dr) (fmap unq dep)
 252
 253     unq :: QPN -> PN
 254     unq (Q _ pn) = pn
 255
 256 {-------------------------------------------------------------------------------
 257   Reverse dependency map
 258 -------------------------------------------------------------------------------}
 259
 260 -- | A map containing reverse dependencies between qualified
 261 -- package names.
 262 type RevDepMap = Map QPN [(Component, QPN)]
 263
 264 {-------------------------------------------------------------------------------
 265   Goals
 266 -------------------------------------------------------------------------------}
 267
 268 -- | A goal is just a solver variable paired with a reason.
 269 -- The reason is only used for tracing.
 270 data Goal qpn = Goal (Var qpn) (GoalReason qpn)
 271   deriving (Eq, Show, Functor)
 272
 273 -- | Reason why a goal is being added to a goal set.
 274 data GoalReason qpn =
 275     UserGoal                              -- introduced by a build target
 276   | DependencyGoal (DependencyReason qpn) -- introduced by a package
 277   deriving (Eq, Show, Functor)
 278
 279 type QGoalReason = GoalReason QPN
 280
 281 goalToVar :: Goal a -> Var a
 282 goalToVar (Goal v _) = v
 283
 284 -- | Compute a singleton conflict set from a 'Var'
 285 varToConflictSet :: Var QPN -> ConflictSet
 286 varToConflictSet = CS.singleton
 287
 288 -- | Convert a 'GoalReason' to a 'ConflictSet' that can be used when the goal
 289 -- leads to a conflict.
 290 goalReasonToConflictSet :: GoalReason QPN -> ConflictSet
 291 goalReasonToConflictSet UserGoal            = CS.empty
 292 goalReasonToConflictSet (DependencyGoal dr) = dependencyReasonToConflictSet dr
 293
 294 -- | Convert a 'GoalReason' to a 'ConflictSet' containing the reason that the
 295 -- conflict occurred, namely the conflict set variables caused a conflict by
 296 -- introducing the given package goal. See the documentation for 'GoalConflict'.
 297 --
 298 -- This function currently only specifies the reason for the conflict in the
 299 -- simple case where the 'GoalReason' does not involve any flags or stanzas.
 300 -- Otherwise, it falls back to calling 'goalReasonToConflictSet'.
 301 goalReasonToConflictSetWithConflict :: QPN -> GoalReason QPN -> ConflictSet
 302 goalReasonToConflictSetWithConflict goal (DependencyGoal (DependencyReason qpn flags stanzas))
 303   | M.null flags && S.null stanzas =
 304       CS.singletonWithConflict (P qpn) $ CS.GoalConflict goal
 305 goalReasonToConflictSetWithConflict _    gr = goalReasonToConflictSet gr
 306
 307 -- | This function returns the solver variables responsible for the dependency.
 308 -- It drops the values chosen for flag and stanza variables, which are only
 309 -- needed for log messages.
 310 dependencyReasonToConflictSet :: DependencyReason QPN -> ConflictSet
 311 dependencyReasonToConflictSet (DependencyReason qpn flags stanzas) =
 312     CS.fromList $ P qpn : flagVars ++ map stanzaToVar (S.toList stanzas)
 313   where
 314     -- Filter out any flags that introduced the dependency with both values.
 315     -- They don't need to be included in the conflict set, because changing the
 316     -- flag value can't remove the dependency.
 317     flagVars :: [Var QPN]
 318     flagVars = [F (FN qpn fn) | (fn, fv) <- M.toList flags, fv /= FlagBoth]
 319
 320     stanzaToVar :: Stanza -> Var QPN
 321     stanzaToVar = S . SN qpn
 322
 323 -- | Convert a 'DependencyReason' to a 'ConflictSet' specifying that the
 324 -- conflict occurred because the conflict set variables introduced a problematic
 325 -- version constraint. See the documentation for 'VersionConstraintConflict'.
 326 --
 327 -- This function currently only specifies the reason for the conflict in the
 328 -- simple case where the 'DependencyReason' does not involve any flags or
 329 -- stanzas. Otherwise, it falls back to calling 'dependencyReasonToConflictSet'.
 330 dependencyReasonToConflictSetWithVersionConstraintConflict :: QPN
 331                                                            -> Ver
 332                                                            -> DependencyReason QPN
 333                                                            -> ConflictSet
 334 dependencyReasonToConflictSetWithVersionConstraintConflict
 335     dependency excludedVersion dr@(DependencyReason qpn flags stanzas)
 336   | M.null flags && S.null stanzas =
 337     CS.singletonWithConflict (P qpn) $
 338     CS.VersionConstraintConflict dependency excludedVersion
 339   | otherwise = dependencyReasonToConflictSet dr
 340
 341 -- | Convert a 'DependencyReason' to a 'ConflictSet' specifying that the
 342 -- conflict occurred because the conflict set variables introduced a version of
 343 -- a package that was excluded by a version constraint. See the documentation
 344 -- for 'VersionConflict'.
 345 --
 346 -- This function currently only specifies the reason for the conflict in the
 347 -- simple case where the 'DependencyReason' does not involve any flags or
 348 -- stanzas. Otherwise, it falls back to calling 'dependencyReasonToConflictSet'.
 349 dependencyReasonToConflictSetWithVersionConflict :: QPN
 350                                                  -> CS.OrderedVersionRange
 351                                                  -> DependencyReason QPN
 352                                                  -> ConflictSet
 353 dependencyReasonToConflictSetWithVersionConflict
 354     pkgWithVersionConstraint constraint dr@(DependencyReason qpn flags stanzas)
 355   | M.null flags && S.null stanzas =
 356     CS.singletonWithConflict (P qpn) $
 357     CS.VersionConflict pkgWithVersionConstraint constraint
 358   | otherwise = dependencyReasonToConflictSet dr