1{-# LANGUAGE DeriveGeneric #-}
2module Distribution.Solver.Types.InstSolverPackage
3    ( InstSolverPackage(..)
4    ) where
5
6import Distribution.Compat.Binary (Binary(..))
7import Distribution.Utils.Structured (Structured)
8import Distribution.Package ( Package(..), HasMungedPackageId(..), HasUnitId(..) )
9import Distribution.Solver.Types.ComponentDeps ( ComponentDeps )
10import Distribution.Solver.Types.SolverId
11import Distribution.Types.MungedPackageId
12import Distribution.Types.PackageId
13import Distribution.Types.MungedPackageName
14import Distribution.InstalledPackageInfo (InstalledPackageInfo)
15import GHC.Generics (Generic)
16
17-- | An 'InstSolverPackage' is a pre-existing installed package
18-- specified by the dependency solver.
19data InstSolverPackage = InstSolverPackage {
20      instSolverPkgIPI :: InstalledPackageInfo,
21      instSolverPkgLibDeps :: ComponentDeps [SolverId],
22      instSolverPkgExeDeps :: ComponentDeps [SolverId]
23    }
24  deriving (Eq, Show, Generic)
25
26instance Binary InstSolverPackage
27instance Structured InstSolverPackage
28
29instance Package InstSolverPackage where
30    packageId i =
31        -- HACK! See Note [Index conversion with internal libraries]
32        let MungedPackageId mpn v = mungedId i
33        in PackageIdentifier (encodeCompatPackageName mpn) v
34
35instance HasMungedPackageId InstSolverPackage where
36    mungedId = mungedId . instSolverPkgIPI
37
38instance HasUnitId InstSolverPackage where
39    installedUnitId = installedUnitId . instSolverPkgIPI
40