Remove the package instance from D.Solver.Modular.Var (closes #4142).

cabal-install/Distribution/Solver/Modular/Assignment.hs

@@ -65,13 +65,13 @@ toCPs (A pa fa sa) rdm =
     -- complete flag assignment by package.
     fapp :: Map QPN FlagAssignment
     fapp = M.fromListWith (++) $
-           L.map (\ ((FN (PI qpn _) fn), b) -> (qpn, [(fn, b)])) $
+           L.map (\ ((FN qpn fn), b) -> (qpn, [(fn, b)])) $
            M.toList $
            fa
     -- Stanzas per package.
     sapp :: Map QPN [OptionalStanza]
     sapp = M.fromListWith (++) $
-           L.map (\ ((SN (PI qpn _) sn), b) -> (qpn, if b then [sn] else [])) $
+           L.map (\ ((SN qpn sn), b) -> (qpn, if b then [sn] else [])) $
            M.toList $
            sa
     -- Dependencies per package.

cabal-install/Distribution/Solver/Modular/Builder.hs

@@ -21,7 +21,7 @@ module Distribution.Solver.Modular.Builder (
 
 import Data.List as L
 import Data.Map as M
-import Prelude hiding (pi, sequence, mapM)
+import Prelude hiding (sequence, mapM)
 
 import Distribution.Solver.Modular.Dependency
 import Distribution.Solver.Modular.Flag
@@ -63,13 +63,13 @@ extendOpen qpn' gs s@(BS { rdeps = gs', open = o' }) = go gs' o' gs
   where
     go :: RevDepMap -> [OpenGoal] -> [PotentialGoal] -> BuildState
     go g o []                                             = s { rdeps = g, open = o }
-    go g o ((PotentialGoal (Flagged fn@(FN pi _) fInfo t f)  ) : ngs) =
-        go g (FlagGoal fn fInfo t f (flagGR pi) : o) ngs
+    go g o ((PotentialGoal (Flagged fn@(FN qpn _) fInfo t f)  ) : ngs) =
+        go g (FlagGoal fn fInfo t f (flagGR qpn) : o) ngs
       -- Note: for 'Flagged' goals, we always insert, so later additions win.
       -- This is important, because in general, if a goal is inserted twice,
       -- the later addition will have better dependency information.
-    go g o ((PotentialGoal (Stanza sn@(SN pi _) t)           ) : ngs) =
-        go g (StanzaGoal sn t (flagGR pi) : o) ngs
+    go g o ((PotentialGoal (Stanza sn@(SN qpn _) t)           ) : ngs) =
+        go g (StanzaGoal sn t (flagGR qpn) : o) ngs
     go g o ((PotentialGoal (Simple (LDep dr (Dep _ qpn _)) c)) : ngs)
       | qpn == qpn'       = go                            g               o  ngs
           -- we ignore self-dependencies at this point; TODO: more care may be needed
@@ -85,19 +85,19 @@ extendOpen qpn' gs s@(BS { rdeps = gs', open = o' }) = go gs' o' gs
 
     -- GoalReason for a flag or stanza. Each flag/stanza is introduced only by
     -- its containing package.
-    flagGR :: PI qpn -> GoalReason qpn
-    flagGR pi = DependencyGoal (DependencyReason pi [] [])
+    flagGR :: qpn -> GoalReason qpn
+    flagGR qpn = DependencyGoal (DependencyReason qpn [] [])
 
 -- | 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 -> FlaggedDeps PN -> FlagInfo ->
+scopedExtendOpen :: QPN -> FlaggedDeps PN -> FlagInfo ->
                     BuildState -> BuildState
-scopedExtendOpen qpn i fdeps fdefs s = extendOpen qpn gs s
+scopedExtendOpen qpn fdeps fdefs s = extendOpen qpn gs s
   where
     -- Qualify all package names
     qfdeps = qualifyDeps (qualifyOptions s) qpn fdeps
     -- Introduce all package flags
-    qfdefs = L.map (\ (fn, b) -> Flagged (FN (PI qpn i) fn) b [] []) $ M.toList fdefs
+    qfdefs = L.map (\ (fn, b) -> Flagged (FN qpn fn) b [] []) $ M.toList fdefs
     -- Combine new package and flag goals
     gs     = L.map PotentialGoal (qfdefs ++ qfdeps)
     -- NOTE:
@@ -107,9 +107,9 @@ scopedExtendOpen qpn i fdeps fdefs s = extendOpen qpn gs s
 
 -- | Datatype that encodes what to build next
 data BuildType =
-    Goals                -- ^ build a goal choice node
-  | OneGoal OpenGoal     -- ^ build a node for this goal
-  | Instance QPN I PInfo -- ^ build a tree for a concrete instance
+    Goals              -- ^ build a goal choice node
+  | OneGoal OpenGoal   -- ^ build a node for this goal
+  | Instance QPN PInfo -- ^ build a tree for a concrete instance
 
 build :: Linker BuildState -> Tree () QGoalReason
 build = ana go
@@ -142,13 +142,13 @@ addChildren bs@(BS { rdeps = rdm, index = idx, next = OneGoal (PkgGoal qpn@(Q _
   case M.lookup pn idx of
     Nothing  -> PChoiceF qpn rdm gr (W.fromList [])
     Just pis -> PChoiceF qpn rdm gr (W.fromList (L.map (\ (i, info) ->
-                                                       ([], POption i Nothing, bs { next = Instance qpn i info }))
+                                                       ([], POption i Nothing, bs { next = Instance qpn info }))
                                                      (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.
-addChildren bs@(BS { rdeps = rdm, next = OneGoal (FlagGoal qfn@(FN (PI qpn _) _) (FInfo b m w) t f gr) }) =
+addChildren bs@(BS { rdeps = rdm, next = OneGoal (FlagGoal qfn@(FN qpn _) (FInfo b m w) t f gr) }) =
   FChoiceF qfn rdm gr weak m b (W.fromList
     [([if b then 0 else 1], True,  (extendOpen qpn (L.map PotentialGoal t) bs) { next = Goals }),
      ([if b then 1 else 0], False, (extendOpen qpn (L.map PotentialGoal f) bs) { next = Goals })])
@@ -161,7 +161,7 @@ addChildren bs@(BS { rdeps = rdm, next = OneGoal (FlagGoal qfn@(FN (PI qpn _) _)
 -- the stanza by replacing the False branch with failure) or preferences
 -- (try enabling the stanza if possible by moving the True branch first).
 
-addChildren bs@(BS { rdeps = rdm, next = OneGoal (StanzaGoal qsn@(SN (PI qpn _) _) t gr) }) =
+addChildren bs@(BS { rdeps = rdm, next = OneGoal (StanzaGoal qsn@(SN qpn _) t gr) }) =
   SChoiceF qsn rdm gr trivial (W.fromList
     [([0], False,                                                                  bs  { next = Goals }),
      ([1], True,  (extendOpen qpn (L.map PotentialGoal t) bs) { next = Goals })])
@@ -172,8 +172,8 @@ addChildren bs@(BS { rdeps = rdm, next = OneGoal (StanzaGoal qsn@(SN (PI qpn _)
 -- and furthermore we update the set of goals.
 --
 -- TODO: We could inline this above.
-addChildren bs@(BS { next = Instance qpn i (PInfo fdeps fdefs _) }) =
-  addChildren ((scopedExtendOpen qpn i fdeps fdefs bs)
+addChildren bs@(BS { next = Instance qpn (PInfo fdeps fdefs _) }) =
+  addChildren ((scopedExtendOpen qpn fdeps fdefs bs)
          { next = Goals })
 
 {-------------------------------------------------------------------------------

cabal-install/Distribution/Solver/Modular/Cycles.hs

@@ -11,7 +11,6 @@ import qualified Distribution.Compat.Graph as G
 import Distribution.Simple.Utils (ordNub)
 import Distribution.Solver.Modular.Dependency
 import Distribution.Solver.Modular.Flag
-import Distribution.Solver.Modular.Package
 import Distribution.Solver.Modular.Tree
 import qualified Distribution.Solver.Modular.ConflictSet as CS
 import Distribution.Solver.Types.ComponentDeps (Component)
@@ -25,9 +24,9 @@ detectCyclesPhase = cata go
     go :: TreeF d c (Tree d c) -> Tree d c
     go (PChoiceF qpn rdm gr                         cs) =
         PChoice qpn rdm gr     $ fmap (checkChild qpn)   cs
-    go (FChoiceF qfn@(FN (PI qpn _) _) rdm gr w m d cs) =
+    go (FChoiceF qfn@(FN qpn _) rdm gr w m d cs) =
         FChoice qfn rdm gr w m d $ fmap (checkChild qpn) cs
-    go (SChoiceF qsn@(SN (PI qpn _) _) rdm gr w     cs) =
+    go (SChoiceF qsn@(SN qpn _) rdm gr w     cs) =
         SChoice qsn rdm gr w   $ fmap (checkChild qpn)   cs
     go x                                                = inn x
 

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

@@ -3,8 +3,8 @@
 module Distribution.Solver.Modular.Dependency (
     -- * Variables
     Var(..)
-  , varPI
   , showVar
+  , varPN
     -- * Conflict sets
   , ConflictSet
   , ConflictMap
@@ -128,32 +128,30 @@ data Dep qpn = Dep  IsExe qpn CI       -- ^ dependency on a package (possibly fo
 -- flag and stanza choices that introduced the dependency. It contains
 -- everything needed for creating ConflictSets or describing conflicts in solver
 -- log messages.
-data DependencyReason qpn = DependencyReason (PI qpn) [(Flag, FlagValue)] [Stanza]
+data DependencyReason qpn = DependencyReason qpn [(Flag, FlagValue)] [Stanza]
   deriving (Functor, Eq, Show)
 
--- | Print a dependency. The first parameter determines how to print the package
--- instance of the dependent package.
-showDep :: (PI QPN -> String) -> LDep QPN -> String
-showDep showPI' (LDep dr (Dep (IsExe is_exe) qpn (Fixed i)       )) =
-  let DependencyReason (PI qpn' _) _ _ = dr
-  in (if qpn /= qpn' then showDependencyReason showPI' dr ++ " => " else "") ++
+-- | Print a dependency.
+showDep :: LDep QPN -> String
+showDep (LDep dr (Dep (IsExe is_exe) qpn (Fixed i)       )) =
+  let DependencyReason qpn' _ _ = dr
+  in (if qpn /= qpn' then showDependencyReason dr ++ " => " else "") ++
      showQPN qpn ++
      (if is_exe then " (exe) " else "") ++ "==" ++ showI i
-showDep showPI' (LDep dr (Dep (IsExe is_exe) qpn (Constrained vr))) =
-  showDependencyReason showPI' dr ++ " => " ++ showQPN qpn ++
+showDep (LDep dr (Dep (IsExe is_exe) qpn (Constrained vr))) =
+  showDependencyReason dr ++ " => " ++ showQPN qpn ++
   (if is_exe then " (exe) " else "") ++ showVR vr
-showDep _ (LDep _ (Ext ext))   = "requires " ++ display ext
-showDep _ (LDep _ (Lang lang)) = "requires " ++ display lang
-showDep _ (LDep _ (Pkg pn vr)) = "requires pkg-config package "
+showDep (LDep _ (Ext ext))   = "requires " ++ display ext
+showDep (LDep _ (Lang lang)) = "requires " ++ display lang
+showDep (LDep _ (Pkg pn vr)) = "requires pkg-config package "
                       ++ display pn ++ display vr
                       ++ ", not found in the pkg-config database"
 
--- | Print the reason that a dependency was introduced. The first parameter
--- determines how to print the package instance.
-showDependencyReason :: (PI QPN -> String) -> DependencyReason QPN -> String
-showDependencyReason showPI' (DependencyReason pi flags stanzas) =
+-- | Print the reason that a dependency was introduced.
+showDependencyReason :: DependencyReason QPN -> String
+showDependencyReason (DependencyReason qpn flags stanzas) =
     intercalate " " $
-        showPI' pi
+        showQPN qpn
       : map (uncurry showFlagValue) flags ++ map (\s -> showSBool s True) stanzas
 
 -- | Options for goal qualification (used in 'qualifyDeps')
@@ -297,14 +295,14 @@ goalReasonToCS (DependencyGoal dr) = dependencyReasonToCS dr
 -- | This function returns the solver variables responsible for the dependency.
 -- It drops the flag and stanza values, which are only needed for log messages.
 dependencyReasonToCS :: DependencyReason QPN -> ConflictSet
-dependencyReasonToCS (DependencyReason pi@(PI qpn _) flags stanzas) =
+dependencyReasonToCS (DependencyReason qpn flags stanzas) =
     CS.fromList $ P qpn : flagVars ++ map stanzaToVar stanzas
   where
     -- Filter out any flags that introduced the dependency with both values.
     -- They don't need to be included in the conflict set, because changing the
     -- flag value can't remove the dependency.
     flagVars :: [Var QPN]
-    flagVars = [F (FN pi fn) | (fn, fv) <- flags, fv /= FlagBoth]
+    flagVars = [F (FN qpn fn) | (fn, fv) <- flags, fv /= FlagBoth]
 
     stanzaToVar :: Stanza -> Var QPN
-    stanzaToVar = S . SN pi
+    stanzaToVar = S . SN qpn

cabal-install/Distribution/Solver/Modular/Flag.hs

@@ -24,13 +24,12 @@ import Prelude hiding (pi)
 
 import qualified Distribution.PackageDescription as P -- from Cabal
 
-import Distribution.Solver.Modular.Package
 import Distribution.Solver.Types.Flag
 import Distribution.Solver.Types.OptionalStanza
 import Distribution.Solver.Types.PackagePath
 
 -- | Flag name. Consists of a package instance and the flag identifier itself.
-data FN qpn = FN (PI qpn) Flag
+data FN qpn = FN qpn Flag
   deriving (Eq, Ord, Show, Functor)
 
 -- | Flag identifier. Just a string.
@@ -58,7 +57,7 @@ type FlagInfo = Map Flag FInfo
 type QFN = FN QPN
 
 -- | Stanza name. Paired with a package name, much like a flag.
-data SN qpn = SN (PI qpn) Stanza
+data SN qpn = SN qpn Stanza
   deriving (Eq, Ord, Show, Functor)
 
 -- | Qualified stanza name.
@@ -84,10 +83,10 @@ data FlagValue = FlagTrue | FlagFalse | FlagBoth
   deriving (Eq, Show)
 
 showQFNBool :: QFN -> Bool -> String
-showQFNBool qfn@(FN pi _f) b = showPI pi ++ ":" ++ showFBool qfn b
+showQFNBool qfn@(FN qpn _f) b = showQPN qpn ++ ":" ++ showFBool qfn b
 
 showQSNBool :: QSN -> Bool -> String
-showQSNBool (SN pi f) b = showPI pi ++ ":" ++ showSBool f b
+showQSNBool (SN qpn s) b = showQPN qpn ++ ":" ++ showSBool s b
 
 showFBool :: FN qpn -> Bool -> String
 showFBool (FN _ f) v = P.showFlagValue (f, v)
@@ -103,7 +102,7 @@ showSBool s True  = "*" ++ showStanza s
 showSBool s False = "!" ++ showStanza s
 
 showQFN :: QFN -> String
-showQFN (FN pi f) = showPI pi ++ ":" ++ unFlag f
+showQFN (FN qpn f) = showQPN qpn ++ ":" ++ unFlag f
 
 showQSN :: QSN -> String
-showQSN (SN pi s) = showPI pi ++ ":" ++ showStanza s
+showQSN (SN qpn s) = showQPN qpn ++ ":" ++ showStanza s