Commit 9369eed3 authored by Andres Löh's avatar Andres Löh
Browse files

properly translate package constraints

parent cb22fda1
...@@ -9,7 +9,7 @@ module Distribution.Client.Dependency.Modular where ...@@ -9,7 +9,7 @@ module Distribution.Client.Dependency.Modular where
-- plan. -- plan.
import Data.Map as M import Data.Map as M
( empty ) ( empty, fromList )
import Distribution.Client.Dependency.Modular.Assignment import Distribution.Client.Dependency.Modular.Assignment
( Assignment, toCPs ) ( Assignment, toCPs )
import Distribution.Client.Dependency.Modular.Dependency import Distribution.Client.Dependency.Modular.Dependency
...@@ -20,10 +20,12 @@ import Distribution.Client.Dependency.Modular.IndexConversion ...@@ -20,10 +20,12 @@ import Distribution.Client.Dependency.Modular.IndexConversion
( convPIs ) ( convPIs )
import Distribution.Client.Dependency.Modular.Log import Distribution.Client.Dependency.Modular.Log
( logToProgress ) ( logToProgress )
import Distribution.Client.Dependency.Modular.Package
( PN )
import Distribution.Client.Dependency.Modular.Solver import Distribution.Client.Dependency.Modular.Solver
( defaultSolver ) ( defaultSolver )
import Distribution.Client.Dependency.Types import Distribution.Client.Dependency.Types
( DependencyResolver ) ( DependencyResolver, PackageConstraint(..) )
import Distribution.Client.InstallPlan import Distribution.Client.InstallPlan
( PlanPackage ) ( PlanPackage )
import Distribution.System import Distribution.System
...@@ -33,14 +35,18 @@ modularResolver :: DependencyResolver ...@@ -33,14 +35,18 @@ modularResolver :: DependencyResolver
modularResolver (Platform arch os) cid iidx sidx pprefs pcs pns = modularResolver (Platform arch os) cid iidx sidx pprefs pcs pns =
fmap (uncurry postprocess) $ -- convert install plan fmap (uncurry postprocess) $ -- convert install plan
logToProgress $ logToProgress $
defaultSolver idx gprefs uprefs goals gcs gfcs lfcs defaultSolver idx gprefs uprefs gcs pns gfcs
where where
idx = convPIs os arch cid iidx sidx idx = convPIs os arch cid iidx sidx
gprefs = M.empty -- global preferences gprefs = M.empty -- global preferences
uprefs = M.empty -- user preferences uprefs = M.empty -- user preferences
goals = pns -- goals/targets gcs = M.fromList (map (\ pc -> (pcName pc, pc)) pcs)
gcs = [] -- global constraints -- user constraints
gfcs = M.empty -- global flag choices gfcs = M.empty -- global flag choices
lfcs = M.empty -- local flag choices
postprocess :: Assignment -> RevDepMap -> [PlanPackage] postprocess :: Assignment -> RevDepMap -> [PlanPackage]
postprocess a rdm = map (convCP iidx sidx) (toCPs a rdm) postprocess a rdm = map (convCP iidx sidx) (toCPs a rdm)
pcName :: PackageConstraint -> PN
pcName (PackageConstraintVersion pn _) = pn
pcName (PackageConstraintInstalled pn ) = pn
pcName (PackageConstraintSource pn ) = pn
pcName (PackageConstraintFlags pn _) = pn
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment