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

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