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 -> forall loc. InstSolverPackage -> ResolverPackage loc
PreExisting forall a b. (a -> b) -> a -> b
$
InstSolverPackage {
instSolverPkgIPI :: InstalledPackageInfo
instSolverPkgIPI = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. PackageIndex a -> UnitId -> Maybe a
SI.lookupUnitId InstalledPackageIndex
iidx UnitId
pi,
instSolverPkgLibDeps :: ComponentDeps [SolverId]
instSolverPkgLibDeps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst ComponentDeps ([SolverId], [SolverId])
ds',
instSolverPkgExeDeps :: ComponentDeps [SolverId]
instSolverPkgExeDeps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd ComponentDeps ([SolverId], [SolverId])
ds'
}
Right PackageId
pi -> forall loc. SolverPackage loc -> ResolverPackage loc
Configured 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst ComponentDeps ([SolverId], [SolverId])
ds',
solverPkgExeDeps :: ComponentDeps [SolverId]
solverPkgExeDeps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd ComponentDeps ([SolverId], [SolverId])
ds'
}
where
srcpkg :: SourcePackage loc
srcpkg = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"convCP: lookupPackageId failed") forall a b. (a -> b) -> a -> b
$ 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' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. [Either a b] -> ([a], [b])
partitionEithers forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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))) = forall a b. a -> Either a b
Left UnitId
pi
convPI PI QPN
pi = forall a b. b -> Either a b
Right (forall pkg. Package pkg => pkg -> PackageId
packageId (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id 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 -> 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 forall a. Eq a => a -> a -> Bool
== PackageName
pn' -> forall a b. b -> Either a b
Right (PackageId -> SolverId
PlannedId PackageId
sourceId)
| Bool
otherwise -> 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