[commit: Cabal] master: refactoring: change the way tree annotations are handled (e1ea7b8)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/e1ea7b80b48fd8b07e904856d592d6434f61f5ea

>---------------------------------------------------------------

commit e1ea7b80b48fd8b07e904856d592d6434f61f5ea
Author: Andres Loeh <andres at well-typed.com>
Date:   Mon Jun 20 14:36:41 2011 +0000

    refactoring: change the way tree annotations are handled

>---------------------------------------------------------------

 .../Client/Dependency/Modular/Builder.hs           |    6 +++---
 .../Distribution/Client/Dependency/Modular/Tree.hs |    7 -------
 .../Client/Dependency/Modular/Validate.hs          |   18 ++++++++++--------
 3 files changed, 13 insertions(+), 18 deletions(-)

diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs b/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs
index 7b1bbeb..842860e 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs
@@ -60,10 +60,10 @@ scopedExtendOpen qpn i gr fdeps fdefs s = extendOpen qpn gs s
 
 data BuildType = Goals | OneGoal Goal | Instance QPN I PInfo
 
-build :: BuildState -> Tree Info
+build :: BuildState -> Tree Scope
 build = ana go
   where
-    go :: BuildState -> TreeF Info BuildState
+    go :: BuildState -> TreeF Scope BuildState
 
     -- If we have a choice between many goals, we just record the choice in
     -- the tree. We select each open goal in turn, and before we descend, remove
@@ -111,7 +111,7 @@ build = ana go
 
 -- | Interface to the tree builder. Just takes an index and a list of package names,
 -- and computes the initial state and then the tree from there.
-buildTree :: Index -> [PN] -> Tree Info
+buildTree :: Index -> [PN] -> Tree Scope
 buildTree idx igs =
     build (BS idx emptyScope
                   (M.fromList (L.map (\ qpn -> (qpn, []))                                               qpns))
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs b/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs
index 5772c74..22afcba 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Tree.hs
@@ -12,13 +12,6 @@ import Distribution.Client.Dependency.Modular.Package
 import Distribution.Client.Dependency.Modular.PSQ as P
 import Distribution.Client.Dependency.Modular.Version
 
--- | All sorts of helpful information we can store in a tree.
-type Info = Scope -- for the time being
-
--- | Type of variables.
-data Var = PVar QPN | FVar QFN
-  deriving (Eq, Show)
-
 -- | Goals are qualified flagged dependencies, together with a reason for
 -- their presence.
 data Goal = Goal (FlaggedDep QPN) GoalReason
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs b/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs
index 0eedc96..8e36cdc 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs
@@ -80,19 +80,21 @@ data ValidateState = VS {
 
 type Validate = Reader ValidateState
 
-validate :: Tree Scope -> Validate (Tree Scope)
+validate :: Tree Scope -> Validate (Tree ())
 validate = cata go
   where
-    go :: TreeF Scope (Validate (Tree Scope)) -> Validate (Tree Scope)
+    go :: TreeF Scope (Validate (Tree ())) -> Validate (Tree ())
 
-    go (PChoiceF qpn sc   ts) = PChoice qpn sc   <$> sequence (P.mapWithKey (goP qpn sc) ts)
-    go (FChoiceF qfn sc b ts) = FChoice qfn sc b <$> sequence (P.mapWithKey (goF qfn sc) ts)
+    go (PChoiceF qpn sc   ts) = PChoice qpn ()   <$> sequence (P.mapWithKey (goP qpn sc) ts)
+    go (FChoiceF qfn sc b ts) = FChoice qfn () b <$> sequence (P.mapWithKey (goF qfn sc) ts)
 
     -- We don't need to do anything for goal choices or failure nodes.
-    go t = inn <$> sequence t
+    go (GoalChoiceF  _    ts) = GoalChoice  ()   <$> sequence ts
+    go (DoneF    rdm        ) = pure (Done rdm)
+    go (FailF    c fr       ) = pure (Fail c fr)
 
     -- What to do for package nodes ...
-    goP :: QPN -> Scope -> I -> Validate (Tree Scope) -> Validate (Tree Scope)
+    goP :: QPN -> Scope -> I -> Validate (Tree ()) -> Validate (Tree ())
     goP qpn@(Q _pp pn) sc i r = do
       PA ppa pfa <- asks pa    -- obtain current preassignment
       idx        <- asks index -- obtain the index
@@ -113,7 +115,7 @@ validate = cata go
                        local (\ s -> s { pa = PA nppa pfa, saved = nsvd }) r
 
     -- What to do for flag nodes ...
-    goF :: QFN -> Scope -> Bool -> Validate (Tree Scope) -> Validate (Tree Scope)
+    goF :: QFN -> Scope -> Bool -> Validate (Tree ()) -> Validate (Tree ())
     goF qfn@(FN (PI qpn _i) _f) _sc b r = do
       PA ppa pfa <- asks pa -- obtain current preassignment
       svd <- asks saved     -- obtain saved dependencies
@@ -169,5 +171,5 @@ extractNewFlagDeps qfn b fa deps = do
                               Just False -> extractNewFlagDeps qfn b fa fd
 
 -- | Interface.
-validateTree :: Index -> Tree Scope -> Tree Scope
+validateTree :: Index -> Tree Scope -> Tree ()
 validateTree idx t = runReader (validate t) (VS idx M.empty (PA M.empty M.empty))