refactor: fix some TODOs

Implement hideInstalledPackagesSpecificBySourcePackageId using constraints.

Remove InstalledPackageIndex from DepResolverParams since it is not needed anymore by the DSL.

Author: andreabedini

cabal-install/src/Distribution/Client/Configure.hs

@@ -463,14 +463,13 @@ planLocalPackage
           . setSolveExecutables (SolveExecutables False)
           . setSolverVerbosity verbosity
           $ standardInstallPolicy
-            installedPkgIndex
             -- NB: We pass in an *empty* source package database,
             -- because cabal configure assumes that all dependencies
             -- have already been installed
             (SourcePackageDb mempty packagePrefs)
             [SpecificSourcePackage localPkg]
 
-    return (resolveDependencies platform (compilerInfo comp) pkgConfigDb resolverParams)
+    return (resolveDependencies platform (compilerInfo comp) pkgConfigDb installedPkgIndex resolverParams)
 
 -- | Call an installer for an 'SourcePackage' but override the configure
 -- flags with the ones given by the 'ReadyPackage'. In particular the

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

@@ -177,7 +177,6 @@ data DepResolverParams = DepResolverParams
   , depResolverConstraints :: [LabeledPackageConstraint]
   , depResolverPreferences :: [PackagePreference]
   , depResolverPreferenceDefault :: PackagesPreferenceDefault
-  , depResolverInstalledPkgIndex :: InstalledPackageIndex
   , depResolverSourcePkgIndex :: PackageIndex.PackageIndex UnresolvedSourcePackage
   , depResolverReorderGoals :: ReorderGoals
   , depResolverCountConflicts :: CountConflicts
@@ -270,16 +269,14 @@ showPackagePreference (PackageStanzasPreference pn st) =
   prettyShow pn ++ " " ++ show st
 
 basicDepResolverParams
-  :: InstalledPackageIndex
-  -> PackageIndex.PackageIndex UnresolvedSourcePackage
+  :: PackageIndex.PackageIndex UnresolvedSourcePackage
   -> DepResolverParams
-basicDepResolverParams installedPkgIndex sourcePkgIndex =
+basicDepResolverParams sourcePkgIndex =
   DepResolverParams
     { depResolverTargets = Set.empty
     , depResolverConstraints = []
     , depResolverPreferences = []
     , depResolverPreferenceDefault = PreferLatestForSelected
-    , depResolverInstalledPkgIndex = installedPkgIndex
     , depResolverSourcePkgIndex = sourcePkgIndex
     , depResolverReorderGoals = ReorderGoals False
     , depResolverCountConflicts = CountConflicts True
@@ -477,33 +474,20 @@ addSourcePackages pkgs params =
           pkgs
     }
 
+-- FIXME this actually works by package name, not by package id
 hideInstalledPackagesSpecificBySourcePackageId
   :: [PackageId]
   -> DepResolverParams
   -> DepResolverParams
-hideInstalledPackagesSpecificBySourcePackageId pkgids params =
-  -- TODO: this should work using exclude constraints instead
-  params
-    { depResolverInstalledPkgIndex =
-        foldl'
-          (flip InstalledPackageIndex.deleteSourcePackageId)
-          (depResolverInstalledPkgIndex params)
-          pkgids
-    }
-
-hideInstalledPackagesAllVersions
-  :: [PackageName]
-  -> DepResolverParams
-  -> DepResolverParams
-hideInstalledPackagesAllVersions pkgnames params =
-  -- TODO: this should work using exclude constraints instead
-  params
-    { depResolverInstalledPkgIndex =
-        foldl'
-          (flip InstalledPackageIndex.deletePackageName)
-          (depResolverInstalledPkgIndex params)
-          pkgnames
-    }
+hideInstalledPackagesSpecificBySourcePackageId pkgids =
+  addConstraints
+    [ LabeledPackageConstraint
+      (PackageConstraint (ScopeAnyQualifier name) PackagePropertySource)
+      -- FIXME
+      ConstraintSourceUnknown
+    | pkgId <- pkgids
+    , let name = packageName pkgId
+    ]
 
 -- | Remove upper bounds in dependencies using the policy specified by the
 -- 'AllowNewer' argument (all/some/none).
@@ -685,17 +669,24 @@ upgradeDependencies = setPreferenceDefault PreferAllLatest
 
 reinstallTargets :: DepResolverParams -> DepResolverParams
 reinstallTargets params =
-  hideInstalledPackagesAllVersions (Set.toList $ depResolverTargets params) params
+  addConstraints
+    [ LabeledPackageConstraint
+      ( PackageConstraint
+          (ScopeAnyQualifier pkgName)
+          PackagePropertySource
+      )
+      ConstraintSourceProfiledDynamic
+    | pkgName <- Set.toList (depResolverTargets params)
+    ]
+    params
 
 -- | A basic solver policy on which all others are built.
 basicInstallPolicy
-  :: InstalledPackageIndex
-  -> SourcePackageDb
+  :: SourcePackageDb
   -> [PackageSpecifier UnresolvedSourcePackage]
   -> DepResolverParams
 basicInstallPolicy
-  installedPkgIndex
-  (SourcePackageDb sourcePkgIndex sourcePkgPrefs)
+    (SourcePackageDb sourcePkgIndex sourcePkgPrefs)
   pkgSpecifiers =
     addPreferences
       [ PackageVersionPreference name ver
@@ -710,22 +701,19 @@ basicInstallPolicy
       . addSourcePackages
         [pkg | SpecificSourcePackage pkg <- pkgSpecifiers]
       $ basicDepResolverParams
-        installedPkgIndex
         sourcePkgIndex
 
 -- | The policy used by all the standard commands, install, fetch, freeze etc
 -- (but not the v2-build and related commands).
 --
 -- It extends the 'basicInstallPolicy' with a policy on setup deps.
 standardInstallPolicy
-  :: InstalledPackageIndex
-  -> SourcePackageDb
+  :: SourcePackageDb
   -> [PackageSpecifier UnresolvedSourcePackage]
   -> DepResolverParams
-standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers =
+standardInstallPolicy sourcePkgDb pkgSpecifiers =
   addDefaultSetupDependencies mkDefaultSetupDeps $
     basicInstallPolicy
-      installedPkgIndex
       sourcePkgDb
       pkgSpecifiers
   where
@@ -774,9 +762,10 @@ resolveDependencies
   :: Platform
   -> CompilerInfo
   -> Maybe PkgConfigDb
+  -> InstalledPackageIndex
   -> DepResolverParams
   -> Progress String String SolverInstallPlan
-resolveDependencies platform comp pkgConfigDB params =
+resolveDependencies platform comp pkgConfigDB installedPkgIndex params =
   Step (showDepResolverParams finalparams) $
     fmap (validateSolverResult platform comp) $
       runSolver
@@ -810,7 +799,6 @@ resolveDependencies platform comp pkgConfigDB params =
                     constraints
                     prefs
                     defpref
-                    installedPkgIndex
                     sourcePkgIndex
                     reordGoals
                     cntConflicts
@@ -1122,14 +1110,14 @@ configuredPackageProblems
 -- It simply means preferences for installed packages will be ignored.
 resolveWithoutDependencies
   :: DepResolverParams
+  -> InstalledPackageIndex
   -> Either [ResolveNoDepsError] [UnresolvedSourcePackage]
 resolveWithoutDependencies
   ( DepResolverParams
       targets
       constraints
       prefs
       defpref
-      installedPkgIndex
       sourcePkgIndex
       _reorderGoals
       _countConflicts
@@ -1145,7 +1133,7 @@ resolveWithoutDependencies
       _onlyConstrained
       _order
       _verbosity
-    ) =
+    ) installedPkgIndex =
     collectEithers $ map selectPackage (Set.toList targets)
     where
       selectPackage :: PackageName -> Either ResolveNoDepsError UnresolvedSourcePackage

cabal-install/src/Distribution/Client/Fetch.hs

@@ -177,6 +177,7 @@ planPackages
               platform
               (compilerInfo comp)
               pkgConfigDb
+              installedPkgIndex
               resolverParams
 
         -- The packages we want to fetch are those packages the 'InstallPlan'
@@ -188,7 +189,7 @@ planPackages
           ]
     | otherwise =
         either (dieWithException verbosity . PlanPackages . unlines . map show) return $
-          resolveWithoutDependencies resolverParams
+          resolveWithoutDependencies resolverParams installedPkgIndex
     where
       resolverParams :: DepResolverParams
       resolverParams =
@@ -219,7 +220,7 @@ planPackages
           -- already installed. Since we want to get the source packages of
           -- things we might have installed (but not have the sources for).
           . reinstallTargets
-          $ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers
+          $ standardInstallPolicy sourcePkgDb pkgSpecifiers
 
       includeDependencies = fromFlag (fetchDeps fetchFlags)
       logMsg message rest = debug verbosity message >> rest

cabal-install/src/Distribution/Client/Freeze.hs

@@ -215,6 +215,7 @@ planPackages
           platform
           (compilerInfo comp)
           pkgConfigDb
+          installedPkgIndex
           resolverParams
 
     return $ pruneInstallPlan installPlan pkgSpecifiers
@@ -244,7 +245,7 @@ planPackages
                in LabeledPackageConstraint pc ConstraintSourceFreeze
             | pkgSpecifier <- pkgSpecifiers
             ]
-          $ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers
+          $ standardInstallPolicy sourcePkgDb pkgSpecifiers
 
       logMsg message rest = debug verbosity message >> rest
 

cabal-install/src/Distribution/Client/Get.hs

@@ -128,7 +128,7 @@ get verbosity repoCtxt globalFlags getFlags userTargets = do
   pkgs <-
     either (dieWithException verbosity . PkgSpecifierException . map show) return $
       resolveWithoutDependencies
-        (resolverParams sourcePkgDb pkgSpecifiers)
+        (resolverParams sourcePkgDb pkgSpecifiers) mempty
 
   unless (null prefix) $
     createDirectoryIfMissing True prefix
@@ -148,7 +148,7 @@ get verbosity repoCtxt globalFlags getFlags userTargets = do
     resolverParams :: SourcePackageDb -> [PackageSpecifier UnresolvedSourcePackage] -> DepResolverParams
     resolverParams sourcePkgDb pkgSpecifiers =
       -- TODO: add command-line constraint and preference args for unpack
-      standardInstallPolicy mempty sourcePkgDb pkgSpecifiers
+      standardInstallPolicy sourcePkgDb pkgSpecifiers
 
     onlyPkgDescr = fromFlagOrDefault False (getOnlyPkgDescr getFlags)
 

cabal-install/src/Distribution/Client/Install.hs

@@ -588,6 +588,7 @@ planPackages
       platform
       (compilerInfo comp)
       pkgConfigDb
+      installedPkgIndex
       resolverParams
       >>= if onlyDeps then pruneInstallPlan pkgSpecifiers else return
     where
@@ -649,7 +650,6 @@ planPackages
           -- doesn't understand how to install them
           . setSolveExecutables (SolveExecutables False)
           $ standardInstallPolicy
-            installedPkgIndex
             sourcePkgDb
             pkgSpecifiers
 

cabal-install/src/Distribution/Client/ProjectPlanning.hs

@@ -1269,6 +1269,7 @@ planPackages
       platform
       (compilerInfo comp)
       pkgConfigDB
+      installedPkgIndex
       resolverParams
     where
       -- TODO: [nice to have] disable multiple instances restriction in
@@ -1387,7 +1388,6 @@ planPackages
         -- Note: we don't use the standardInstallPolicy here, since that uses
         -- its own addDefaultSetupDependencies that is not appropriate for us.
         basicInstallPolicy
-          installedPkgIndex
           sourcePkgDb
           localPackages
 

cabal-install/src/Distribution/Client/Types/PackageSpecifier.hs

@@ -11,7 +11,7 @@ module Distribution.Client.Types.PackageSpecifier
 import Distribution.Client.Compat.Prelude
 import Prelude ()
 
-import Distribution.Package (Package (..), PackageIdentifier (..), packageName, packageVersion)
+import Distribution.Package (Package (..), PackageIdentifier (..), packageName)
 import Distribution.Types.PackageName (PackageName)
 import Distribution.Version (nullVersion, thisVersion)
 
@@ -48,12 +48,12 @@ pkgSpecifierConstraints (NamedPackage name props) = map toLpc props
         (PackageConstraint (scopeToplevel name) prop)
         ConstraintSourceUserTarget
 pkgSpecifierConstraints (SpecificSourcePackage pkg) =
-  [LabeledPackageConstraint pc ConstraintSourceUserTarget]
+  [LabeledPackageConstraint sourceConstraint ConstraintSourceUserTarget]
   where
-    pc =
+    sourceConstraint =
       PackageConstraint
         (ScopeTarget $ packageName pkg)
-        (PackagePropertyVersion $ thisVersion (packageVersion pkg))
+        PackagePropertySource
 
 mkNamedPackage :: PackageIdentifier -> PackageSpecifier pkg
 mkNamedPackage pkgId =