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 <[email protected]> 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)) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
