module Distribution.Solver.Modular.ConfiguredConversion
( convCP
) where
import Data.Maybe
import Prelude hiding (pi)
import Data.Either (partitionEithers)
import Distribution.Package (UnitId, packageId)
import qualified Distribution.Simple.PackageIndex as SI
import Distribution.Solver.Modular.Configured
import Distribution.Solver.Modular.Package
import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
import qualified Distribution.Solver.Types.PackageIndex as CI
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.ResolverPackage
import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.InstSolverPackage
import Distribution.Solver.Types.SourcePackage
convCP :: SI.InstalledPackageIndex ->
CI.PackageIndex (SourcePackage loc) ->
CP QPN -> ResolverPackage loc
convCP :: forall loc.
InstalledPackageIndex
-> PackageIndex (SourcePackage loc)
-> CP QPN
-> ResolverPackage loc
convCP InstalledPackageIndex
iidx PackageIndex (SourcePackage loc)
sidx (CP PI QPN
qpi FlagAssignment
fa OptionalStanzaSet
es ComponentDeps [PI QPN]
ds) =
case PI QPN -> Either UnitId PackageId
convPI PI QPN
qpi of
Left UnitId
pi -> InstSolverPackage -> ResolverPackage loc
forall loc. InstSolverPackage -> ResolverPackage loc
PreExisting (InstSolverPackage -> ResolverPackage loc)
-> InstSolverPackage -> ResolverPackage loc
forall a b. (a -> b) -> a -> b
$
InstSolverPackage {
instSolverPkgIPI :: InstalledPackageInfo
instSolverPkgIPI = Maybe InstalledPackageInfo -> InstalledPackageInfo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe InstalledPackageInfo -> InstalledPackageInfo)
-> Maybe InstalledPackageInfo -> InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex -> UnitId -> Maybe InstalledPackageInfo
forall a. PackageIndex a -> UnitId -> Maybe a
SI.lookupUnitId InstalledPackageIndex
iidx UnitId
pi,
instSolverPkgLibDeps :: ComponentDeps [SolverId]
instSolverPkgLibDeps = (([SolverId], [SolverId]) -> [SolverId])
-> ComponentDeps ([SolverId], [SolverId])
-> ComponentDeps [SolverId]
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SolverId], [SolverId]) -> [SolverId]
forall a b. (a, b) -> a
fst ComponentDeps ([SolverId], [SolverId])
ds',
instSolverPkgExeDeps :: ComponentDeps [SolverId]
instSolverPkgExeDeps = (([SolverId], [SolverId]) -> [SolverId])
-> ComponentDeps ([SolverId], [SolverId])
-> ComponentDeps [SolverId]
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SolverId], [SolverId]) -> [SolverId]
forall a b. (a, b) -> b
snd ComponentDeps ([SolverId], [SolverId])
ds'
}
Right PackageId
pi -> SolverPackage loc -> ResolverPackage loc
forall loc. SolverPackage loc -> ResolverPackage loc
Configured (SolverPackage loc -> ResolverPackage loc)
-> SolverPackage loc -> ResolverPackage loc
forall a b. (a -> b) -> a -> b
$
SolverPackage {
solverPkgSource :: SourcePackage loc
solverPkgSource = SourcePackage loc
srcpkg,
solverPkgFlags :: FlagAssignment
solverPkgFlags = FlagAssignment
fa,
solverPkgStanzas :: OptionalStanzaSet
solverPkgStanzas = OptionalStanzaSet
es,
solverPkgLibDeps :: ComponentDeps [SolverId]
solverPkgLibDeps = (([SolverId], [SolverId]) -> [SolverId])
-> ComponentDeps ([SolverId], [SolverId])
-> ComponentDeps [SolverId]
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SolverId], [SolverId]) -> [SolverId]
forall a b. (a, b) -> a
fst ComponentDeps ([SolverId], [SolverId])
ds',
solverPkgExeDeps :: ComponentDeps [SolverId]
solverPkgExeDeps = (([SolverId], [SolverId]) -> [SolverId])
-> ComponentDeps ([SolverId], [SolverId])
-> ComponentDeps [SolverId]
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SolverId], [SolverId]) -> [SolverId]
forall a b. (a, b) -> b
snd ComponentDeps ([SolverId], [SolverId])
ds'
}
where
srcpkg :: SourcePackage loc
srcpkg = SourcePackage loc -> Maybe (SourcePackage loc) -> SourcePackage loc
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> SourcePackage loc
forall a. HasCallStack => [Char] -> a
error [Char]
"convCP: lookupPackageId failed") (Maybe (SourcePackage loc) -> SourcePackage loc)
-> Maybe (SourcePackage loc) -> SourcePackage loc
forall a b. (a -> b) -> a -> b
$ PackageIndex (SourcePackage loc)
-> PackageId -> Maybe (SourcePackage loc)
forall pkg.
Package pkg =>
PackageIndex pkg -> PackageId -> Maybe pkg
CI.lookupPackageId PackageIndex (SourcePackage loc)
sidx PackageId
pi
where
ds' :: ComponentDeps ([SolverId] , [SolverId] )
ds' :: ComponentDeps ([SolverId], [SolverId])
ds' = ([PI QPN] -> ([SolverId], [SolverId]))
-> ComponentDeps [PI QPN] -> ComponentDeps ([SolverId], [SolverId])
forall a b. (a -> b) -> ComponentDeps a -> ComponentDeps b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Either SolverId SolverId] -> ([SolverId], [SolverId])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either SolverId SolverId] -> ([SolverId], [SolverId]))
-> ([PI QPN] -> [Either SolverId SolverId])
-> [PI QPN]
-> ([SolverId], [SolverId])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PI QPN -> Either SolverId SolverId)
-> [PI QPN] -> [Either SolverId SolverId]
forall a b. (a -> b) -> [a] -> [b]
map PI QPN -> Either SolverId SolverId
convConfId) ComponentDeps [PI QPN]
ds
convPI :: PI QPN -> Either UnitId PackageId
convPI :: PI QPN -> Either UnitId PackageId
convPI (PI QPN
_ (I Ver
_ (Inst UnitId
pi))) = UnitId -> Either UnitId PackageId
forall a b. a -> Either a b
Left UnitId
pi
convPI PI QPN
pi = PackageId -> Either UnitId PackageId
forall a b. b -> Either a b
Right (SolverId -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId ((SolverId -> SolverId)
-> (SolverId -> SolverId) -> Either SolverId SolverId -> SolverId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SolverId -> SolverId
forall a. a -> a
id SolverId -> SolverId
forall a. a -> a
id (PI QPN -> Either SolverId SolverId
convConfId PI QPN
pi)))
convConfId :: PI QPN -> Either SolverId SolverId
convConfId :: PI QPN -> Either SolverId SolverId
convConfId (PI (Q (PackagePath Namespace
_ Qualifier
q) PackageName
pn) (I Ver
v Loc
loc)) =
case Loc
loc of
Inst UnitId
pi -> SolverId -> Either SolverId SolverId
forall a b. a -> Either a b
Left (PackageId -> UnitId -> SolverId
PreExistingId PackageId
sourceId UnitId
pi)
Loc
_otherwise
| QualExe PackageName
_ PackageName
pn' <- Qualifier
q
, PackageName
pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
pn' -> SolverId -> Either SolverId SolverId
forall a b. b -> Either a b
Right (PackageId -> SolverId
PlannedId PackageId
sourceId)
| Bool
otherwise -> SolverId -> Either SolverId SolverId
forall a b. a -> Either a b
Left (PackageId -> SolverId
PlannedId PackageId
sourceId)
where
sourceId :: PackageId
sourceId = PackageName -> Ver -> PackageId
PackageIdentifier PackageName
pn Ver
v