never executed always true always false
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 = CD.components (solverPkgLibDeps spkg)
130 <> CD.components (solverPkgExeDeps spkg)
131
132 -- | Build an installation plan from a valid set of resolved packages.
133 --
134 new :: IndependentGoals
135 -> SolverPlanIndex
136 -> Either [SolverPlanProblem] SolverInstallPlan
137 new indepGoals index =
138 case problems indepGoals index of
139 [] -> Right (SolverInstallPlan index indepGoals)
140 probs -> Left probs
141
142 toList :: SolverInstallPlan -> [SolverPlanPackage]
143 toList = Foldable.toList . planIndex
144
145 toMap :: SolverInstallPlan -> Map SolverId SolverPlanPackage
146 toMap = Graph.toMap . planIndex
147
148 -- | Remove packages from the install plan. This will result in an
149 -- error if there are remaining packages that depend on any matching
150 -- package. This is primarily useful for obtaining an install plan for
151 -- the dependencies of a package or set of packages without actually
152 -- installing the package itself, as when doing development.
153 --
154 remove :: (SolverPlanPackage -> Bool)
155 -> SolverInstallPlan
156 -> Either [SolverPlanProblem]
157 (SolverInstallPlan)
158 remove shouldRemove plan =
159 new (planIndepGoals plan) newIndex
160 where
161 newIndex = Graph.fromDistinctList $
162 filter (not . shouldRemove) (toList plan)
163
164 -- ------------------------------------------------------------
165 -- * Checking validity of plans
166 -- ------------------------------------------------------------
167
168 -- | A valid installation plan is a set of packages that is 'acyclic',
169 -- 'closed' and 'consistent'. Also, every 'ConfiguredPackage' in the
170 -- plan has to have a valid configuration (see 'configuredPackageValid').
171 --
172 -- * if the result is @False@ use 'problems' to get a detailed list.
173 --
174 valid :: IndependentGoals
175 -> SolverPlanIndex
176 -> Bool
177 valid indepGoals index =
178 null $ problems indepGoals index
179
180 data SolverPlanProblem =
181 PackageMissingDeps SolverPlanPackage
182 [PackageIdentifier]
183 | PackageCycle [SolverPlanPackage]
184 | PackageInconsistency PackageName [(PackageIdentifier, Version)]
185 | PackageStateInvalid SolverPlanPackage SolverPlanPackage
186
187 showPlanProblem :: SolverPlanProblem -> String
188 showPlanProblem (PackageMissingDeps pkg missingDeps) =
189 "Package " ++ prettyShow (packageId pkg)
190 ++ " depends on the following packages which are missing from the plan: "
191 ++ intercalate ", " (map prettyShow missingDeps)
192
193 showPlanProblem (PackageCycle cycleGroup) =
194 "The following packages are involved in a dependency cycle "
195 ++ intercalate ", " (map (prettyShow.packageId) cycleGroup)
196
197 showPlanProblem (PackageInconsistency name inconsistencies) =
198 "Package " ++ prettyShow name
199 ++ " is required by several packages,"
200 ++ " but they require inconsistent versions:\n"
201 ++ unlines [ " package " ++ prettyShow pkg ++ " requires "
202 ++ prettyShow (PackageIdentifier name ver)
203 | (pkg, ver) <- inconsistencies ]
204
205 showPlanProblem (PackageStateInvalid pkg pkg') =
206 "Package " ++ prettyShow (packageId pkg)
207 ++ " is in the " ++ showPlanState pkg
208 ++ " state but it depends on package " ++ prettyShow (packageId pkg')
209 ++ " which is in the " ++ showPlanState pkg'
210 ++ " state"
211 where
212 showPlanState (PreExisting _) = "pre-existing"
213 showPlanState (Configured _) = "configured"
214
215 -- | For an invalid plan, produce a detailed list of problems as human readable
216 -- error messages. This is mainly intended for debugging purposes.
217 -- Use 'showPlanProblem' for a human readable explanation.
218 --
219 problems :: IndependentGoals
220 -> SolverPlanIndex
221 -> [SolverPlanProblem]
222 problems indepGoals index =
223
224 [ PackageMissingDeps pkg
225 (mapMaybe
226 (fmap packageId . flip Graph.lookup index)
227 missingDeps)
228 | (pkg, missingDeps) <- Graph.broken index ]
229
230 ++ [ PackageCycle cycleGroup
231 | cycleGroup <- Graph.cycles index ]
232
233 ++ [ PackageInconsistency name inconsistencies
234 | (name, inconsistencies) <-
235 dependencyInconsistencies indepGoals index ]
236
237 ++ [ PackageStateInvalid pkg pkg'
238 | pkg <- Foldable.toList index
239 , Just pkg' <- map (flip Graph.lookup index)
240 (nodeNeighbors pkg)
241 , not (stateDependencyRelation pkg pkg') ]
242
243
244 -- | Compute all roots of the install plan, and verify that the transitive
245 -- plans from those roots are all consistent.
246 --
247 -- NOTE: This does not check for dependency cycles. Moreover, dependency cycles
248 -- may be absent from the subplans even if the larger plan contains a dependency
249 -- cycle. Such cycles may or may not be an issue; either way, we don't check
250 -- for them here.
251 dependencyInconsistencies :: IndependentGoals
252 -> SolverPlanIndex
253 -> [(PackageName, [(PackageIdentifier, Version)])]
254 dependencyInconsistencies indepGoals index =
255 concatMap dependencyInconsistencies' subplans
256 where
257 subplans :: [SolverPlanIndex]
258 subplans = -- Not Graph.closure!!
259 map (nonSetupClosure index)
260 (rootSets indepGoals index)
261
262 -- NB: When we check for inconsistencies, packages from the setup
263 -- scripts don't count as part of the closure (this way, we
264 -- can build, e.g., Cabal-1.24.1 even if its setup script is
265 -- built with Cabal-1.24.0).
266 --
267 -- This is a best effort function that swallows any non-existent
268 -- SolverIds.
269 nonSetupClosure :: SolverPlanIndex
270 -> [SolverId]
271 -> SolverPlanIndex
272 nonSetupClosure index pkgids0 = closure Graph.empty pkgids0
273 where
274 closure completed [] = completed
275 closure completed (pkgid:pkgids) =
276 case Graph.lookup pkgid index of
277 Nothing -> closure completed pkgids
278 Just pkg ->
279 case Graph.lookup (nodeKey pkg) completed of
280 Just _ -> closure completed pkgids
281 Nothing -> closure completed' pkgids'
282 where completed' = Graph.insert pkg completed
283 pkgids' = CD.nonSetupDeps (resolverPackageLibDeps pkg) ++ pkgids
284
285 -- | Compute the root sets of a plan
286 --
287 -- A root set is a set of packages whose dependency closure must be consistent.
288 -- This is the set of all top-level library roots (taken together normally, or
289 -- as singletons sets if we are considering them as independent goals), along
290 -- with all setup dependencies of all packages.
291 rootSets :: IndependentGoals -> SolverPlanIndex -> [[SolverId]]
292 rootSets (IndependentGoals indepGoals) index =
293 if indepGoals then map (:[]) libRoots else [libRoots]
294 ++ setupRoots index
295 where
296 libRoots = libraryRoots index
297
298 -- | Compute the library roots of a plan
299 --
300 -- The library roots are the set of packages with no reverse dependencies
301 -- (no reverse library dependencies but also no reverse setup dependencies).
302 libraryRoots :: SolverPlanIndex -> [SolverId]
303 libraryRoots index =
304 map (nodeKey . toPkgId) roots
305 where
306 (graph, toPkgId, _) = Graph.toGraph index
307 indegree = OldGraph.indegree graph
308 roots = filter isRoot (OldGraph.vertices graph)
309 isRoot v = indegree ! v == 0
310
311 -- | The setup dependencies of each package in the plan
312 setupRoots :: SolverPlanIndex -> [[SolverId]]
313 setupRoots = filter (not . null)
314 . map (CD.setupDeps . resolverPackageLibDeps)
315 . Foldable.toList
316
317 -- | Given a package index where we assume we want to use all the packages
318 -- (use 'dependencyClosure' if you need to get such a index subset) find out
319 -- if the dependencies within it use consistent versions of each package.
320 -- Return all cases where multiple packages depend on different versions of
321 -- some other package.
322 --
323 -- Each element in the result is a package name along with the packages that
324 -- depend on it and the versions they require. These are guaranteed to be
325 -- distinct.
326 --
327 dependencyInconsistencies' :: SolverPlanIndex
328 -> [(PackageName, [(PackageIdentifier, Version)])]
329 dependencyInconsistencies' index =
330 [ (name, [ (pid, packageVersion dep) | (dep,pids) <- uses, pid <- pids])
331 | (name, ipid_map) <- Map.toList inverseIndex
332 , let uses = Map.elems ipid_map
333 , reallyIsInconsistent (map fst uses)
334 ]
335 where
336 -- For each package name (of a dependency, somewhere)
337 -- and each installed ID of that package
338 -- the associated package instance
339 -- and a list of reverse dependencies (as source IDs)
340 inverseIndex :: Map PackageName (Map SolverId (SolverPlanPackage, [PackageId]))
341 inverseIndex = Map.fromListWith (Map.unionWith (\(a,b) (_,b') -> (a,b++b')))
342 [ (packageName dep, Map.fromList [(sid,(dep,[packageId pkg]))])
343 | -- For each package @pkg@
344 pkg <- Foldable.toList index
345 -- Find out which @sid@ @pkg@ depends on
346 , sid <- CD.nonSetupDeps (resolverPackageLibDeps pkg)
347 -- And look up those @sid@ (i.e., @sid@ is the ID of @dep@)
348 , Just dep <- [Graph.lookup sid index]
349 ]
350
351 -- If, in a single install plan, we depend on more than one version of a
352 -- package, then this is ONLY okay in the (rather special) case that we
353 -- depend on precisely two versions of that package, and one of them
354 -- depends on the other. This is necessary for example for the base where
355 -- we have base-3 depending on base-4.
356 reallyIsInconsistent :: [SolverPlanPackage] -> Bool
357 reallyIsInconsistent [] = False
358 reallyIsInconsistent [_p] = False
359 reallyIsInconsistent [p1, p2] =
360 let pid1 = nodeKey p1
361 pid2 = nodeKey p2
362 in pid1 `notElem` CD.nonSetupDeps (resolverPackageLibDeps p2)
363 && pid2 `notElem` CD.nonSetupDeps (resolverPackageLibDeps p1)
364 reallyIsInconsistent _ = True
365
366
367 -- | The graph of packages (nodes) and dependencies (edges) must be acyclic.
368 --
369 -- * if the result is @False@ use 'PackageIndex.dependencyCycles' to find out
370 -- which packages are involved in dependency cycles.
371 --
372 acyclic :: SolverPlanIndex -> Bool
373 acyclic = null . Graph.cycles
374
375 -- | An installation plan is closed if for every package in the set, all of
376 -- its dependencies are also in the set. That is, the set is closed under the
377 -- dependency relation.
378 --
379 -- * if the result is @False@ use 'PackageIndex.brokenPackages' to find out
380 -- which packages depend on packages not in the index.
381 --
382 closed :: SolverPlanIndex -> Bool
383 closed = null . Graph.broken
384
385 -- | An installation plan is consistent if all dependencies that target a
386 -- single package name, target the same version.
387 --
388 -- This is slightly subtle. It is not the same as requiring that there be at
389 -- most one version of any package in the set. It only requires that of
390 -- packages which have more than one other package depending on them. We could
391 -- actually make the condition even more precise and say that different
392 -- versions are OK so long as they are not both in the transitive closure of
393 -- any other package (or equivalently that their inverse closures do not
394 -- intersect). The point is we do not want to have any packages depending
395 -- directly or indirectly on two different versions of the same package. The
396 -- current definition is just a safe approximation of that.
397 --
398 -- * if the result is @False@ use 'PackageIndex.dependencyInconsistencies' to
399 -- find out which packages are.
400 --
401 consistent :: SolverPlanIndex -> Bool
402 consistent = null . dependencyInconsistencies (IndependentGoals False)
403
404 -- | The states of packages have that depend on each other must respect
405 -- this relation. That is for very case where package @a@ depends on
406 -- package @b@ we require that @dependencyStatesOk a b = True@.
407 --
408 stateDependencyRelation :: SolverPlanPackage
409 -> SolverPlanPackage
410 -> Bool
411 stateDependencyRelation PreExisting{} PreExisting{} = True
412
413 stateDependencyRelation (Configured _) PreExisting{} = True
414 stateDependencyRelation (Configured _) (Configured _) = True
415
416 stateDependencyRelation _ _ = False
417
418
419 -- | Compute the dependency closure of a package in a install plan
420 --
421 dependencyClosure :: SolverInstallPlan
422 -> [SolverId]
423 -> [SolverPlanPackage]
424 dependencyClosure plan = fromMaybe [] . Graph.closure (planIndex plan)
425
426
427 reverseDependencyClosure :: SolverInstallPlan
428 -> [SolverId]
429 -> [SolverPlanPackage]
430 reverseDependencyClosure plan = fromMaybe [] . Graph.revClosure (planIndex plan)
431
432
433 topologicalOrder :: SolverInstallPlan
434 -> [SolverPlanPackage]
435 topologicalOrder plan = Graph.topSort (planIndex plan)
436
437
438 reverseTopologicalOrder :: SolverInstallPlan
439 -> [SolverPlanPackage]
440 reverseTopologicalOrder plan = Graph.revTopSort (planIndex plan)