refactor(cabal-install-solver)!: remove base shim

- Remove QualifiyOptions

Remove QualifyOptions by setting qoSetupIndependent to be always true (the
current default) and qoBaseShim false (this must have been just a hack of some
sort).

Author: andreabedini

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

@@ -50,8 +50,7 @@ data BuildState = BS {
   index :: Index,                   -- ^ information about packages and their dependencies
   rdeps :: RevDepMap,               -- ^ set of all package goals, completed and open, with reverse dependencies
   open  :: [OpenGoal],              -- ^ set of still open goals (flag and package goals)
-  next  :: BuildType,               -- ^ kind of node to generate next
-  qualifyOptions :: QualifyOptions  -- ^ qualification options
+  next  :: BuildType                -- ^ kind of node to generate next
 }
 
 -- | Map of available linking targets.
@@ -105,7 +104,7 @@ scopedExtendOpen :: QPN -> FlaggedDeps PN -> FlagInfo ->
 scopedExtendOpen qpn fdeps fdefs s = extendOpen qpn gs s
   where
     -- Qualify all package names
-    qfdeps = qualifyDeps (qualifyOptions s) qpn fdeps
+    qfdeps = qualifyDeps qpn fdeps
     -- Introduce all package flags
     qfdefs = L.map (\ (fn, b) -> Flagged (FN qpn fn) b [] []) $ M.toList fdefs
     -- Combine new package and flag goals
@@ -255,7 +254,6 @@ buildTree idx (IndependentGoals ind) igs =
           , rdeps = M.fromList (L.map (\ qpn -> (qpn, []))              qpns)
           , open  = L.map topLevelGoal qpns
           , next  = Goals
-          , qualifyOptions = defaultQualifyOptions idx
           }
       , linkingState = M.empty
       }

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

@@ -1,34 +1,38 @@
 {-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE RecordWildCards #-}
-module Distribution.Solver.Modular.Dependency (
-    -- * Variables
-    Var(..)
+
+module Distribution.Solver.Modular.Dependency
+  ( -- * Variables
+    Var (..)
   , showVar
   , varPN
+
     -- * Conflict sets
   , ConflictSet
   , ConflictMap
   , CS.showConflictSet
+
     -- * Constrained instances
-  , CI(..)
+  , CI (..)
+
     -- * Flagged dependencies
   , FlaggedDeps
-  , FlaggedDep(..)
-  , LDep(..)
-  , Dep(..)
-  , PkgComponent(..)
-  , ExposedComponent(..)
-  , DependencyReason(..)
+  , FlaggedDep (..)
+  , LDep (..)
+  , Dep (..)
+  , PkgComponent (..)
+  , ExposedComponent (..)
+  , DependencyReason (..)
   , showDependencyReason
   , flattenFlaggedDeps
-  , QualifyOptions(..)
   , qualifyDeps
   , unqualifyDeps
+
     -- * Reverse dependency map
   , RevDepMap
+
     -- * Goals
-  , Goal(..)
-  , GoalReason(..)
+  , Goal (..)
+  , GoalReason (..)
   , QGoalReason
   , goalToVar
   , varToConflictSet
@@ -39,21 +43,21 @@ module Distribution.Solver.Modular.Dependency (
   , dependencyReasonToConflictSetWithVersionConflict
   ) where
 
-import Prelude ()
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Distribution.Solver.Compat.Prelude hiding (pi)
+import Prelude ()
 
-import Language.Haskell.Extension (Extension(..), Language(..))
+import Language.Haskell.Extension (Extension (..), Language (..))
 
-import Distribution.Solver.Modular.ConflictSet (ConflictSet, ConflictMap)
+import Distribution.Solver.Modular.ConflictSet (ConflictMap, ConflictSet)
+import qualified Distribution.Solver.Modular.ConflictSet as CS
 import Distribution.Solver.Modular.Flag
 import Distribution.Solver.Modular.Package
 import Distribution.Solver.Modular.Var
 import Distribution.Solver.Modular.Version
-import qualified Distribution.Solver.Modular.ConflictSet as CS
 
-import Distribution.Solver.Types.ComponentDeps (Component(..))
+import Distribution.Solver.Types.ComponentDeps (Component (..))
 import Distribution.Solver.Types.PackagePath
 import Distribution.Types.LibraryName
 import Distribution.Types.PkgconfigVersionRange
@@ -85,14 +89,14 @@ type FlaggedDeps qpn = [FlaggedDep qpn]
 
 -- | Flagged dependencies can either be plain dependency constraints,
 -- or flag-dependent dependency trees.
-data FlaggedDep qpn =
-    -- | Dependencies which are conditional on a flag choice.
+data FlaggedDep qpn
+  = -- | Dependencies which are conditional on a flag choice.
     Flagged (FN qpn) FInfo (TrueFlaggedDeps qpn) (FalseFlaggedDeps qpn)
-    -- | Dependencies which are conditional on whether or not a stanza
+  | -- | Dependencies which are conditional on whether or not a stanza
     -- (e.g., a test suite or benchmark) is enabled.
-  | Stanza  (SN qpn)       (TrueFlaggedDeps qpn)
-    -- | Dependencies which are always enabled, for the component 'comp'.
-  | Simple (LDep qpn) Component
+    Stanza (SN qpn) (TrueFlaggedDeps qpn)
+  | -- | Dependencies which are always enabled, for the component 'comp'.
+    Simple (LDep qpn) Component
 
 -- | Conservatively flatten out flagged dependencies
 --
@@ -102,10 +106,10 @@ flattenFlaggedDeps = concatMap aux
   where
     aux :: FlaggedDep qpn -> [(LDep qpn, Component)]
     aux (Flagged _ _ t f) = flattenFlaggedDeps t ++ flattenFlaggedDeps f
-    aux (Stanza  _   t)   = flattenFlaggedDeps t
-    aux (Simple d c)      = [(d, c)]
+    aux (Stanza _ t) = flattenFlaggedDeps t
+    aux (Simple d c) = [(d, c)]
 
-type TrueFlaggedDeps  qpn = FlaggedDeps qpn
+type TrueFlaggedDeps qpn = FlaggedDeps qpn
 type FalseFlaggedDeps qpn = FlaggedDeps qpn
 
 -- | A 'Dep' labeled with the reason it was introduced.
@@ -119,11 +123,16 @@ data LDep qpn = LDep (DependencyReason qpn) (Dep qpn)
 -- | A dependency (constraint) associates a package name with a constrained
 -- instance. It can also represent other types of dependencies, such as
 -- dependencies on language extensions.
-data Dep qpn = Dep (PkgComponent qpn) CI  -- ^ dependency on a package component
-             | Ext Extension              -- ^ dependency on a language extension
-             | Lang Language              -- ^ dependency on a language version
-             | Pkg PkgconfigName PkgconfigVersionRange  -- ^ dependency on a pkg-config package
-  deriving Functor
+data Dep qpn
+  = -- | dependency on a package component
+    Dep (PkgComponent qpn) CI
+  | -- | dependency on a language extension
+    Ext Extension
+  | -- | dependency on a language version
+    Lang Language
+  | -- | dependency on a pkg-config package
+    Pkg PkgconfigName PkgconfigVersionRange
+  deriving (Functor)
 
 -- | An exposed component within a package. This type is used to represent
 -- build-depends and build-tool-depends dependencies.
@@ -132,8 +141,8 @@ data PkgComponent qpn = PkgComponent qpn ExposedComponent
 
 -- | A component that can be depended upon by another package, i.e., a library
 -- or an executable.
-data ExposedComponent =
-    ExposedLib LibraryName
+data ExposedComponent
+  = ExposedLib LibraryName
   | ExposedExe UnqualComponentName
   deriving (Eq, Ord, Show)
 
@@ -147,43 +156,25 @@ data DependencyReason qpn = DependencyReason qpn (Map Flag FlagValue) (S.Set Sta
 -- | Print the reason that a dependency was introduced.
 showDependencyReason :: DependencyReason QPN -> String
 showDependencyReason (DependencyReason qpn flags stanzas) =
-    intercalate " " $
-        showQPN qpn
+  intercalate " " $
+    showQPN qpn
       : map (uncurry showFlagValue) (M.toList flags)
-     ++ map (\s -> showSBool s True) (S.toList stanzas)
-
--- | Options for goal qualification (used in 'qualifyDeps')
---
--- See also 'defaultQualifyOptions'
-data QualifyOptions = QO {
-    -- | Do we have a version of base relying on another version of base?
-    qoBaseShim :: Bool
-
-    -- Should dependencies of the setup script be treated as independent?
-  , qoSetupIndependent :: Bool
-  }
-  deriving Show
+      ++ map (\s -> showSBool s True) (S.toList stanzas)
 
 -- | Apply built-in rules for package qualifiers
 --
--- Although the behaviour of 'qualifyDeps' depends on the 'QualifyOptions',
--- it is important that these 'QualifyOptions' are _static_. Qualification
--- does NOT depend on flag assignment; in other words, it behaves the same no
--- matter which choices the solver makes (modulo the global 'QualifyOptions');
--- we rely on this in 'linkDeps' (see comment there).
---
 -- NOTE: It's the _dependencies_ of a package that may or may not be independent
 -- from the package itself. Package flag choices must of course be consistent.
-qualifyDeps :: QualifyOptions -> QPN -> FlaggedDeps PN -> FlaggedDeps QPN
-qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
+qualifyDeps :: QPN -> FlaggedDeps PN -> FlaggedDeps QPN
+qualifyDeps (Q pp@(PackagePath ns q) pn) = go
   where
     go :: FlaggedDeps PN -> FlaggedDeps QPN
     go = map go1
 
     go1 :: FlaggedDep PN -> FlaggedDep QPN
     go1 (Flagged fn nfo t f) = Flagged (fmap (Q pp) fn) nfo (go t) (go f)
-    go1 (Stanza  sn     t)   = Stanza  (fmap (Q pp) sn)     (go t)
-    go1 (Simple dep comp)    = Simple (goLDep dep comp) comp
+    go1 (Stanza sn t) = Stanza (fmap (Q pp) sn) (go t)
+    go1 (Simple dep comp) = Simple (goLDep dep comp) comp
 
     -- Suppose package B has a setup dependency on package A.
     -- This will be recorded as something like
@@ -197,15 +188,14 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
     goLDep (LDep dr dep) comp = LDep (fmap (Q pp) dr) (goD dep comp)
 
     goD :: Dep PN -> Component -> Dep QPN
-    goD (Ext  ext)    _    = Ext  ext
-    goD (Lang lang)   _    = Lang lang
-    goD (Pkg pkn vr)  _    = Pkg pkn vr
+    goD (Ext ext) _ = Ext ext
+    goD (Lang lang) _ = Lang lang
+    goD (Pkg pkn vr) _ = Pkg pkn vr
     goD (Dep dep@(PkgComponent qpn (ExposedExe _)) ci) _ =
-        Dep (Q (PackagePath ns (QualExe pn qpn)) <$> dep) ci
-    goD (Dep dep@(PkgComponent qpn (ExposedLib _)) ci) comp
-      | qBase qpn   = Dep (Q (PackagePath ns (QualBase  pn)) <$> dep) ci
-      | qSetup comp = Dep (Q (PackagePath ns (QualSetup pn)) <$> dep) ci
-      | otherwise   = Dep (Q (PackagePath ns inheritedQ    ) <$> dep) ci
+      Dep (Q (PackagePath ns (QualExe pn qpn)) <$> dep) ci
+    goD (Dep dep@(PkgComponent _qpn (ExposedLib _)) ci) comp
+      | comp == ComponentSetup = Dep (Q (PackagePath ns (QualSetup pn)) <$> dep) ci
+      | otherwise = Dep (Q (PackagePath ns inheritedQ) <$> dep) ci
 
     -- If P has a setup dependency on Q, and Q has a regular dependency on R, then
     -- we say that the 'Setup' qualifier is inherited: P has an (indirect) setup
@@ -216,18 +206,9 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
     -- a detailed discussion.
     inheritedQ :: Qualifier
     inheritedQ = case q of
-                   QualSetup _  -> q
-                   QualExe _ _  -> q
-                   QualToplevel -> q
-                   QualBase _   -> QualToplevel
-
-    -- Should we qualify this goal with the 'Base' package path?
-    qBase :: PN -> Bool
-    qBase dep = qoBaseShim && unPackageName dep == "base"
-
-    -- Should we qualify this goal with the 'Setup' package path?
-    qSetup :: Component -> Bool
-    qSetup comp = qoSetupIndependent && comp == ComponentSetup
+      QualSetup _ -> q
+      QualExe _ _ -> q
+      QualToplevel -> q
 
 -- | Remove qualifiers from set of dependencies
 --
@@ -244,8 +225,8 @@ unqualifyDeps = go
 
     go1 :: FlaggedDep QPN -> FlaggedDep PN
     go1 (Flagged fn nfo t f) = Flagged (fmap unq fn) nfo (go t) (go f)
-    go1 (Stanza  sn     t)   = Stanza  (fmap unq sn)     (go t)
-    go1 (Simple dep comp)    = Simple (goLDep dep) comp
+    go1 (Stanza sn t) = Stanza (fmap unq sn) (go t)
+    go1 (Simple dep comp) = Simple (goLDep dep) comp
 
     goLDep :: LDep QPN -> LDep PN
     goLDep (LDep dr dep) = LDep (fmap unq dr) (fmap unq dep)
@@ -271,8 +252,8 @@ data Goal qpn = Goal (Var qpn) (GoalReason qpn)
   deriving (Eq, Show, Functor)
 
 -- | Reason why a goal is being added to a goal set.
-data GoalReason qpn =
-    UserGoal                              -- introduced by a build target
+data GoalReason qpn
+  = UserGoal -- introduced by a build target
   | DependencyGoal (DependencyReason qpn) -- introduced by a package
   deriving (Eq, Show, Functor)
 
@@ -288,7 +269,7 @@ varToConflictSet = CS.singleton
 -- | Convert a 'GoalReason' to a 'ConflictSet' that can be used when the goal
 -- leads to a conflict.
 goalReasonToConflictSet :: GoalReason QPN -> ConflictSet
-goalReasonToConflictSet UserGoal            = CS.empty
+goalReasonToConflictSet UserGoal = CS.empty
 goalReasonToConflictSet (DependencyGoal dr) = dependencyReasonToConflictSet dr
 
 -- | Convert a 'GoalReason' to a 'ConflictSet' containing the reason that the
@@ -302,14 +283,14 @@ goalReasonToConflictSetWithConflict :: QPN -> GoalReason QPN -> ConflictSet
 goalReasonToConflictSetWithConflict goal (DependencyGoal (DependencyReason qpn flags stanzas))
   | M.null flags && S.null stanzas =
       CS.singletonWithConflict (P qpn) $ CS.GoalConflict goal
-goalReasonToConflictSetWithConflict _    gr = goalReasonToConflictSet gr
+goalReasonToConflictSetWithConflict _ gr = goalReasonToConflictSet gr
 
 -- | This function returns the solver variables responsible for the dependency.
 -- It drops the values chosen for flag and stanza variables, which are only
 -- needed for log messages.
 dependencyReasonToConflictSet :: DependencyReason QPN -> ConflictSet
 dependencyReasonToConflictSet (DependencyReason qpn flags stanzas) =
-    CS.fromList $ P qpn : flagVars ++ map stanzaToVar (S.toList stanzas)
+  CS.fromList $ P qpn : flagVars ++ map stanzaToVar (S.toList 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
@@ -327,16 +308,19 @@ dependencyReasonToConflictSet (DependencyReason qpn flags stanzas) =
 -- This function currently only specifies the reason for the conflict in the
 -- simple case where the 'DependencyReason' does not involve any flags or
 -- stanzas. Otherwise, it falls back to calling 'dependencyReasonToConflictSet'.
-dependencyReasonToConflictSetWithVersionConstraintConflict :: QPN
-                                                           -> Ver
-                                                           -> DependencyReason QPN
-                                                           -> ConflictSet
 dependencyReasonToConflictSetWithVersionConstraintConflict
-    dependency excludedVersion dr@(DependencyReason qpn flags stanzas)
-  | M.null flags && S.null stanzas =
-    CS.singletonWithConflict (P qpn) $
-    CS.VersionConstraintConflict dependency excludedVersion
-  | otherwise = dependencyReasonToConflictSet dr
+  :: QPN
+  -> Ver
+  -> DependencyReason QPN
+  -> ConflictSet
+dependencyReasonToConflictSetWithVersionConstraintConflict
+  dependency
+  excludedVersion
+  dr@(DependencyReason qpn flags stanzas)
+    | M.null flags && S.null stanzas =
+        CS.singletonWithConflict (P qpn) $
+          CS.VersionConstraintConflict dependency excludedVersion
+    | otherwise = dependencyReasonToConflictSet dr
 
 -- | Convert a 'DependencyReason' to a 'ConflictSet' specifying that the
 -- conflict occurred because the conflict set variables introduced a version of
@@ -346,13 +330,16 @@ dependencyReasonToConflictSetWithVersionConstraintConflict
 -- This function currently only specifies the reason for the conflict in the
 -- simple case where the 'DependencyReason' does not involve any flags or
 -- stanzas. Otherwise, it falls back to calling 'dependencyReasonToConflictSet'.
-dependencyReasonToConflictSetWithVersionConflict :: QPN
-                                                 -> CS.OrderedVersionRange
-                                                 -> DependencyReason QPN
-                                                 -> ConflictSet
 dependencyReasonToConflictSetWithVersionConflict
-    pkgWithVersionConstraint constraint dr@(DependencyReason qpn flags stanzas)
-  | M.null flags && S.null stanzas =
-    CS.singletonWithConflict (P qpn) $
-    CS.VersionConflict pkgWithVersionConstraint constraint
-  | otherwise = dependencyReasonToConflictSet dr
+  :: QPN
+  -> CS.OrderedVersionRange
+  -> DependencyReason QPN
+  -> ConflictSet
+dependencyReasonToConflictSetWithVersionConflict
+  pkgWithVersionConstraint
+  constraint
+  dr@(DependencyReason qpn flags stanzas)
+    | M.null flags && S.null stanzas =
+        CS.singletonWithConflict (P qpn) $
+          CS.VersionConflict pkgWithVersionConstraint constraint
+    | otherwise = dependencyReasonToConflictSet dr

cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs

@@ -270,7 +270,7 @@ exploreLog mbj enableBj fineGrainedConflicts (CountConflicts countConflicts) idx
     couldResolveConflicts :: QPN -> POption -> S.Set CS.Conflict -> Maybe ConflictSet
     couldResolveConflicts currentQPN@(Q _ pn) (POption i@(I v _) _) conflicts =
       let (PInfo deps _ _ _) = idx M.! pn M.! i
-          qdeps = qualifyDeps (defaultQualifyOptions idx) currentQPN deps
+          qdeps = qualifyDeps currentQPN deps
 
           couldBeResolved :: CS.Conflict -> Maybe ConflictSet
           couldBeResolved CS.OtherConflict = Nothing