{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.SolverInstallPlan
-- Copyright   :  (c) Duncan Coutts 2008
-- License     :  BSD-like
--
-- Maintainer  :  duncan@community.haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- The 'SolverInstallPlan' is the graph of packages produced by the
-- dependency solver, and specifies at the package-granularity what
-- things are going to be installed.  To put it another way: the
-- dependency solver produces a 'SolverInstallPlan', which is then
-- consumed by various other parts of Cabal.
--
-----------------------------------------------------------------------------
module Distribution.Client.SolverInstallPlan(
  SolverInstallPlan(..),
  SolverPlanPackage,
  ResolverPackage(..),

  -- * Operations on 'SolverInstallPlan's
  new,
  toList,
  toMap,

  remove,

  showPlanIndex,
  showInstallPlan,

  -- * Checking validity of plans
  valid,
  closed,
  consistent,
  acyclic,

  -- ** Details on invalid plans
  SolverPlanProblem(..),
  showPlanProblem,
  problems,

  -- ** Querying the install plan
  dependencyClosure,
  reverseDependencyClosure,
  topologicalOrder,
  reverseTopologicalOrder,
) where

import Distribution.Client.Compat.Prelude hiding (toList)
import Prelude ()

import Distribution.Package
         ( PackageIdentifier(..), Package(..), PackageName
         , HasUnitId(..), PackageId, packageVersion, packageName )
import Distribution.Types.Flag (nullFlagAssignment)
import qualified Distribution.Solver.Types.ComponentDeps as CD

import Distribution.Client.Types
         ( UnresolvedPkgLoc )
import Distribution.Version
         ( Version )

import           Distribution.Solver.Types.Settings
import           Distribution.Solver.Types.ResolverPackage
import           Distribution.Solver.Types.SolverId
import           Distribution.Solver.Types.SolverPackage

import Distribution.Compat.Graph (Graph, IsNode(..))
import qualified Data.Foldable as Foldable
import qualified Data.Graph as OldGraph
import qualified Distribution.Compat.Graph as Graph
import qualified Data.Map as Map
import Data.Array ((!))

type SolverPlanPackage = ResolverPackage UnresolvedPkgLoc

type SolverPlanIndex = Graph SolverPlanPackage

data SolverInstallPlan = SolverInstallPlan {
    SolverInstallPlan -> SolverPlanIndex
planIndex      :: !SolverPlanIndex,
    SolverInstallPlan -> IndependentGoals
planIndepGoals :: !IndependentGoals
  }
  deriving (Typeable, forall x. Rep SolverInstallPlan x -> SolverInstallPlan
forall x. SolverInstallPlan -> Rep SolverInstallPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SolverInstallPlan x -> SolverInstallPlan
$cfrom :: forall x. SolverInstallPlan -> Rep SolverInstallPlan x
Generic)

{-
-- | Much like 'planPkgIdOf', but mapping back to full packages.
planPkgOf :: SolverInstallPlan
          -> Graph.Vertex
          -> SolverPlanPackage
planPkgOf plan v =
    case Graph.lookupKey (planIndex plan)
                         (planPkgIdOf plan v) of
      Just pkg -> pkg
      Nothing  -> error "InstallPlan: internal error: planPkgOf lookup failed"
-}



instance Binary SolverInstallPlan
instance Structured SolverInstallPlan

showPlanIndex :: [SolverPlanPackage] -> String
showPlanIndex :: [ResolverPackage UnresolvedPkgLoc] -> FilePath
showPlanIndex = forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ResolverPackage UnresolvedPkgLoc -> FilePath
showPlanPackage

showInstallPlan :: SolverInstallPlan -> String
showInstallPlan :: SolverInstallPlan -> FilePath
showInstallPlan = [ResolverPackage UnresolvedPkgLoc] -> FilePath
showPlanIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
toList

showPlanPackage :: SolverPlanPackage -> String
showPlanPackage :: ResolverPackage UnresolvedPkgLoc -> FilePath
showPlanPackage (PreExisting InstSolverPackage
ipkg) = FilePath
"PreExisting " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId InstSolverPackage
ipkg)
                                            forall a. [a] -> [a] -> [a]
++ FilePath
" (" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstSolverPackage
ipkg)
                                            forall a. [a] -> [a] -> [a]
++ FilePath
")"
showPlanPackage (Configured  SolverPackage UnresolvedPkgLoc
spkg) =
    FilePath
"Configured " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId SolverPackage UnresolvedPkgLoc
spkg) forall a. [a] -> [a] -> [a]
++ FilePath
flags forall a. [a] -> [a] -> [a]
++ FilePath
comps
  where
    flags :: FilePath
flags
        | FlagAssignment -> Bool
nullFlagAssignment FlagAssignment
fa = FilePath
""
        | Bool
otherwise             = FilePath
" " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall loc. SolverPackage loc -> FlagAssignment
solverPkgFlags SolverPackage UnresolvedPkgLoc
spkg)
      where
        fa :: FlagAssignment
fa = forall loc. SolverPackage loc -> FlagAssignment
solverPkgFlags SolverPackage UnresolvedPkgLoc
spkg

    comps :: FilePath
comps | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Component
deps = FilePath
""
          | Bool
otherwise = FilePath
" " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> FilePath
prettyShow forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Set Component
deps)
      where
        deps :: Set CD.Component
        deps :: Set Component
deps = forall a. ComponentDeps a -> Set Component
CD.components (forall loc. SolverPackage loc -> ComponentDeps [SolverId]
solverPkgLibDeps SolverPackage UnresolvedPkgLoc
spkg)
             forall a. Semigroup a => a -> a -> a
<> forall a. ComponentDeps a -> Set Component
CD.components (forall loc. SolverPackage loc -> ComponentDeps [SolverId]
solverPkgExeDeps SolverPackage UnresolvedPkgLoc
spkg)

-- | Build an installation plan from a valid set of resolved packages.
--
new :: IndependentGoals
    -> SolverPlanIndex
    -> Either [SolverPlanProblem] SolverInstallPlan
new :: IndependentGoals
-> SolverPlanIndex -> Either [SolverPlanProblem] SolverInstallPlan
new IndependentGoals
indepGoals SolverPlanIndex
index =
  case IndependentGoals -> SolverPlanIndex -> [SolverPlanProblem]
problems IndependentGoals
indepGoals SolverPlanIndex
index of
    []    -> forall a b. b -> Either a b
Right (SolverPlanIndex -> IndependentGoals -> SolverInstallPlan
SolverInstallPlan SolverPlanIndex
index IndependentGoals
indepGoals)
    [SolverPlanProblem]
probs -> forall a b. a -> Either a b
Left [SolverPlanProblem]
probs

toList :: SolverInstallPlan -> [SolverPlanPackage]
toList :: SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
toList = forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolverInstallPlan -> SolverPlanIndex
planIndex

toMap :: SolverInstallPlan -> Map SolverId SolverPlanPackage
toMap :: SolverInstallPlan
-> Map SolverId (ResolverPackage UnresolvedPkgLoc)
toMap = forall a. Graph a -> Map (Key a) a
Graph.toMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolverInstallPlan -> SolverPlanIndex
planIndex

-- | Remove packages from the install plan. This will result in an
-- error if there are remaining packages that depend on any matching
-- package. This is primarily useful for obtaining an install plan for
-- the dependencies of a package or set of packages without actually
-- installing the package itself, as when doing development.
--
remove :: (SolverPlanPackage -> Bool)
       -> SolverInstallPlan
       -> Either [SolverPlanProblem]
                 (SolverInstallPlan)
remove :: (ResolverPackage UnresolvedPkgLoc -> Bool)
-> SolverInstallPlan
-> Either [SolverPlanProblem] SolverInstallPlan
remove ResolverPackage UnresolvedPkgLoc -> Bool
shouldRemove SolverInstallPlan
plan =
    IndependentGoals
-> SolverPlanIndex -> Either [SolverPlanProblem] SolverInstallPlan
new (SolverInstallPlan -> IndependentGoals
planIndepGoals SolverInstallPlan
plan) SolverPlanIndex
newIndex
  where
    newIndex :: SolverPlanIndex
newIndex = forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList forall a b. (a -> b) -> a -> b
$
                 forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverPackage UnresolvedPkgLoc -> Bool
shouldRemove) (SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
toList SolverInstallPlan
plan)

-- ------------------------------------------------------------
-- * Checking validity of plans
-- ------------------------------------------------------------

-- | A valid installation plan is a set of packages that is 'acyclic',
-- 'closed' and 'consistent'. Also, every 'ConfiguredPackage' in the
-- plan has to have a valid configuration (see 'configuredPackageValid').
--
-- * if the result is @False@ use 'problems' to get a detailed list.
--
valid :: IndependentGoals
      -> SolverPlanIndex
      -> Bool
valid :: IndependentGoals -> SolverPlanIndex -> Bool
valid IndependentGoals
indepGoals SolverPlanIndex
index =
    forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ IndependentGoals -> SolverPlanIndex -> [SolverPlanProblem]
problems IndependentGoals
indepGoals SolverPlanIndex
index

data SolverPlanProblem =
     PackageMissingDeps   SolverPlanPackage
                          [PackageIdentifier]
   | PackageCycle         [SolverPlanPackage]
   | PackageInconsistency PackageName [(PackageIdentifier, Version)]
   | PackageStateInvalid  SolverPlanPackage SolverPlanPackage

showPlanProblem :: SolverPlanProblem -> String
showPlanProblem :: SolverPlanProblem -> FilePath
showPlanProblem (PackageMissingDeps ResolverPackage UnresolvedPkgLoc
pkg [PackageIdentifier]
missingDeps) =
     FilePath
"Package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ResolverPackage UnresolvedPkgLoc
pkg)
  forall a. [a] -> [a] -> [a]
++ FilePath
" depends on the following packages which are missing from the plan: "
  forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> FilePath
prettyShow [PackageIdentifier]
missingDeps)

showPlanProblem (PackageCycle [ResolverPackage UnresolvedPkgLoc]
cycleGroup) =
     FilePath
"The following packages are involved in a dependency cycle "
  forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> FilePath
prettyShowforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall pkg. Package pkg => pkg -> PackageIdentifier
packageId) [ResolverPackage UnresolvedPkgLoc]
cycleGroup)

showPlanProblem (PackageInconsistency PackageName
name [(PackageIdentifier, Version)]
inconsistencies) =
     FilePath
"Package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow PackageName
name
  forall a. [a] -> [a] -> [a]
++ FilePath
" is required by several packages,"
  forall a. [a] -> [a] -> [a]
++ FilePath
" but they require inconsistent versions:\n"
  forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines [ FilePath
"  package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkg forall a. [a] -> [a] -> [a]
++ FilePath
" requires "
                            forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
name Version
ver)
             | (PackageIdentifier
pkg, Version
ver) <- [(PackageIdentifier, Version)]
inconsistencies ]

showPlanProblem (PackageStateInvalid ResolverPackage UnresolvedPkgLoc
pkg ResolverPackage UnresolvedPkgLoc
pkg') =
     FilePath
"Package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ResolverPackage UnresolvedPkgLoc
pkg)
  forall a. [a] -> [a] -> [a]
++ FilePath
" is in the " forall a. [a] -> [a] -> [a]
++ forall {loc}. ResolverPackage loc -> FilePath
showPlanState ResolverPackage UnresolvedPkgLoc
pkg
  forall a. [a] -> [a] -> [a]
++ FilePath
" state but it depends on package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ResolverPackage UnresolvedPkgLoc
pkg')
  forall a. [a] -> [a] -> [a]
++ FilePath
" which is in the " forall a. [a] -> [a] -> [a]
++ forall {loc}. ResolverPackage loc -> FilePath
showPlanState ResolverPackage UnresolvedPkgLoc
pkg'
  forall a. [a] -> [a] -> [a]
++ FilePath
" state"
  where
    showPlanState :: ResolverPackage loc -> FilePath
showPlanState (PreExisting InstSolverPackage
_) = FilePath
"pre-existing"
    showPlanState (Configured  SolverPackage loc
_)   = FilePath
"configured"

-- | For an invalid plan, produce a detailed list of problems as human readable
-- error messages. This is mainly intended for debugging purposes.
-- Use 'showPlanProblem' for a human readable explanation.
--
problems :: IndependentGoals
         -> SolverPlanIndex
         -> [SolverPlanProblem]
problems :: IndependentGoals -> SolverPlanIndex -> [SolverPlanProblem]
problems IndependentGoals
indepGoals SolverPlanIndex
index =

     [ ResolverPackage UnresolvedPkgLoc
-> [PackageIdentifier] -> SolverPlanProblem
PackageMissingDeps ResolverPackage UnresolvedPkgLoc
pkg
       (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
         (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall pkg. Package pkg => pkg -> PackageIdentifier
packageId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. IsNode a => Key a -> Graph a -> Maybe a
Graph.lookup SolverPlanIndex
index)
         [SolverId]
missingDeps)
     | (ResolverPackage UnresolvedPkgLoc
pkg, [SolverId]
missingDeps) <- forall a. Graph a -> [(a, [Key a])]
Graph.broken SolverPlanIndex
index ]

  forall a. [a] -> [a] -> [a]
++ [ [ResolverPackage UnresolvedPkgLoc] -> SolverPlanProblem
PackageCycle [ResolverPackage UnresolvedPkgLoc]
cycleGroup
     | [ResolverPackage UnresolvedPkgLoc]
cycleGroup <- forall a. Graph a -> [[a]]
Graph.cycles SolverPlanIndex
index ]

  forall a. [a] -> [a] -> [a]
++ [ PackageName -> [(PackageIdentifier, Version)] -> SolverPlanProblem
PackageInconsistency PackageName
name [(PackageIdentifier, Version)]
inconsistencies
     | (PackageName
name, [(PackageIdentifier, Version)]
inconsistencies) <-
       IndependentGoals
-> SolverPlanIndex
-> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies IndependentGoals
indepGoals SolverPlanIndex
index ]

  forall a. [a] -> [a] -> [a]
++ [ ResolverPackage UnresolvedPkgLoc
-> ResolverPackage UnresolvedPkgLoc -> SolverPlanProblem
PackageStateInvalid ResolverPackage UnresolvedPkgLoc
pkg ResolverPackage UnresolvedPkgLoc
pkg'
     | ResolverPackage UnresolvedPkgLoc
pkg <- forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList SolverPlanIndex
index
     , Just ResolverPackage UnresolvedPkgLoc
pkg' <- forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. IsNode a => Key a -> Graph a -> Maybe a
Graph.lookup SolverPlanIndex
index)
                    (forall a. IsNode a => a -> [Key a]
nodeNeighbors ResolverPackage UnresolvedPkgLoc
pkg)
     , Bool -> Bool
not (ResolverPackage UnresolvedPkgLoc
-> ResolverPackage UnresolvedPkgLoc -> Bool
stateDependencyRelation ResolverPackage UnresolvedPkgLoc
pkg ResolverPackage UnresolvedPkgLoc
pkg') ]


-- | Compute all roots of the install plan, and verify that the transitive
-- plans from those roots are all consistent.
--
-- NOTE: This does not check for dependency cycles. Moreover, dependency cycles
-- may be absent from the subplans even if the larger plan contains a dependency
-- cycle. Such cycles may or may not be an issue; either way, we don't check
-- for them here.
dependencyInconsistencies :: IndependentGoals
                          -> SolverPlanIndex
                          -> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies :: IndependentGoals
-> SolverPlanIndex
-> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies IndependentGoals
indepGoals SolverPlanIndex
index  =
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SolverPlanIndex -> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies' [SolverPlanIndex]
subplans
  where
    subplans :: [SolverPlanIndex]
    subplans :: [SolverPlanIndex]
subplans = -- Not Graph.closure!!
               forall a b. (a -> b) -> [a] -> [b]
map (SolverPlanIndex -> [SolverId] -> SolverPlanIndex
nonSetupClosure SolverPlanIndex
index)
                   (IndependentGoals -> SolverPlanIndex -> [[SolverId]]
rootSets IndependentGoals
indepGoals SolverPlanIndex
index)

-- NB: When we check for inconsistencies, packages from the setup
-- scripts don't count as part of the closure (this way, we
-- can build, e.g., Cabal-1.24.1 even if its setup script is
-- built with Cabal-1.24.0).
--
-- This is a best effort function that swallows any non-existent
-- SolverIds.
nonSetupClosure :: SolverPlanIndex
                -> [SolverId]
                -> SolverPlanIndex
nonSetupClosure :: SolverPlanIndex -> [SolverId] -> SolverPlanIndex
nonSetupClosure SolverPlanIndex
index [SolverId]
pkgids0 = SolverPlanIndex -> [SolverId] -> SolverPlanIndex
closure forall a. IsNode a => Graph a
Graph.empty [SolverId]
pkgids0
 where
    closure :: Graph SolverPlanPackage -> [SolverId] -> SolverPlanIndex
    closure :: SolverPlanIndex -> [SolverId] -> SolverPlanIndex
closure SolverPlanIndex
completed []             = SolverPlanIndex
completed
    closure SolverPlanIndex
completed (SolverId
pkgid:[SolverId]
pkgids) =
      case forall a. IsNode a => Key a -> Graph a -> Maybe a
Graph.lookup SolverId
pkgid SolverPlanIndex
index of
        Maybe (ResolverPackage UnresolvedPkgLoc)
Nothing   -> SolverPlanIndex -> [SolverId] -> SolverPlanIndex
closure SolverPlanIndex
completed [SolverId]
pkgids
        Just ResolverPackage UnresolvedPkgLoc
pkg  ->
          case forall a. IsNode a => Key a -> Graph a -> Maybe a
Graph.lookup (forall a. IsNode a => a -> Key a
nodeKey ResolverPackage UnresolvedPkgLoc
pkg) SolverPlanIndex
completed of
            Just ResolverPackage UnresolvedPkgLoc
_  -> SolverPlanIndex -> [SolverId] -> SolverPlanIndex
closure SolverPlanIndex
completed  [SolverId]
pkgids
            Maybe (ResolverPackage UnresolvedPkgLoc)
Nothing -> SolverPlanIndex -> [SolverId] -> SolverPlanIndex
closure SolverPlanIndex
completed' [SolverId]
pkgids'
              where completed' :: SolverPlanIndex
completed' = forall a. IsNode a => a -> Graph a -> Graph a
Graph.insert ResolverPackage UnresolvedPkgLoc
pkg SolverPlanIndex
completed
                    pkgids' :: [SolverId]
pkgids'    = forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (forall loc. ResolverPackage loc -> ComponentDeps [SolverId]
resolverPackageLibDeps ResolverPackage UnresolvedPkgLoc
pkg) forall a. [a] -> [a] -> [a]
++ [SolverId]
pkgids

-- | Compute the root sets of a plan
--
-- A root set is a set of packages whose dependency closure must be consistent.
-- This is the set of all top-level library roots (taken together normally, or
-- as singletons sets if we are considering them as independent goals), along
-- with all setup dependencies of all packages.
rootSets :: IndependentGoals -> SolverPlanIndex -> [[SolverId]]
rootSets :: IndependentGoals -> SolverPlanIndex -> [[SolverId]]
rootSets (IndependentGoals Bool
indepGoals) SolverPlanIndex
index =
       if Bool
indepGoals then forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:[]) [SolverId]
libRoots else [[SolverId]
libRoots]
    forall a. [a] -> [a] -> [a]
++ SolverPlanIndex -> [[SolverId]]
setupRoots SolverPlanIndex
index
  where
    libRoots :: [SolverId]
    libRoots :: [SolverId]
libRoots = SolverPlanIndex -> [SolverId]
libraryRoots SolverPlanIndex
index

-- | Compute the library roots of a plan
--
-- The library roots are the set of packages with no reverse dependencies
-- (no reverse library dependencies but also no reverse setup dependencies).
libraryRoots :: SolverPlanIndex -> [SolverId]
libraryRoots :: SolverPlanIndex -> [SolverId]
libraryRoots SolverPlanIndex
index =
    forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsNode a => a -> Key a
nodeKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ResolverPackage UnresolvedPkgLoc
toPkgId) [Int]
roots
  where
    (Graph
graph, Int -> ResolverPackage UnresolvedPkgLoc
toPkgId, Key (ResolverPackage UnresolvedPkgLoc) -> Maybe Int
_) = forall a. Graph a -> (Graph, Int -> a, Key a -> Maybe Int)
Graph.toGraph SolverPlanIndex
index
    indegree :: Array Int Int
indegree = Graph -> Array Int Int
OldGraph.indegree Graph
graph
    roots :: [Int]
roots    = forall a. (a -> Bool) -> [a] -> [a]
filter Int -> Bool
isRoot (Graph -> [Int]
OldGraph.vertices Graph
graph)
    isRoot :: Int -> Bool
isRoot Int
v = Array Int Int
indegree forall i e. Ix i => Array i e -> i -> e
! Int
v forall a. Eq a => a -> a -> Bool
== Int
0

-- | The setup dependencies of each package in the plan
setupRoots :: SolverPlanIndex -> [[SolverId]]
setupRoots :: SolverPlanIndex -> [[SolverId]]
setupRoots = forall a. (a -> Bool) -> [a] -> [a]
filter (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 b. (a -> b) -> [a] -> [b]
map (forall a. Monoid a => ComponentDeps a -> a
CD.setupDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall loc. ResolverPackage loc -> ComponentDeps [SolverId]
resolverPackageLibDeps)
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList

-- | Given a package index where we assume we want to use all the packages
-- (use 'dependencyClosure' if you need to get such a index subset) find out
-- if the dependencies within it use consistent versions of each package.
-- Return all cases where multiple packages depend on different versions of
-- some other package.
--
-- Each element in the result is a package name along with the packages that
-- depend on it and the versions they require. These are guaranteed to be
-- distinct.
--
dependencyInconsistencies' :: SolverPlanIndex
                           -> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies' :: SolverPlanIndex -> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies' SolverPlanIndex
index =
    [ (PackageName
name, [ (PackageIdentifier
pid, forall pkg. Package pkg => pkg -> Version
packageVersion ResolverPackage UnresolvedPkgLoc
dep) | (ResolverPackage UnresolvedPkgLoc
dep,[PackageIdentifier]
pids) <- [(ResolverPackage UnresolvedPkgLoc, [PackageIdentifier])]
uses, PackageIdentifier
pid <- [PackageIdentifier]
pids])
    | (PackageName
name, Map
  SolverId (ResolverPackage UnresolvedPkgLoc, [PackageIdentifier])
ipid_map) <- forall k a. Map k a -> [(k, a)]
Map.toList Map
  PackageName
  (Map
     SolverId (ResolverPackage UnresolvedPkgLoc, [PackageIdentifier]))
inverseIndex
    , let uses :: [(ResolverPackage UnresolvedPkgLoc, [PackageIdentifier])]
uses = forall k a. Map k a -> [a]
Map.elems Map
  SolverId (ResolverPackage UnresolvedPkgLoc, [PackageIdentifier])
ipid_map
    , [ResolverPackage UnresolvedPkgLoc] -> Bool
reallyIsInconsistent (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(ResolverPackage UnresolvedPkgLoc, [PackageIdentifier])]
uses)
    ]
  where
    -- For each package name (of a dependency, somewhere)
    --   and each installed ID of that package
    --     the associated package instance
    --     and a list of reverse dependencies (as source IDs)
    inverseIndex :: Map PackageName (Map SolverId (SolverPlanPackage, [PackageId]))
    inverseIndex :: Map
  PackageName
  (Map
     SolverId (ResolverPackage UnresolvedPkgLoc, [PackageIdentifier]))
inverseIndex = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\(ResolverPackage UnresolvedPkgLoc
a,[PackageIdentifier]
b) (ResolverPackage UnresolvedPkgLoc
_,[PackageIdentifier]
b') -> (ResolverPackage UnresolvedPkgLoc
a,[PackageIdentifier]
bforall a. [a] -> [a] -> [a]
++[PackageIdentifier]
b')))
      [ (forall pkg. Package pkg => pkg -> PackageName
packageName ResolverPackage UnresolvedPkgLoc
dep, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(SolverId
sid,(ResolverPackage UnresolvedPkgLoc
dep,[forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ResolverPackage UnresolvedPkgLoc
pkg]))])
      | -- For each package @pkg@
        ResolverPackage UnresolvedPkgLoc
pkg <- forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList SolverPlanIndex
index
        -- Find out which @sid@ @pkg@ depends on
      , SolverId
sid <- forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (forall loc. ResolverPackage loc -> ComponentDeps [SolverId]
resolverPackageLibDeps ResolverPackage UnresolvedPkgLoc
pkg)
        -- And look up those @sid@ (i.e., @sid@ is the ID of @dep@)
      , Just ResolverPackage UnresolvedPkgLoc
dep <- [forall a. IsNode a => Key a -> Graph a -> Maybe a
Graph.lookup SolverId
sid SolverPlanIndex
index]
      ]

    -- If, in a single install plan, we depend on more than one version of a
    -- package, then this is ONLY okay in the (rather special) case that we
    -- depend on precisely two versions of that package, and one of them
    -- depends on the other. This is necessary for example for the base where
    -- we have base-3 depending on base-4.
    reallyIsInconsistent :: [SolverPlanPackage] -> Bool
    reallyIsInconsistent :: [ResolverPackage UnresolvedPkgLoc] -> Bool
reallyIsInconsistent []       = Bool
False
    reallyIsInconsistent [ResolverPackage UnresolvedPkgLoc
_p]     = Bool
False
    reallyIsInconsistent [ResolverPackage UnresolvedPkgLoc
p1, ResolverPackage UnresolvedPkgLoc
p2] =
      let pid1 :: Key (ResolverPackage UnresolvedPkgLoc)
pid1 = forall a. IsNode a => a -> Key a
nodeKey ResolverPackage UnresolvedPkgLoc
p1
          pid2 :: Key (ResolverPackage UnresolvedPkgLoc)
pid2 = forall a. IsNode a => a -> Key a
nodeKey ResolverPackage UnresolvedPkgLoc
p2
      in Key (ResolverPackage UnresolvedPkgLoc)
pid1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (forall loc. ResolverPackage loc -> ComponentDeps [SolverId]
resolverPackageLibDeps ResolverPackage UnresolvedPkgLoc
p2)
      Bool -> Bool -> Bool
&& Key (ResolverPackage UnresolvedPkgLoc)
pid2 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (forall loc. ResolverPackage loc -> ComponentDeps [SolverId]
resolverPackageLibDeps ResolverPackage UnresolvedPkgLoc
p1)
    reallyIsInconsistent [ResolverPackage UnresolvedPkgLoc]
_ = Bool
True


-- | The graph of packages (nodes) and dependencies (edges) must be acyclic.
--
-- * if the result is @False@ use 'PackageIndex.dependencyCycles' to find out
--   which packages are involved in dependency cycles.
--
acyclic :: SolverPlanIndex -> Bool
acyclic :: SolverPlanIndex -> Bool
acyclic = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Graph a -> [[a]]
Graph.cycles

-- | An installation plan is closed if for every package in the set, all of
-- its dependencies are also in the set. That is, the set is closed under the
-- dependency relation.
--
-- * if the result is @False@ use 'PackageIndex.brokenPackages' to find out
--   which packages depend on packages not in the index.
--
closed :: SolverPlanIndex -> Bool
closed :: SolverPlanIndex -> Bool
closed = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Graph a -> [(a, [Key a])]
Graph.broken

-- | An installation plan is consistent if all dependencies that target a
-- single package name, target the same version.
--
-- This is slightly subtle. It is not the same as requiring that there be at
-- most one version of any package in the set. It only requires that of
-- packages which have more than one other package depending on them. We could
-- actually make the condition even more precise and say that different
-- versions are OK so long as they are not both in the transitive closure of
-- any other package (or equivalently that their inverse closures do not
-- intersect). The point is we do not want to have any packages depending
-- directly or indirectly on two different versions of the same package. The
-- current definition is just a safe approximation of that.
--
-- * if the result is @False@ use 'PackageIndex.dependencyInconsistencies' to
--   find out which packages are.
--
consistent :: SolverPlanIndex -> Bool
consistent :: SolverPlanIndex -> Bool
consistent = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndependentGoals
-> SolverPlanIndex
-> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies (Bool -> IndependentGoals
IndependentGoals Bool
False)

-- | The states of packages have that depend on each other must respect
-- this relation. That is for very case where package @a@ depends on
-- package @b@ we require that @dependencyStatesOk a b = True@.
--
stateDependencyRelation :: SolverPlanPackage
                        -> SolverPlanPackage
                        -> Bool
stateDependencyRelation :: ResolverPackage UnresolvedPkgLoc
-> ResolverPackage UnresolvedPkgLoc -> Bool
stateDependencyRelation PreExisting{}   PreExisting{}     = Bool
True

stateDependencyRelation (Configured  SolverPackage UnresolvedPkgLoc
_) PreExisting{}     = Bool
True
stateDependencyRelation (Configured  SolverPackage UnresolvedPkgLoc
_) (Configured  SolverPackage UnresolvedPkgLoc
_)   = Bool
True

stateDependencyRelation ResolverPackage UnresolvedPkgLoc
_               ResolverPackage UnresolvedPkgLoc
_                 = Bool
False


-- | Compute the dependency closure of a package in a install plan
--
dependencyClosure :: SolverInstallPlan
                  -> [SolverId]
                  -> [SolverPlanPackage]
dependencyClosure :: SolverInstallPlan
-> [SolverId] -> [ResolverPackage UnresolvedPkgLoc]
dependencyClosure SolverInstallPlan
plan = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Graph a -> [Key a] -> Maybe [a]
Graph.closure (SolverInstallPlan -> SolverPlanIndex
planIndex SolverInstallPlan
plan)


reverseDependencyClosure :: SolverInstallPlan
                         -> [SolverId]
                         -> [SolverPlanPackage]
reverseDependencyClosure :: SolverInstallPlan
-> [SolverId] -> [ResolverPackage UnresolvedPkgLoc]
reverseDependencyClosure SolverInstallPlan
plan = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Graph a -> [Key a] -> Maybe [a]
Graph.revClosure (SolverInstallPlan -> SolverPlanIndex
planIndex SolverInstallPlan
plan)


topologicalOrder :: SolverInstallPlan
                 -> [SolverPlanPackage]
topologicalOrder :: SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
topologicalOrder SolverInstallPlan
plan = forall a. Graph a -> [a]
Graph.topSort (SolverInstallPlan -> SolverPlanIndex
planIndex SolverInstallPlan
plan)


reverseTopologicalOrder :: SolverInstallPlan
                        -> [SolverPlanPackage]
reverseTopologicalOrder :: SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
reverseTopologicalOrder SolverInstallPlan
plan = forall a. Graph a -> [a]
Graph.revTopSort (SolverInstallPlan -> SolverPlanIndex
planIndex SolverInstallPlan
plan)