Abstract out qualification of goals

This happened independently in a number of places, which was bad; and was about
to get worse with the base 3/4 thing.

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

@@ -16,7 +16,6 @@ module Distribution.Client.Dependency.Modular.Builder (buildTree) where
 -- flag-guarded dependencies, we cannot introduce them immediately. Instead, we
 -- store the entire dependency.
 
-import Control.Monad.Reader hiding (sequence, mapM)
 import Data.List as L
 import Data.Map as M
 import Prelude hiding (sequence, mapM)
@@ -65,19 +64,10 @@ extendOpen qpn' gs s@(BS { rdeps = gs', open = o' }) = go gs' o' gs
 -- dependencies and then extend the set of open goals accordingly.
 scopedExtendOpen :: QPN -> I -> QGoalReasonChain -> FlaggedDeps Component PN -> FlagInfo ->
                     BuildState -> BuildState
-scopedExtendOpen qpn@(Q pp pn) i gr fdeps fdefs s = extendOpen qpn gs s
+scopedExtendOpen qpn i gr fdeps fdefs s = extendOpen qpn gs s
   where
     -- Qualify all package names
-    --
-    -- NOTE: We `fmap` over the setup dependencies to qualify the package name,
-    -- BUT this is _only_ correct because the setup dependencies cannot have
-    -- conditional sections (setup dependencies cannot depend on flags). IF
-    -- setup dependencies _could_ depend on flags, then these flag names should
-    -- NOT be qualified with @Q (Setup pn pp)@ but rather with @pp@: flag
-    -- assignments are package wide, irrespective of whether or not we treat
-    -- certain dependencies as independent or not.
-    qfdeps = L.map (fmap (Q pp))            (nonSetupDeps fdeps)
-          ++ L.map (fmap (Q (Setup pn pp))) (setupDeps    fdeps)
+    qfdeps = qualifyDeps qpn fdeps
     -- 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

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

@@ -18,6 +18,7 @@ module Distribution.Client.Dependency.Modular.Dependency (
   , FalseFlaggedDeps
   , Dep(..)
   , showDep
+  , qualifyDeps
     -- ** Setting/forgetting components
   , forgetCompOpenGoal
   , setCompFlaggedDeps
@@ -191,6 +192,21 @@ showDep (Dep qpn (Constrained [(vr, Goal v _)])) =
 showDep (Dep qpn ci                            ) =
   showQPN qpn ++ showCI ci
 
+-- | Apply built-in rules for package qualifiers
+--
+-- NOTE: We `fmap` over the setup dependencies to qualify the package name, BUT
+-- this is _only_ correct because the setup dependencies cannot have conditional
+-- sections (setup dependencies cannot depend on flags). IF setup dependencies
+-- _could_ depend on flags, then these flag names should NOT be qualified with
+-- @Q (Setup pn pp)@ but rather with @pp@: flag assignments are package wide,
+-- irrespective of whether or not we treat certain dependencies as independent
+-- or not.
+qualifyDeps :: QPN -> FlaggedDeps Component PN -> FlaggedDeps Component QPN
+qualifyDeps (Q pp pn) deps = concat [
+      map (fmap (Q pp))            (nonSetupDeps deps)
+    , map (fmap (Q (Setup pn pp))) (setupDeps    deps)
+    ]
+
 {-------------------------------------------------------------------------------
   Setting/forgetting the Component
 -------------------------------------------------------------------------------}

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

@@ -116,11 +116,10 @@ validateLinking index = (`runReader` initVS) . cata go
 
     -- Package choices
     goP :: QPN -> POption -> Validate (Tree QGoalReasonChain) -> Validate (Tree QGoalReasonChain)
-    goP qpn@(Q pp pn) opt@(POption i _) r = do
+    goP qpn@(Q _pp pn) opt@(POption i _) r = do
       vs <- ask
       let PInfo deps _ _ = vsIndex vs ! pn ! i
-          qdeps          = map (fmap (Q pp))            (nonSetupDeps deps)
-                        ++ map (fmap (Q (Setup pn pp))) (setupDeps    deps)
+          qdeps          = qualifyDeps qpn deps
       case execUpdateState (pickPOption qpn opt qdeps) vs of
         Left  (cs, err) -> return $ Fail cs (DependenciesNotLinked err)
         Right vs'       -> local (const vs') r
@@ -254,8 +253,7 @@ linkNewDeps var b = do
     vs <- get
     let (qpn@(Q pp pn), Just i) = varPI var
         PInfo deps _ _          = vsIndex vs ! pn ! i
-        qdeps                   = map (fmap (Q pp))            (nonSetupDeps deps)
-                               ++ map (fmap (Q (Setup pn pp))) (setupDeps    deps)
+        qdeps                   = qualifyDeps qpn deps
         lg                      = vsLinks vs ! qpn
         (parents, newDeps)      = findNewDeps vs qdeps
         linkedTo                = S.delete pp (lgMembers lg)

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

@@ -103,6 +103,5 @@ makeIndependent ps = [ Q pp pn | (pn, i) <- zip ps [0::Int ..]
                                , let pp = Independent i None
                      ]
 
-
 unQualify :: Q a -> a
 unQualify (Q _ x) = x

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

@@ -120,15 +120,14 @@ validate = cata go
 
     -- What to do for package nodes ...
     goP :: QPN -> QGoalReasonChain -> POption -> Validate (Tree QGoalReasonChain) -> Validate (Tree QGoalReasonChain)
-    goP qpn@(Q pp pn) gr (POption i _) r = do
+    goP qpn@(Q _pp pn) gr (POption i _) r = do
       PA ppa pfa psa <- asks pa    -- obtain current preassignment
       idx            <- asks index -- obtain the index
       svd            <- asks saved -- obtain saved dependencies
       -- obtain dependencies and index-dictated exclusions introduced by the choice
       let (PInfo deps _ mfr) = idx ! pn ! i
       -- qualify the deps in the current scope
-      let qdeps = L.map (fmap (Q pp))            (nonSetupDeps deps)
-               ++ L.map (fmap (Q (Setup pn pp))) (setupDeps    deps)
+      let qdeps = qualifyDeps qpn deps
       -- the new active constraints are given by the instance we have chosen,
       -- plus the dependency information we have for that instance
       let goal = Goal (P qpn) gr