1{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE DeriveGeneric #-}
3module Distribution.Solver.Types.ResolverPackage
4    ( ResolverPackage(..)
5    , resolverPackageLibDeps
6    , resolverPackageExeDeps
7    ) where
8
9import Distribution.Solver.Compat.Prelude
10import Prelude ()
11
12import Distribution.Solver.Types.InstSolverPackage
13import Distribution.Solver.Types.SolverId
14import Distribution.Solver.Types.SolverPackage
15import qualified Distribution.Solver.Types.ComponentDeps as CD
16
17import Distribution.Compat.Graph (IsNode(..))
18import Distribution.Package (Package(..), HasUnitId(..))
19import Distribution.Simple.Utils (ordNub)
20
21-- | The dependency resolver picks either pre-existing installed packages
22-- or it picks source packages along with package configuration.
23--
24-- This is like the 'InstallPlan.PlanPackage' but with fewer cases.
25--
26data ResolverPackage loc = PreExisting InstSolverPackage
27                         | Configured  (SolverPackage loc)
28  deriving (Eq, Show, Generic)
29
30instance Binary loc => Binary (ResolverPackage loc)
31instance Structured loc => Structured (ResolverPackage loc)
32
33instance Package (ResolverPackage loc) where
34  packageId (PreExisting ipkg)     = packageId ipkg
35  packageId (Configured  spkg)     = packageId spkg
36
37resolverPackageLibDeps :: ResolverPackage loc -> CD.ComponentDeps [SolverId]
38resolverPackageLibDeps (PreExisting ipkg) = instSolverPkgLibDeps ipkg
39resolverPackageLibDeps (Configured spkg) = solverPkgLibDeps spkg
40
41resolverPackageExeDeps :: ResolverPackage loc -> CD.ComponentDeps [SolverId]
42resolverPackageExeDeps (PreExisting ipkg) = instSolverPkgExeDeps ipkg
43resolverPackageExeDeps (Configured spkg) = solverPkgExeDeps spkg
44
45instance IsNode (ResolverPackage loc) where
46  type Key (ResolverPackage loc) = SolverId
47  nodeKey (PreExisting ipkg) = PreExistingId (packageId ipkg) (installedUnitId ipkg)
48  nodeKey (Configured spkg) = PlannedId (packageId spkg)
49  -- Use dependencies for ALL components
50  nodeNeighbors pkg =
51    ordNub $ CD.flatDeps (resolverPackageLibDeps pkg) ++
52             CD.flatDeps (resolverPackageExeDeps pkg)
53