[commit: Cabal] master: Update types in modular dependency solver to compile with new test/benchmark dependency constraints. (33af02d)
Ian Lynagh
igloo at earth.li
Fri Feb 17 20:34:11 CET 2012
Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/33af02d2369ab88f5847629f971e65fe5647f3e3
>---------------------------------------------------------------
commit 33af02d2369ab88f5847629f971e65fe5647f3e3
Author: Thomas Tuegel <ttuegel at gmail.com>
Date: Tue Feb 7 19:45:43 2012 +0000
Update types in modular dependency solver to compile with new test/benchmark dependency constraints.
>---------------------------------------------------------------
.../Client/Dependency/Modular/Assignment.hs | 9 ++++++---
.../Client/Dependency/Modular/Configured.hs | 3 ++-
.../Dependency/Modular/ConfiguredConversion.hs | 3 ++-
.../Client/Dependency/Modular/Explore.hs | 20 ++++++++++----------
4 files changed, 20 insertions(+), 15 deletions(-)
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs b/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs
index 3766eac..fc6a0b5 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs
@@ -10,6 +10,7 @@ import Data.Graph
import Prelude hiding (pi)
import Distribution.PackageDescription (FlagAssignment) -- from Cabal
+import Distribution.Client.Types (OptionalStanza)
import Distribution.Client.Dependency.Modular.Configured
import Distribution.Client.Dependency.Modular.Dependency
@@ -28,9 +29,10 @@ type PAssignment = Map QPN I
-- and in the extreme case fix a concrete instance.
type PPreAssignment = Map QPN (CI QPN)
type FAssignment = Map QFN Bool
+type SAssignment = Map QPN [OptionalStanza]
-- | A (partial) assignment of variables.
-data Assignment = A PAssignment FAssignment
+data Assignment = A PAssignment FAssignment SAssignment
deriving (Show, Eq)
-- | A preassignment comprises knowledge about variables, but not
@@ -64,7 +66,7 @@ extend var pa qa = foldM (\ a (Dep qpn ci) ->
-- of one package version chosen by the solver, which will lead to
-- clashes.
toCPs :: Assignment -> RevDepMap -> [CP QPN]
-toCPs (A pa fa) rdm =
+toCPs (A pa fa sa) rdm =
let
-- get hold of the graph
g :: Graph
@@ -99,6 +101,7 @@ toCPs (A pa fa) rdm =
in
L.map (\ pi@(PI qpn _) -> CP pi
(M.findWithDefault [] qpn fapp)
+ (M.findWithDefault [] qpn sa)
(depp qpn))
ps
@@ -106,7 +109,7 @@ toCPs (A pa fa) rdm =
--
-- This is preliminary, and geared towards output right now.
finalize :: Index -> Assignment -> RevDepMap -> IO ()
-finalize idx (A pa fa) rdm =
+finalize idx (A pa fa _) rdm =
let
-- get hold of the graph
g :: Graph
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Configured.hs b/cabal-install/Distribution/Client/Dependency/Modular/Configured.hs
index 191d160..d6f2bc2 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Configured.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Configured.hs
@@ -1,9 +1,10 @@
module Distribution.Client.Dependency.Modular.Configured where
import Distribution.PackageDescription (FlagAssignment) -- from Cabal
+import Distribution.Client.Types (OptionalStanza)
import Distribution.Client.Dependency.Modular.Package
-- | A configured package is a package instance together with
-- a flag assignment and complete dependencies.
-data CP qpn = CP (PI qpn) FlagAssignment [PI qpn]
+data CP qpn = CP (PI qpn) FlagAssignment [OptionalStanza] [PI qpn]
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs b/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs
index 25e2fc3..58e08a3 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs
@@ -21,7 +21,7 @@ mkPlan plat comp iidx sidx cps =
convCP :: SI.PackageIndex -> CI.PackageIndex SourcePackage ->
CP QPN -> PlanPackage
-convCP iidx sidx (CP qpi fa ds) =
+convCP iidx sidx (CP qpi fa es ds) =
case convPI qpi of
Left pi -> PreExisting $ InstalledPackage
(fromJust $ SI.lookupInstalledPackageId iidx pi)
@@ -29,6 +29,7 @@ convCP iidx sidx (CP qpi fa ds) =
Right pi -> Configured $ ConfiguredPackage
(fromJust $ CI.lookupPackageId sidx pi)
fa
+ es
(map convPI' ds)
convPI :: PI QPN -> Either InstalledPackageId PackageId
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Explore.hs b/cabal-install/Distribution/Client/Dependency/Modular/Explore.hs
index 1f1b3ee..4d90123 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Explore.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Explore.hs
@@ -74,15 +74,15 @@ explore = cata go
where
go (FailF _ _) _ = A.empty
go (DoneF rdm) a = pure (a, rdm)
- go (PChoiceF qpn _ ts) (A pa fa) =
+ go (PChoiceF qpn _ ts) (A pa fa sa) =
asum $ -- try children in order,
P.mapWithKey -- when descending ...
- (\ k r -> r (A (M.insert qpn k pa) fa)) $ -- record the pkg choice
+ (\ k r -> r (A (M.insert qpn k pa) fa sa)) $ -- record the pkg choice
ts
- go (FChoiceF qfn _ _ ts) (A pa fa) =
+ go (FChoiceF qfn _ _ ts) (A pa fa sa) =
asum $ -- try children in order,
P.mapWithKey -- when descending ...
- (\ k r -> r (A pa (M.insert qfn k fa))) $ -- record the flag choice
+ (\ k r -> r (A pa (M.insert qfn k fa) sa)) $ -- record the flag choice
ts
go (GoalChoiceF ts) a =
casePSQ ts A.empty -- empty goal choice is an internal error
@@ -94,19 +94,19 @@ exploreLog = cata go
where
go (FailF c fr) _ = failWith (Failure c fr)
go (DoneF rdm) a = succeedWith Success (a, rdm)
- go (PChoiceF qpn c ts) (A pa fa) =
+ go (PChoiceF qpn c ts) (A pa fa sa) =
backjumpInfo c $
asum $ -- try children in order,
P.mapWithKey -- when descending ...
(\ k r -> tryWith (TryP (PI qpn k)) $ -- log and ...
- r (A (M.insert qpn k pa) fa)) -- record the pkg choice
+ r (A (M.insert qpn k pa) fa sa)) -- record the pkg choice
ts
- go (FChoiceF qfn c _ ts) (A pa fa) =
+ go (FChoiceF qfn c _ ts) (A pa fa sa) =
backjumpInfo c $
asum $ -- try children in order,
P.mapWithKey -- when descending ...
(\ k r -> tryWith (TryF qfn k) $ -- log and ...
- r (A pa (M.insert qfn k fa))) -- record the pkg choice
+ r (A pa (M.insert qfn k fa) sa)) -- record the pkg choice
ts
go (GoalChoiceF ts) a =
casePSQ ts
@@ -126,8 +126,8 @@ backjumpInfo c m = m <|> case c of -- important to produce 'm' before matching o
-- | Interface.
exploreTree :: Alternative m => Tree a -> m (Assignment, RevDepMap)
-exploreTree t = explore t (A M.empty M.empty)
+exploreTree t = explore t (A M.empty M.empty M.empty)
-- | Interface.
exploreTreeLog :: Tree (Maybe (ConflictSet QPN)) -> Log Message (Assignment, RevDepMap)
-exploreTreeLog t = exploreLog t (A M.empty M.empty)
+exploreTreeLog t = exploreLog t (A M.empty M.empty M.empty)
More information about the Cvs-libraries
mailing list