cabal-install/src/Distribution/Client/SolverInstallPlan.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3 {-# LANGUAGE TypeFamilies #-}
   4
   5 -----------------------------------------------------------------------------
   6
   7 -----------------------------------------------------------------------------
   8
   9 -- |
  10 -- Module      :  Distribution.Client.SolverInstallPlan
  11 -- Copyright   :  (c) Duncan Coutts 2008
  12 -- License     :  BSD-like
  13 --
  14 -- Maintainer  :  duncan@community.haskell.org
  15 -- Stability   :  provisional
  16 -- Portability :  portable
  17 --
  18 -- The 'SolverInstallPlan' is the graph of packages produced by the
  19 -- dependency solver, and specifies at the package-granularity what
  20 -- things are going to be installed.  To put it another way: the
  21 -- dependency solver produces a 'SolverInstallPlan', which is then
  22 -- consumed by various other parts of Cabal.
  23 module Distribution.Client.SolverInstallPlan
  24   ( SolverInstallPlan (..)
  25   , SolverPlanPackage
  26   , ResolverPackage (..)
  27
  28     -- * Operations on 'SolverInstallPlan's
  29   , new
  30   , toList
  31   , toMap
  32   , remove
  33   , showPlanIndex
  34   , showInstallPlan
  35
  36     -- * Checking validity of plans
  37   , valid
  38   , closed
  39   , consistent
  40   , acyclic
  41
  42     -- ** Details on invalid plans
  43   , SolverPlanProblem (..)
  44   , showPlanProblem
  45   , problems
  46
  47     -- ** Querying the install plan
  48   , dependencyClosure
  49   , reverseDependencyClosure
  50   , topologicalOrder
  51   , reverseTopologicalOrder
  52   ) where
  53
  54 import Distribution.Client.Compat.Prelude hiding (toList)
  55 import Prelude ()
  56
  57 import Distribution.Package
  58   ( HasUnitId (..)
  59   , Package (..)
  60   , PackageId
  61   , PackageIdentifier (..)
  62   , PackageName
  63   , packageName
  64   , packageVersion
  65   )
  66 import qualified Distribution.Solver.Types.ComponentDeps as CD
  67 import Distribution.Types.Flag (nullFlagAssignment)
  68
  69 import Distribution.Client.Types
  70   ( UnresolvedPkgLoc
  71   )
  72 import Distribution.Version
  73   ( Version
  74   )
  75
  76 import Distribution.Solver.Types.ResolverPackage
  77 import Distribution.Solver.Types.Settings
  78 import Distribution.Solver.Types.SolverId
  79 import Distribution.Solver.Types.SolverPackage
  80
  81 import Data.Array ((!))
  82 import qualified Data.Foldable as Foldable
  83 import qualified Data.Graph as OldGraph
  84 import qualified Data.Map as Map
  85 import Distribution.Compat.Graph (Graph, IsNode (..))
  86 import qualified Distribution.Compat.Graph as Graph
  87
  88 type SolverPlanPackage = ResolverPackage UnresolvedPkgLoc
  89
  90 type SolverPlanIndex = Graph SolverPlanPackage
  91
  92 data SolverInstallPlan = SolverInstallPlan
  93   { planIndex :: !SolverPlanIndex
  94   , planIndepGoals :: !IndependentGoals
  95   }
  96   deriving (Typeable, Generic)
  97
  98 {-
  99 -- | Much like 'planPkgIdOf', but mapping back to full packages.
 100 planPkgOf :: SolverInstallPlan
 101           -> Graph.Vertex
 102           -> SolverPlanPackage
 103 planPkgOf plan v =
 104     case Graph.lookupKey (planIndex plan)
 105                          (planPkgIdOf plan v) of
 106       Just pkg -> pkg
 107       Nothing  -> error "InstallPlan: internal error: planPkgOf lookup failed"
 108 -}
 109
 110 instance Binary SolverInstallPlan
 111 instance Structured SolverInstallPlan
 112
 113 showPlanIndex :: [SolverPlanPackage] -> String
 114 showPlanIndex = intercalate "\n" . map showPlanPackage
 115
 116 showInstallPlan :: SolverInstallPlan -> String
 117 showInstallPlan = showPlanIndex . toList
 118
 119 showPlanPackage :: SolverPlanPackage -> String
 120 showPlanPackage (PreExisting ipkg) =
 121   "PreExisting "
 122     ++ prettyShow (packageId ipkg)
 123     ++ " ("
 124     ++ prettyShow (installedUnitId ipkg)
 125     ++ ")"
 126 showPlanPackage (Configured spkg) =
 127   "Configured " ++ prettyShow (packageId spkg) ++ flags ++ comps
 128   where
 129     flags
 130       | nullFlagAssignment fa = ""
 131       | otherwise = " " ++ prettyShow (solverPkgFlags spkg)
 132       where
 133         fa = solverPkgFlags spkg
 134
 135     comps
 136       | null deps = ""
 137       | otherwise = " " ++ unwords (map prettyShow $ Foldable.toList deps)
 138       where
 139         deps :: Set CD.Component
 140         deps =
 141           CD.components (solverPkgLibDeps spkg)
 142             <> CD.components (solverPkgExeDeps spkg)
 143
 144 -- | Build an installation plan from a valid set of resolved packages.
 145 new
 146   :: IndependentGoals
 147   -> SolverPlanIndex
 148   -> Either [SolverPlanProblem] SolverInstallPlan
 149 new indepGoals index =
 150   case problems indepGoals index of
 151     [] -> Right (SolverInstallPlan index indepGoals)
 152     probs -> Left probs
 153
 154 toList :: SolverInstallPlan -> [SolverPlanPackage]
 155 toList = Foldable.toList . planIndex
 156
 157 toMap :: SolverInstallPlan -> Map SolverId SolverPlanPackage
 158 toMap = Graph.toMap . planIndex
 159
 160 -- | Remove packages from the install plan. This will result in an
 161 -- error if there are remaining packages that depend on any matching
 162 -- package. This is primarily useful for obtaining an install plan for
 163 -- the dependencies of a package or set of packages without actually
 164 -- installing the package itself, as when doing development.
 165 remove
 166   :: (SolverPlanPackage -> Bool)
 167   -> SolverInstallPlan
 168   -> Either
 169       [SolverPlanProblem]
 170       (SolverInstallPlan)
 171 remove shouldRemove plan =
 172   new (planIndepGoals plan) newIndex
 173   where
 174     newIndex =
 175       Graph.fromDistinctList $
 176         filter (not . shouldRemove) (toList plan)
 177
 178 -- ------------------------------------------------------------
 179
 180 -- * Checking validity of plans
 181
 182 -- ------------------------------------------------------------
 183
 184 -- | A valid installation plan is a set of packages that is 'acyclic',
 185 -- 'closed' and 'consistent'. Also, every 'ConfiguredPackage' in the
 186 -- plan has to have a valid configuration (see 'configuredPackageValid').
 187 --
 188 -- * if the result is @False@ use 'problems' to get a detailed list.
 189 valid
 190   :: IndependentGoals
 191   -> SolverPlanIndex
 192   -> Bool
 193 valid indepGoals index =
 194   null $ problems indepGoals index
 195
 196 data SolverPlanProblem
 197   = PackageMissingDeps
 198       SolverPlanPackage
 199       [PackageIdentifier]
 200   | PackageCycle [SolverPlanPackage]
 201   | PackageInconsistency PackageName [(PackageIdentifier, Version)]
 202   | PackageStateInvalid SolverPlanPackage SolverPlanPackage
 203
 204 showPlanProblem :: SolverPlanProblem -> String
 205 showPlanProblem (PackageMissingDeps pkg missingDeps) =
 206   "Package "
 207     ++ prettyShow (packageId pkg)
 208     ++ " depends on the following packages which are missing from the plan: "
 209     ++ intercalate ", " (map prettyShow missingDeps)
 210 showPlanProblem (PackageCycle cycleGroup) =
 211   "The following packages are involved in a dependency cycle "
 212     ++ intercalate ", " (map (prettyShow . packageId) cycleGroup)
 213 showPlanProblem (PackageInconsistency name inconsistencies) =
 214   "Package "
 215     ++ prettyShow name
 216     ++ " is required by several packages,"
 217     ++ " but they require inconsistent versions:\n"
 218     ++ unlines
 219       [ "  package "
 220         ++ prettyShow pkg
 221         ++ " requires "
 222         ++ prettyShow (PackageIdentifier name ver)
 223       | (pkg, ver) <- inconsistencies
 224       ]
 225 showPlanProblem (PackageStateInvalid pkg pkg') =
 226   "Package "
 227     ++ prettyShow (packageId pkg)
 228     ++ " is in the "
 229     ++ showPlanState pkg
 230     ++ " state but it depends on package "
 231     ++ prettyShow (packageId pkg')
 232     ++ " which is in the "
 233     ++ showPlanState pkg'
 234     ++ " state"
 235   where
 236     showPlanState (PreExisting _) = "pre-existing"
 237     showPlanState (Configured _) = "configured"
 238
 239 -- | For an invalid plan, produce a detailed list of problems as human readable
 240 -- error messages. This is mainly intended for debugging purposes.
 241 -- Use 'showPlanProblem' for a human readable explanation.
 242 problems
 243   :: IndependentGoals
 244   -> SolverPlanIndex
 245   -> [SolverPlanProblem]
 246 problems indepGoals index =
 247   [ PackageMissingDeps
 248     pkg
 249     ( mapMaybe
 250         (fmap packageId . flip Graph.lookup index)
 251         missingDeps
 252     )
 253   | (pkg, missingDeps) <- Graph.broken index
 254   ]
 255     ++ [ PackageCycle cycleGroup
 256        | cycleGroup <- Graph.cycles index
 257        ]
 258     ++ [ PackageInconsistency name inconsistencies
 259        | (name, inconsistencies) <-
 260           dependencyInconsistencies indepGoals index
 261        ]
 262     ++ [ PackageStateInvalid pkg pkg'
 263        | pkg <- Foldable.toList index
 264        , Just pkg' <-
 265           map
 266             (flip Graph.lookup index)
 267             (nodeNeighbors pkg)
 268        , not (stateDependencyRelation pkg pkg')
 269        ]
 270
 271 -- | Compute all roots of the install plan, and verify that the transitive
 272 -- plans from those roots are all consistent.
 273 --
 274 -- NOTE: This does not check for dependency cycles. Moreover, dependency cycles
 275 -- may be absent from the subplans even if the larger plan contains a dependency
 276 -- cycle. Such cycles may or may not be an issue; either way, we don't check
 277 -- for them here.
 278 dependencyInconsistencies
 279   :: IndependentGoals
 280   -> SolverPlanIndex
 281   -> [(PackageName, [(PackageIdentifier, Version)])]
 282 dependencyInconsistencies indepGoals index =
 283   concatMap dependencyInconsistencies' subplans
 284   where
 285     subplans :: [SolverPlanIndex]
 286     subplans =
 287       -- Not Graph.closure!!
 288       map
 289         (nonSetupClosure index)
 290         (rootSets indepGoals index)
 291
 292 -- NB: When we check for inconsistencies, packages from the setup
 293 -- scripts don't count as part of the closure (this way, we
 294 -- can build, e.g., Cabal-1.24.1 even if its setup script is
 295 -- built with Cabal-1.24.0).
 296 --
 297 -- This is a best effort function that swallows any non-existent
 298 -- SolverIds.
 299 nonSetupClosure
 300   :: SolverPlanIndex
 301   -> [SolverId]
 302   -> SolverPlanIndex
 303 nonSetupClosure index pkgids0 = closure Graph.empty pkgids0
 304   where
 305     closure :: Graph SolverPlanPackage -> [SolverId] -> SolverPlanIndex
 306     closure completed [] = completed
 307     closure completed (pkgid : pkgids) =
 308       case Graph.lookup pkgid index of
 309         Nothing -> closure completed pkgids
 310         Just pkg ->
 311           case Graph.lookup (nodeKey pkg) completed of
 312             Just _ -> closure completed pkgids
 313             Nothing -> closure completed' pkgids'
 314               where
 315                 completed' = Graph.insert pkg completed
 316                 pkgids' = CD.nonSetupDeps (resolverPackageLibDeps pkg) ++ pkgids
 317
 318 -- | Compute the root sets of a plan
 319 --
 320 -- A root set is a set of packages whose dependency closure must be consistent.
 321 -- This is the set of all top-level library roots (taken together normally, or
 322 -- as singletons sets if we are considering them as independent goals), along
 323 -- with all setup dependencies of all packages.
 324 rootSets :: IndependentGoals -> SolverPlanIndex -> [[SolverId]]
 325 rootSets (IndependentGoals indepGoals) index =
 326   if indepGoals
 327     then map (: []) libRoots
 328     else
 329       [libRoots]
 330         ++ setupRoots index
 331   where
 332     libRoots :: [SolverId]
 333     libRoots = libraryRoots index
 334
 335 -- | Compute the library roots of a plan
 336 --
 337 -- The library roots are the set of packages with no reverse dependencies
 338 -- (no reverse library dependencies but also no reverse setup dependencies).
 339 libraryRoots :: SolverPlanIndex -> [SolverId]
 340 libraryRoots index =
 341   map (nodeKey . toPkgId) roots
 342   where
 343     (graph, toPkgId, _) = Graph.toGraph index
 344     indegree = OldGraph.indegree graph
 345     roots = filter isRoot (OldGraph.vertices graph)
 346     isRoot v = indegree ! v == 0
 347
 348 -- | The setup dependencies of each package in the plan
 349 setupRoots :: SolverPlanIndex -> [[SolverId]]
 350 setupRoots =
 351   filter (not . null)
 352     . map (CD.setupDeps . resolverPackageLibDeps)
 353     . Foldable.toList
 354
 355 -- | Given a package index where we assume we want to use all the packages
 356 -- (use 'dependencyClosure' if you need to get such a index subset) find out
 357 -- if the dependencies within it use consistent versions of each package.
 358 -- Return all cases where multiple packages depend on different versions of
 359 -- some other package.
 360 --
 361 -- Each element in the result is a package name along with the packages that
 362 -- depend on it and the versions they require. These are guaranteed to be
 363 -- distinct.
 364 dependencyInconsistencies'
 365   :: SolverPlanIndex
 366   -> [(PackageName, [(PackageIdentifier, Version)])]
 367 dependencyInconsistencies' index =
 368   [ (name, [(pid, packageVersion dep) | (dep, pids) <- uses, pid <- pids])
 369   | (name, ipid_map) <- Map.toList inverseIndex
 370   , let uses = Map.elems ipid_map
 371   , reallyIsInconsistent (map fst uses)
 372   ]
 373   where
 374     -- For each package name (of a dependency, somewhere)
 375     --   and each installed ID of that package
 376     --     the associated package instance
 377     --     and a list of reverse dependencies (as source IDs)
 378     inverseIndex :: Map PackageName (Map SolverId (SolverPlanPackage, [PackageId]))
 379     inverseIndex =
 380       Map.fromListWith
 381         (Map.unionWith (\(a, b) (_, b') -> (a, b ++ b')))
 382         [ (packageName dep, Map.fromList [(sid, (dep, [packageId pkg]))])
 383         | -- For each package @pkg@
 384         pkg <- Foldable.toList index
 385         , -- Find out which @sid@ @pkg@ depends on
 386         sid <- CD.nonSetupDeps (resolverPackageLibDeps pkg)
 387         , -- And look up those @sid@ (i.e., @sid@ is the ID of @dep@)
 388         Just dep <- [Graph.lookup sid index]
 389         ]
 390
 391     -- If, in a single install plan, we depend on more than one version of a
 392     -- package, then this is ONLY okay in the (rather special) case that we
 393     -- depend on precisely two versions of that package, and one of them
 394     -- depends on the other. This is necessary for example for the base where
 395     -- we have base-3 depending on base-4.
 396     reallyIsInconsistent :: [SolverPlanPackage] -> Bool
 397     reallyIsInconsistent [] = False
 398     reallyIsInconsistent [_p] = False
 399     reallyIsInconsistent [p1, p2] =
 400       let pid1 = nodeKey p1
 401           pid2 = nodeKey p2
 402        in pid1 `notElem` CD.nonSetupDeps (resolverPackageLibDeps p2)
 403             && pid2 `notElem` CD.nonSetupDeps (resolverPackageLibDeps p1)
 404     reallyIsInconsistent _ = True
 405
 406 -- | The graph of packages (nodes) and dependencies (edges) must be acyclic.
 407 --
 408 -- * if the result is @False@ use 'PackageIndex.dependencyCycles' to find out
 409 --   which packages are involved in dependency cycles.
 410 acyclic :: SolverPlanIndex -> Bool
 411 acyclic = null . Graph.cycles
 412
 413 -- | An installation plan is closed if for every package in the set, all of
 414 -- its dependencies are also in the set. That is, the set is closed under the
 415 -- dependency relation.
 416 --
 417 -- * if the result is @False@ use 'PackageIndex.brokenPackages' to find out
 418 --   which packages depend on packages not in the index.
 419 closed :: SolverPlanIndex -> Bool
 420 closed = null . Graph.broken
 421
 422 -- | An installation plan is consistent if all dependencies that target a
 423 -- single package name, target the same version.
 424 --
 425 -- This is slightly subtle. It is not the same as requiring that there be at
 426 -- most one version of any package in the set. It only requires that of
 427 -- packages which have more than one other package depending on them. We could
 428 -- actually make the condition even more precise and say that different
 429 -- versions are OK so long as they are not both in the transitive closure of
 430 -- any other package (or equivalently that their inverse closures do not
 431 -- intersect). The point is we do not want to have any packages depending
 432 -- directly or indirectly on two different versions of the same package. The
 433 -- current definition is just a safe approximation of that.
 434 --
 435 -- * if the result is @False@ use 'PackageIndex.dependencyInconsistencies' to
 436 --   find out which packages are.
 437 consistent :: SolverPlanIndex -> Bool
 438 consistent = null . dependencyInconsistencies (IndependentGoals False)
 439
 440 -- | The states of packages have that depend on each other must respect
 441 -- this relation. That is for very case where package @a@ depends on
 442 -- package @b@ we require that @dependencyStatesOk a b = True@.
 443 stateDependencyRelation
 444   :: SolverPlanPackage
 445   -> SolverPlanPackage
 446   -> Bool
 447 stateDependencyRelation PreExisting{} PreExisting{} = True
 448 stateDependencyRelation (Configured _) PreExisting{} = True
 449 stateDependencyRelation (Configured _) (Configured _) = True
 450 stateDependencyRelation _ _ = False
 451
 452 -- | Compute the dependency closure of a package in a install plan
 453 dependencyClosure
 454   :: SolverInstallPlan
 455   -> [SolverId]
 456   -> [SolverPlanPackage]
 457 dependencyClosure plan = fromMaybe [] . Graph.closure (planIndex plan)
 458
 459 reverseDependencyClosure
 460   :: SolverInstallPlan
 461   -> [SolverId]
 462   -> [SolverPlanPackage]
 463 reverseDependencyClosure plan = fromMaybe [] . Graph.revClosure (planIndex plan)
 464
 465 topologicalOrder
 466   :: SolverInstallPlan
 467   -> [SolverPlanPackage]
 468 topologicalOrder plan = Graph.topSort (planIndex plan)
 469
 470 reverseTopologicalOrder
 471   :: SolverInstallPlan
 472   -> [SolverPlanPackage]
 473 reverseTopologicalOrder plan = Graph.revTopSort (planIndex plan)