From 5c93eef7b0d67db8c8b431a83a0ec46bed55279d Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@community.haskell.org>
Date: Mon, 16 May 2016 15:16:44 +0100
Subject: [PATCH] Fix handling of default setup deps

Commit 2f976576c35b91f7e5a2225774e46b234550371d added default setup dep
handling to the existing install command code paths, but unfortunately
broke the handling for the new-build code path. It added a call to
addDefaultSetupDependencies into the standardInstallPolicy. That
interfered with the addDefaultSetupDependencies that ProjectPlanning was
already using.

So this patch splits a basicInstallPolicy out of standardInstallPolicy,
where the basicInstallPolicy is all the old stuff, and the
standardInstallPolicy just adds the addDefaultSetupDependencies that the
install/fetch/freeze commands need. So then ProjectPlanning uses just
the basicInstallPolicy.

The 2f97657 commit also added a new and simpler method to determine if a
package has had default setup deps added. Previously ProjectPlanning had
to use a rather complex method to remember this information. So this
patch removes all that and makes use of the new method.

To stop this breaking in future the next patch adds integration tests to
cover custom setup script handling.

This fixed issue #3394.
---
 .../Distribution/Client/Dependency.hs         | 32 ++++--
 .../Distribution/Client/ProjectPlanning.hs    | 98 ++++---------------
 2 files changed, 45 insertions(+), 85 deletions(-)

diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs
index 892c3f8061..3c5b500aa2 100644
--- a/cabal-install/Distribution/Client/Dependency.hs
+++ b/cabal-install/Distribution/Client/Dependency.hs
@@ -30,6 +30,7 @@ module Distribution.Client.Dependency (
     InstalledPreference(..),
 
     -- ** Standard policy
+    basicInstallPolicy,
     standardInstallPolicy,
     PackageSpecifier(..),
 
@@ -448,11 +449,13 @@ reinstallTargets params =
     hideInstalledPackagesAllVersions (depResolverTargets params) params
 
 
-standardInstallPolicy :: InstalledPackageIndex
-                      -> SourcePackageDb
-                      -> [PackageSpecifier UnresolvedSourcePackage]
-                      -> DepResolverParams
-standardInstallPolicy
+-- | A basic solver policy on which all others are built.
+--
+basicInstallPolicy :: InstalledPackageIndex
+                   -> SourcePackageDb
+                   -> [PackageSpecifier UnresolvedSourcePackage]
+                   -> DepResolverParams
+basicInstallPolicy
     installedPkgIndex (SourcePackageDb sourcePkgIndex sourcePkgPrefs)
     pkgSpecifiers
 
@@ -469,14 +472,29 @@ standardInstallPolicy
   . hideInstalledPackagesSpecificBySourcePackageId
       [ packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers ]
 
-  . addDefaultSetupDependencies mkDefaultSetupDeps
-
   . addSourcePackages
       [ pkg  | SpecificSourcePackage pkg <- pkgSpecifiers ]
 
   $ basicDepResolverParams
       installedPkgIndex sourcePkgIndex
 
+
+-- | The policy used by all the standard commands, install, fetch, freeze etc
+-- (but not the new-build and related commands).
+--
+-- It extends the 'basicInstallPolicy' with a policy on setup deps.
+--
+standardInstallPolicy :: InstalledPackageIndex
+                      -> SourcePackageDb
+                      -> [PackageSpecifier UnresolvedSourcePackage]
+                      -> DepResolverParams
+standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers
+
+  = addDefaultSetupDependencies mkDefaultSetupDeps
+
+  $ basicInstallPolicy
+      installedPkgIndex sourcePkgDb pkgSpecifiers
+
     where
       -- Force Cabal >= 1.24 dep when the package is affected by #3199.
       mkDefaultSetupDeps :: UnresolvedSourcePackage -> Maybe [Dependency]
diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs
index 89febdf6f2..bb653c1bfc 100644
--- a/cabal-install/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/Distribution/Client/ProjectPlanning.hs
@@ -82,7 +82,6 @@ import           Distribution.Solver.Types.ConstraintSource
 import           Distribution.Solver.Types.LabeledPackageConstraint
 import           Distribution.Solver.Types.OptionalStanza
 import           Distribution.Solver.Types.PackageFixedDeps
-import qualified Distribution.Solver.Types.PackageIndex as SourcePackageIndex
 import           Distribution.Solver.Types.PkgConfigDb
 import           Distribution.Solver.Types.Settings
 import           Distribution.Solver.Types.SolverId
@@ -424,7 +423,7 @@ rebuildInstallPlan verbosity
     phaseRunSolver :: ProjectConfig
                    -> (Compiler, Platform, ProgramDb)
                    -> [UnresolvedSourcePackage]
-                   -> Rebuild (SolverInstallPlan, PackagesImplicitSetupDeps)
+                   -> Rebuild SolverInstallPlan
     phaseRunSolver projectConfig@ProjectConfig {
                      projectConfigShared,
                      projectConfigBuildOnly
@@ -490,7 +489,7 @@ rebuildInstallPlan verbosity
     --
     phaseElaboratePlan :: ProjectConfig
                        -> (Compiler, Platform, ProgramDb)
-                       -> (SolverInstallPlan, PackagesImplicitSetupDeps)
+                       -> SolverInstallPlan
                        -> [SourcePackage loc]
                        -> Rebuild ( ElaboratedInstallPlan
                                   , ElaboratedSharedConfig )
@@ -501,8 +500,7 @@ rebuildInstallPlan verbosity
                          projectConfigBuildOnly
                        }
                        (compiler, platform, progdb)
-                       (solverPlan, pkgsImplicitSetupDeps)
-                       localPackages = do
+                       solverPlan localPackages = do
 
         liftIO $ debug verbosity "Elaborating the install plan..."
 
@@ -518,7 +516,6 @@ rebuildInstallPlan verbosity
             distDirLayout
             cabalDirLayout
             solverPlan
-            pkgsImplicitSetupDeps
             localPackages
             sourcePackageHashes
             defaultInstallDirs
@@ -827,14 +824,11 @@ planPackages :: Compiler
              -> PkgConfigDb
              -> [UnresolvedSourcePackage]
              -> Map PackageName (Map OptionalStanza Bool)
-             -> Progress String String
-                         (SolverInstallPlan, PackagesImplicitSetupDeps)
+             -> Progress String String SolverInstallPlan
 planPackages comp platform solver SolverSettings{..}
              installedPkgIndex sourcePkgDb pkgConfigDB
              localPackages pkgStanzasEnable =
 
-    rememberImplicitSetupDeps (depResolverSourcePkgIndex stdResolverParams) <$>
-
     resolveDependencies
       platform (compilerInfo comp)
       pkgConfigDB solver
@@ -933,7 +927,9 @@ planPackages comp platform solver SolverSettings{..}
       $ stdResolverParams
 
     stdResolverParams =
-      standardInstallPolicy
+      -- Note: we don't use the standardInstallPolicy here, since that uses
+      -- its own addDefaultSetupDependencies that is not appropriate for us.
+      basicInstallPolicy
         installedPkgIndex sourcePkgDb
         (map SpecificSourcePackage localPackages)
 
@@ -973,7 +969,6 @@ elaborateInstallPlan
   -> DistDirLayout
   -> CabalDirLayout
   -> SolverInstallPlan
-  -> PackagesImplicitSetupDeps
   -> [SourcePackage loc]
   -> Map PackageId PackageSourceHash
   -> InstallDirs.InstallDirTemplates
@@ -984,7 +979,7 @@ elaborateInstallPlan
 elaborateInstallPlan platform compiler compilerprogdb
                      DistDirLayout{..}
                      cabalDirLayout@CabalDirLayout{cabalStorePackageDB}
-                     solverPlan pkgsImplicitSetupDeps localPackages
+                     solverPlan localPackages
                      sourcePackageHashes
                      defaultInstallDirs
                      _sharedPackageConfig
@@ -1101,8 +1096,7 @@ elaborateInstallPlan platform compiler compilerprogdb
         pkgRegisterPackageDBStack = buildAndRegisterDbs
         pkgRequiresRegistration   = PD.hasPublicLib pkgDescription
 
-        pkgSetupScriptStyle       = packageSetupScriptStylePostSolver
-                                      pkgsImplicitSetupDeps pkg pkgDescription
+        pkgSetupScriptStyle       = packageSetupScriptStyle pkgDescription
         pkgSetupScriptCliVersion  = packageSetupScriptSpecVersion
                                       pkgSetupScriptStyle pkgDescription deps
         pkgSetupPackageDBStack    = buildAndRegisterDbs
@@ -1689,18 +1683,20 @@ dependencyGraph pkgid deps pkgs =
 
 -- | Work out the 'SetupScriptStyle' given the package description.
 --
--- This only works on original packages before we give them to the solver,
--- since after the solver some implicit setup deps are made explicit.
---
--- See 'rememberImplicitSetupDeps' and 'packageSetupScriptStylePostSolver'.
---
-packageSetupScriptStylePreSolver :: PD.PackageDescription -> SetupScriptStyle
-packageSetupScriptStylePreSolver pkg
+packageSetupScriptStyle :: PD.PackageDescription -> SetupScriptStyle
+packageSetupScriptStyle pkg
   | buildType == PD.Custom
-  , isJust (PD.setupBuildInfo pkg)
+  , Just setupbi <- PD.setupBuildInfo pkg -- does have a custom-setup stanza
+  , not (PD.defaultSetupDepends setupbi)  -- but not one we added internally
   = SetupCustomExplicitDeps
 
   | buildType == PD.Custom
+  , Just setupbi <- PD.setupBuildInfo pkg -- we get this case post-solver as
+  , PD.defaultSetupDepends setupbi        -- the solver fills in the deps
+  = SetupCustomImplicitDeps
+
+  | buildType == PD.Custom
+  , Nothing <- PD.setupBuildInfo pkg      -- we get this case pre-solver
   = SetupCustomImplicitDeps
 
   | PD.specVersion pkg > cabalVersion -- one cabal-install is built against
@@ -1731,7 +1727,7 @@ defaultSetupDeps :: Compiler -> Platform
                  -> PD.PackageDescription
                  -> Maybe [Dependency]
 defaultSetupDeps compiler platform pkg =
-    case packageSetupScriptStylePreSolver pkg of
+    case packageSetupScriptStyle pkg of
 
       -- For packages with build type custom that do not specify explicit
       -- setup dependencies, we add a dependency on Cabal and a number
@@ -1783,60 +1779,6 @@ defaultSetupDeps compiler platform pkg =
              ++ "setup deps: " ++ display (packageId pkg)
 
 
--- | See 'rememberImplicitSetupDeps' for details.
-type PackagesImplicitSetupDeps = Set InstalledPackageId
-
--- | A consequence of using 'defaultSetupDeps' in 'planPackages' is that by
--- making implicit setup deps explicit we loose track of which packages
--- originally had implicit setup deps. That's important because we do still
--- have different behaviour based on the setup style (in particular whether to
--- compile a Setup.hs script with version macros).
---
--- So we remember the necessary information in an auxilliary set and use it
--- in 'packageSetupScriptStylePreSolver' to recover the full info.
---
-rememberImplicitSetupDeps :: SourcePackageIndex.PackageIndex (SourcePackage loc)
-                          -> SolverInstallPlan
-                          -> (SolverInstallPlan, PackagesImplicitSetupDeps)
-rememberImplicitSetupDeps sourcePkgIndex plan =
-    (plan, pkgsImplicitSetupDeps)
-  where
-    pkgsImplicitSetupDeps =
-      Set.fromList
-        [ installedPackageId pkg
-        | InstallPlan.Configured
-            pkg@(SolverPackage newpkg _ _ _) <- InstallPlan.toList plan
-          -- has explicit setup deps now
-        , hasExplicitSetupDeps newpkg
-          -- but originally had no setup deps
-        , let Just origpkg = SourcePackageIndex.lookupPackageId
-                               sourcePkgIndex (packageId pkg)
-        , not (hasExplicitSetupDeps origpkg)
-        ]
-
-    hasExplicitSetupDeps =
-        (SetupCustomExplicitDeps==)
-      . packageSetupScriptStylePreSolver
-      . PD.packageDescription . packageDescription
-
-
--- | Use the extra info saved by 'rememberImplicitSetupDeps' to let us work
--- out the correct 'SetupScriptStyle'. This should give the same result as
--- 'packageSetupScriptStylePreSolver' gave prior to munging the package info
--- through the solver.
---
-packageSetupScriptStylePostSolver :: Set InstalledPackageId
-                                  -> SolverPackage loc
-                                  -> PD.PackageDescription
-                                  -> SetupScriptStyle
-packageSetupScriptStylePostSolver pkgsImplicitSetupDeps pkg pkgDescription =
-    case packageSetupScriptStylePreSolver pkgDescription of
-      SetupCustomExplicitDeps
-        | Set.member (installedPackageId pkg) pkgsImplicitSetupDeps
-            -> SetupCustomImplicitDeps
-      other -> other
-
-
 -- | Work out which version of the Cabal spec we will be using to talk to the
 -- Setup.hs interface for this package.
 --
-- 
GitLab