Use standard graph construction in PlanIndex

cabal-install/Distribution/Client/Dependency.hs

@@ -513,12 +513,12 @@ resolveDependencies :: Platform
     --TODO: is this needed here? see dontUpgradeNonUpgradeablePackages
 resolveDependencies platform comp _solver params
   | null (depResolverTargets params)
-  = return (mkInstallPlan platform comp [])
+  = return (mkInstallPlan platform comp (depResolverIndependentGoals params) [])
 
 resolveDependencies platform comp  solver params =
 
     Step (debugDepResolverParams finalparams)
-  $ fmap (mkInstallPlan platform comp)
+  $ fmap (mkInstallPlan platform comp indGoals)
   $ runSolver solver (SolverConfig reorderGoals indGoals noReinstalls
                       shadowing strFlags maxBkjumps)
                      platform comp installedPkgIndex sourcePkgIndex
@@ -553,10 +553,11 @@ resolveDependencies platform comp  solver params =
 --
 mkInstallPlan :: Platform
               -> CompilerInfo
+              -> Bool
               -> [InstallPlan.PlanPackage] -> InstallPlan
-mkInstallPlan platform comp pkgIndex =
+mkInstallPlan platform comp indepGoals pkgIndex =
   let index = InstalledPackageIndex.fromList pkgIndex in
-  case InstallPlan.new platform comp index of
+  case InstallPlan.new platform comp indepGoals index of
     Right plan     -> plan
     Left  problems -> error $ unlines $
         "internal error: could not construct a valid install plan."

cabal-install/Distribution/Client/Dependency/Modular/Builder.hs

@@ -1,4 +1,4 @@
-module Distribution.Client.Dependency.Modular.Builder where
+module Distribution.Client.Dependency.Modular.Builder (buildTree) where
 
 -- Building the search tree.
 --
@@ -30,7 +30,6 @@ import Distribution.Client.Dependency.Modular.Tree
 -- | The state needed during the build phase of the search tree.
 data BuildState = BS {
   index :: Index,           -- ^ information about packages and their dependencies
-  scope :: Scope,           -- ^ information about encapsulations
   rdeps :: RevDepMap,       -- ^ set of all package goals, completed and open, with reverse dependencies
   open  :: PSQ OpenGoal (), -- ^ set of still open goals (flag and package goals)
   next  :: BuildType        -- ^ kind of node to generate next
@@ -57,23 +56,14 @@ extendOpen qpn' gs s@(BS { rdeps = gs', open = o' }) = go gs' o' gs
       | otherwise                                         = go (M.insert qpn [qpn']  g) (cons ng () o) ngs
                                        -- code above is correct; insert/adjust have different arg order
 
--- | Update the current scope by taking into account the encapsulations that
--- are defined for the current package.
-establishScope :: QPN -> Encaps -> BuildState -> BuildState
-establishScope (Q pp pn) ecs s =
-    s { scope = L.foldl (\ m e -> M.insert e pp' m) (scope s) ecs }
-  where
-    pp' = pn : pp -- new path
-
 -- | Given the current scope, qualify all the package names in the given set of
 -- dependencies and then extend the set of open goals accordingly.
 scopedExtendOpen :: QPN -> I -> QGoalReasonChain -> FlaggedDeps PN -> FlagInfo ->
                     BuildState -> BuildState
-scopedExtendOpen qpn i gr fdeps fdefs s = extendOpen qpn gs s
+scopedExtendOpen qpn@(Q pp _pn) i gr fdeps fdefs s = extendOpen qpn gs s
   where
-    sc     = scope s
     -- Qualify all package names
-    qfdeps = L.map (fmap (qualify sc)) fdeps -- qualify all the package names
+    qfdeps = L.map (fmap (Q pp)) fdeps -- qualify all the package names
     -- Introduce all package flags
     qfdefs = L.map (\ (fn, b) -> Flagged (FN (PI qpn i) fn) b [] []) $ M.toList fdefs
     -- Combine new package and flag goals
@@ -101,10 +91,10 @@ data BuildType =
   | Instance QPN I PInfo QGoalReasonChain  -- ^ build a tree for a concrete instance
   deriving Show
 
-build :: BuildState -> Tree (QGoalReasonChain, Scope)
+build :: BuildState -> Tree QGoalReasonChain
 build = ana go
   where
-    go :: BuildState -> TreeF (QGoalReasonChain, Scope) BuildState
+    go :: BuildState -> TreeF QGoalReasonChain 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
@@ -119,29 +109,29 @@ build = ana go
     --
     -- For a package, we look up the instances available in the global info,
     -- and then handle each instance in turn.
-    go bs@(BS { index = idx, scope = sc, next = OneGoal (OpenGoal (Simple (Dep qpn@(Q _ pn) _)) gr) }) =
+    go bs@(BS { index = idx, next = OneGoal (OpenGoal (Simple (Dep qpn@(Q _ pn) _)) gr) }) =
       case M.lookup pn idx of
         Nothing  -> FailF (toConflictSet (Goal (P qpn) gr)) (BuildFailureNotInIndex pn)
-        Just pis -> PChoiceF qpn (gr, sc) (P.fromList (L.map (\ (i, info) ->
-                                                           (i, bs { next = Instance qpn i info gr }))
+        Just pis -> PChoiceF qpn gr (P.fromList (L.map (\ (i, info) ->
+                                                           (POption i Nothing, bs { next = Instance qpn i info gr }))
                                                          (M.toList pis)))
           -- TODO: data structure conversion is rather ugly here
 
     -- For a flag, we create only two subtrees, and we create them in the order
     -- that is indicated by the flag default.
     --
     -- TODO: Should we include the flag default in the tree?
-    go bs@(BS { scope = sc, next = OneGoal (OpenGoal (Flagged qfn@(FN (PI qpn _) _) (FInfo b m w) t f) gr) }) =
-      FChoiceF qfn (gr, sc) (w || trivial) m (P.fromList (reorder b
+    go bs@(BS { next = OneGoal (OpenGoal (Flagged qfn@(FN (PI qpn _) _) (FInfo b m w) t f) gr) }) =
+      FChoiceF qfn gr (w || trivial) m (P.fromList (reorder b
         [(True,  (extendOpen qpn (L.map (flip OpenGoal (FDependency qfn True  : gr)) t) bs) { next = Goals }),
          (False, (extendOpen qpn (L.map (flip OpenGoal (FDependency qfn False : gr)) f) bs) { next = Goals })]))
       where
         reorder True  = id
         reorder False = reverse
         trivial = L.null t && L.null f
 
-    go bs@(BS { scope = sc, next = OneGoal (OpenGoal (Stanza qsn@(SN (PI qpn _) _) t) gr) }) =
-      SChoiceF qsn (gr, sc) trivial (P.fromList
+    go bs@(BS { next = OneGoal (OpenGoal (Stanza qsn@(SN (PI qpn _) _) t) gr) }) =
+      SChoiceF qsn gr trivial (P.fromList
         [(False,                                                                        bs  { next = Goals }),
          (True,  (extendOpen qpn (L.map (flip OpenGoal (SDependency qsn : gr)) t) bs) { next = Goals })])
       where
@@ -151,20 +141,17 @@ build = ana go
     -- and furthermore we update the set of goals.
     --
     -- TODO: We could inline this above.
-    go bs@(BS { next = Instance qpn i (PInfo fdeps fdefs ecs _) gr }) =
-      go ((establishScope qpn ecs
-             (scopedExtendOpen qpn i (PDependency (PI qpn i) : gr) fdeps fdefs bs))
+    go bs@(BS { next = Instance qpn i (PInfo fdeps fdefs _) gr }) =
+      go ((scopedExtendOpen qpn i (PDependency (PI qpn i) : gr) fdeps fdefs bs)
              { next = Goals })
 
 -- | 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 -> Bool -> [PN] -> Tree (QGoalReasonChain, Scope)
+buildTree :: Index -> Bool -> [PN] -> Tree QGoalReasonChain
 buildTree idx ind igs =
-    build (BS idx sc
-                  (M.fromList (L.map (\ qpn -> (qpn, []))                                                     qpns))
+    build (BS idx (M.fromList (L.map (\ qpn -> (qpn, []))                                                     qpns))
                   (P.fromList (L.map (\ qpn -> (OpenGoal (Simple (Dep qpn (Constrained []))) [UserGoal], ())) qpns))
                   Goals)
   where
-    sc | ind       = makeIndependent igs
-       | otherwise = emptyScope
-    qpns           = L.map (qualify sc) igs
+    qpns | ind       = makeIndependent igs
+         | otherwise = L.map (Q None) igs

cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs

@@ -13,11 +13,11 @@ import Distribution.System
 import Distribution.Client.Dependency.Modular.Configured
 import Distribution.Client.Dependency.Modular.Package
 
-mkPlan :: Platform -> CompilerInfo ->
+mkPlan :: Platform -> CompilerInfo -> Bool ->
           SI.InstalledPackageIndex -> CI.PackageIndex SourcePackage ->
           [CP QPN] -> Either [PlanProblem] InstallPlan
-mkPlan plat comp iidx sidx cps =
-  new plat comp (SI.fromList (map (convCP iidx sidx) cps))
+mkPlan plat comp indepGoals iidx sidx cps =
+  new plat comp indepGoals (SI.fromList (map (convCP iidx sidx) cps))
 
 convCP :: SI.InstalledPackageIndex -> CI.PackageIndex SourcePackage ->
           CP QPN -> PlanPackage

cabal-install/Distribution/Client/Dependency/Modular/Explore.hs

@@ -80,7 +80,7 @@ explore = cata go
     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 sa)) -- record the pkg choice
+        (\ (POption k _) r -> r (A (M.insert qpn k pa) fa sa)) -- record the pkg choice
       ts
     go (FChoiceF qfn _ _ _ ts) (A pa fa sa)   =
       asum $                                      -- try children in order,
@@ -107,7 +107,7 @@ exploreLog = cata go
       backjumpInfo c $
       asum $                                      -- try children in order,
       P.mapWithKey                                -- when descending ...
-        (\ k r -> tryWith (TryP (PI qpn k)) $     -- log and ...
+        (\ i@(POption k _) r -> tryWith (TryP qpn i) $     -- log and ...
                     r (A (M.insert qpn k pa) fa sa)) -- record the pkg choice
       ts
     go (FChoiceF qfn c _ _ ts) (A pa fa sa)   =

cabal-install/Distribution/Client/Dependency/Modular/Index.hs

@@ -15,17 +15,14 @@ import Distribution.Client.Dependency.Modular.Tree
 type Index = Map PN (Map I PInfo)
 
 -- | Info associated with a package instance.
--- Currently, dependencies, flags, encapsulations and failure reasons.
+-- Currently, dependencies, flags and failure reasons.
 -- Packages that have a failure reason recorded for them are disabled
 -- globally, for reasons external to the solver. We currently use this
 -- for shadowing which essentially is a GHC limitation, and for
 -- installed packages that are broken.
-data PInfo = PInfo (FlaggedDeps PN) FlagInfo Encaps (Maybe FailReason)
+data PInfo = PInfo (FlaggedDeps PN) FlagInfo (Maybe FailReason)
   deriving (Show)
 
--- | Encapsulations. A list of package names.
-type Encaps = [PN]
-
 mkIndex :: [(PN, I, PInfo)] -> Index
 mkIndex xs = M.map M.fromList (groupMap (L.map (\ (pn, i, pi) -> (pn, (i, pi))) xs))
 

cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs

@@ -49,8 +49,8 @@ convIPI' sip idx =
   where
 
     -- shadowing is recorded in the package info
-    shadow (pn, i, PInfo fdeps fds encs _) | sip = (pn, i, PInfo fdeps fds encs (Just Shadowed))
-    shadow x                                     = x
+    shadow (pn, i, PInfo fdeps fds _) | sip = (pn, i, PInfo fdeps fds (Just Shadowed))
+    shadow x                                = x
 
 convIPI :: Bool -> SI.InstalledPackageIndex -> Index
 convIPI sip = mkIndex . convIPI' sip
@@ -62,8 +62,8 @@ convIP idx ipi =
       i = I (pkgVersion (sourcePackageId ipi)) (Inst ipid)
       pn = pkgName (sourcePackageId ipi)
   in  case mapM (convIPId pn idx) (IPI.depends ipi) of
-        Nothing  -> (pn, i, PInfo [] M.empty [] (Just Broken))
-        Just fds -> (pn, i, PInfo fds M.empty [] Nothing)
+        Nothing  -> (pn, i, PInfo []  M.empty (Just Broken))
+        Just fds -> (pn, i, PInfo fds M.empty Nothing)
 -- TODO: Installed packages should also store their encapsulations!
 
 -- | Convert dependencies specified by an installed package id into
@@ -119,7 +119,6 @@ convGPD os arch comp strfl pi
       prefix (Stanza (SN pi BenchStanzas))
         (L.map     (convCondTree os arch comp pi fds (const True)     . snd) benchs))
       fds
-      [] -- TODO: add encaps
       Nothing
 
 prefix :: (FlaggedDeps qpn -> FlaggedDep qpn) -> [FlaggedDeps qpn] -> FlaggedDeps qpn