{-# LANGUAGE DeriveGeneric #-}
module Distribution.Solver.Types.InstSolverPackage
    ( InstSolverPackage(..)
    ) where

import Distribution.Solver.Compat.Prelude
import Prelude ()

import Distribution.Package ( Package(..), HasMungedPackageId(..), HasUnitId(..) )
import Distribution.Solver.Types.ComponentDeps ( ComponentDeps )
import Distribution.Solver.Types.SolverId
import Distribution.Types.MungedPackageId
import Distribution.Types.PackageId
import Distribution.Types.MungedPackageName
import Distribution.InstalledPackageInfo (InstalledPackageInfo)

-- | An 'InstSolverPackage' is a pre-existing installed package
-- specified by the dependency solver.
data InstSolverPackage = InstSolverPackage {
      InstSolverPackage -> InstalledPackageInfo
instSolverPkgIPI :: InstalledPackageInfo,
      InstSolverPackage -> ComponentDeps [SolverId]
instSolverPkgLibDeps :: ComponentDeps [SolverId],
      InstSolverPackage -> ComponentDeps [SolverId]
instSolverPkgExeDeps :: ComponentDeps [SolverId]
    }
  deriving (InstSolverPackage -> InstSolverPackage -> Bool
(InstSolverPackage -> InstSolverPackage -> Bool)
-> (InstSolverPackage -> InstSolverPackage -> Bool)
-> Eq InstSolverPackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstSolverPackage -> InstSolverPackage -> Bool
== :: InstSolverPackage -> InstSolverPackage -> Bool
$c/= :: InstSolverPackage -> InstSolverPackage -> Bool
/= :: InstSolverPackage -> InstSolverPackage -> Bool
Eq, Int -> InstSolverPackage -> ShowS
[InstSolverPackage] -> ShowS
InstSolverPackage -> String
(Int -> InstSolverPackage -> ShowS)
-> (InstSolverPackage -> String)
-> ([InstSolverPackage] -> ShowS)
-> Show InstSolverPackage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstSolverPackage -> ShowS
showsPrec :: Int -> InstSolverPackage -> ShowS
$cshow :: InstSolverPackage -> String
show :: InstSolverPackage -> String
$cshowList :: [InstSolverPackage] -> ShowS
showList :: [InstSolverPackage] -> ShowS
Show, (forall x. InstSolverPackage -> Rep InstSolverPackage x)
-> (forall x. Rep InstSolverPackage x -> InstSolverPackage)
-> Generic InstSolverPackage
forall x. Rep InstSolverPackage x -> InstSolverPackage
forall x. InstSolverPackage -> Rep InstSolverPackage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InstSolverPackage -> Rep InstSolverPackage x
from :: forall x. InstSolverPackage -> Rep InstSolverPackage x
$cto :: forall x. Rep InstSolverPackage x -> InstSolverPackage
to :: forall x. Rep InstSolverPackage x -> InstSolverPackage
Generic)

instance Binary InstSolverPackage
instance Structured InstSolverPackage

instance Package InstSolverPackage where
    packageId :: InstSolverPackage -> PackageIdentifier
packageId InstSolverPackage
i =
        -- HACK! See Note [Index conversion with internal libraries]
        let MungedPackageId MungedPackageName
mpn Version
v = InstSolverPackage -> MungedPackageId
forall pkg. HasMungedPackageId pkg => pkg -> MungedPackageId
mungedId InstSolverPackage
i
        in PackageName -> Version -> PackageIdentifier
PackageIdentifier (MungedPackageName -> PackageName
encodeCompatPackageName MungedPackageName
mpn) Version
v

instance HasMungedPackageId InstSolverPackage where
    mungedId :: InstSolverPackage -> MungedPackageId
mungedId = InstalledPackageInfo -> MungedPackageId
forall pkg. HasMungedPackageId pkg => pkg -> MungedPackageId
mungedId (InstalledPackageInfo -> MungedPackageId)
-> (InstSolverPackage -> InstalledPackageInfo)
-> InstSolverPackage
-> MungedPackageId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstSolverPackage -> InstalledPackageInfo
instSolverPkgIPI

instance HasUnitId InstSolverPackage where
    installedUnitId :: InstSolverPackage -> UnitId
installedUnitId = InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId (InstalledPackageInfo -> UnitId)
-> (InstSolverPackage -> InstalledPackageInfo)
-> InstSolverPackage
-> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstSolverPackage -> InstalledPackageInfo
instSolverPkgIPI