Actually _use_ setup deps in configure and co

edsko · edsko · commit ba317c2cf97d · 2015-04-06T12:56:35.000+01:00
The only problematic thing is that when we call `cabal clean` or `cabal
haddock` (and possibly others), _without_ first having called `configure`, we
attempt to build the setup script without calling the solver at all. This means
that if you do, say,

    cabal configure
    cabal clean
    cabal clean

for a package with a custom setup script that really needs setup dependencies
(for instance, because there are two versions of Cabal in the global package DB
and the setup script needs the _older_ one), then first call to `clean` will
succeed, but the second call will fail because we will try to build the setup
script without the solver and that will fail.
diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs
@@ -13,6 +13,7 @@
 -----------------------------------------------------------------------------
 module Distribution.Client.Configure (
     configure,
+    configureSetupScript,
     chooseCabalVersion,
   ) where
 
@@ -30,6 +31,8 @@ import Distribution.Client.SetupWrapper
 import Distribution.Client.Targets
          ( userToPackageConstraint )
 import qualified Distribution.Client.ComponentDeps as CD
+import Distribution.Package (PackageId)
+import Distribution.Client.JobControl (Lock)
 
 import Distribution.Simple.Compiler
          ( Compiler, CompilerInfo, compilerInfo, PackageDB(..), PackageDBStack )
@@ -41,7 +44,10 @@ import Distribution.Simple.Utils
          ( defaultPackageDesc )
 import qualified Distribution.InstalledPackageInfo as Installed
 import Distribution.Package
-         ( Package(..), packageName, Dependency(..), thisPackageVersion )
+         ( Package(..), InstalledPackageId, packageName
+         , Dependency(..), thisPackageVersion
+         )
+import qualified Distribution.PackageDescription as PkgDesc
 import Distribution.PackageDescription.Parse
          ( readPackageDescription )
 import Distribution.PackageDescription.Configuration
@@ -60,6 +66,7 @@ import Distribution.Version
 #if !MIN_VERSION_base(4,8,0)
 import Data.Monoid (Monoid(..))
 #endif
+import Data.Maybe (isJust, fromMaybe)
 
 -- | Choose the Cabal version such that the setup scripts compiled against this
 -- version will support the given command-line flags.
@@ -101,52 +108,114 @@ configure verbosity packageDBs repos comp platform conf
                             progress
   case maybePlan of
     Left message -> do
-      info verbosity message
-      setupWrapper verbosity (setupScriptOptions installedPkgIndex) Nothing
+      info verbosity $
+           "Warning: solver failed to find a solution:\n"
+        ++ message
+        ++ "Trying configure anyway."
+      setupWrapper verbosity (setupScriptOptions installedPkgIndex Nothing) Nothing
         configureCommand (const configFlags) extraArgs
 
     Right installPlan -> case InstallPlan.ready installPlan of
-      [pkg@(ReadyPackage (SourcePackage _ _ (LocalUnpackedPackage _) _) _ _ _)] ->
+      [pkg@(ReadyPackage (SourcePackage _ _ (LocalUnpackedPackage _) _) _ _ _)] -> do
         configurePackage verbosity
           (InstallPlan.planPlatform installPlan)
           (InstallPlan.planCompiler installPlan)
-          (setupScriptOptions installedPkgIndex)
+          (setupScriptOptions installedPkgIndex (Just pkg))
           configFlags pkg extraArgs
 
       _ -> die $ "internal error: configure install plan should have exactly "
               ++ "one local ready package."
 
   where
-    setupScriptOptions index = SetupScriptOptions {
-      useCabalVersion  = chooseCabalVersion configExFlags
-                         (flagToMaybe (configCabalVersion configExFlags)),
-      useCompiler      = Just comp,
-      usePlatform      = Just platform,
-      usePackageDB     = packageDBs',
-      usePackageIndex  = index',
-      useProgramConfig = conf,
-      useDistPref      = fromFlagOrDefault
-                           (useDistPref defaultSetupScriptOptions)
-                           (configDistPref configFlags),
-      useLoggingHandle = Nothing,
-      useWorkingDir    = Nothing,
-      useWin32CleanHack        = False,
-      forceExternalSetupMethod = False,
-      setupCacheLock   = Nothing
-    }
-      where
-        -- Hack: we typically want to allow the UserPackageDB for finding the
-        -- Cabal lib when compiling any Setup.hs even if we're doing a global
-        -- install. However we also allow looking in a specific package db.
-        (packageDBs', index') =
-          case packageDBs of
-            (GlobalPackageDB:dbs) | UserPackageDB `notElem` dbs
-                -> (GlobalPackageDB:UserPackageDB:dbs, Nothing)
-            -- but if the user is using an odd db stack, don't touch it
-            dbs -> (dbs, Just index)
+    setupScriptOptions :: InstalledPackageIndex -> Maybe ReadyPackage -> SetupScriptOptions
+    setupScriptOptions =
+      configureSetupScript
+        packageDBs
+        comp
+        platform
+        conf
+        (fromFlagOrDefault
+           (useDistPref defaultSetupScriptOptions)
+           (configDistPref configFlags))
+        (chooseCabalVersion
+           configExFlags
+           (flagToMaybe (configCabalVersion configExFlags)))
+        Nothing
+        False
 
     logMsg message rest = debug verbosity message >> rest
 
+configureSetupScript :: PackageDBStack
+                     -> Compiler
+                     -> Platform
+                     -> ProgramConfiguration
+                     -> FilePath
+                     -> VersionRange
+                     -> Maybe Lock
+                     -> Bool
+                     -> InstalledPackageIndex
+                     -> Maybe ReadyPackage
+                     -> SetupScriptOptions
+configureSetupScript packageDBs
+                     comp
+                     platform
+                     conf
+                     distPref
+                     cabalVersion
+                     lock
+                     forceExternal
+                     index
+                     mpkg
+  = SetupScriptOptions {
+      useCabalVersion   = cabalVersion
+    , useCompiler       = Just comp
+    , usePlatform       = Just platform
+    , usePackageDB      = packageDBs'
+    , usePackageIndex   = index'
+    , useProgramConfig  = conf
+    , useDistPref       = distPref
+    , useLoggingHandle  = Nothing
+    , useWorkingDir     = Nothing
+    , setupCacheLock    = lock
+    , useWin32CleanHack = False
+    , forceExternalSetupMethod = forceExternal
+      -- If we have explicit setup dependencies, list them; otherwise, we give
+      -- the empty list of dependencies; ideally, we would fix the version of
+      -- Cabal here, so that we no longer need the special case for that in
+      -- `compileSetupExecutable` in `externalSetupMethod`, but we don't yet
+      -- know the version of Cabal at this point, but only find this there.
+      -- Therefore, for now, we just leave this blank.
+    , useDependencies          = fromMaybe [] explicitSetupDeps
+    , useDependenciesExclusive = isJust explicitSetupDeps
+    }
+  where
+    -- When we are compiling a legacy setup script without an explicit
+    -- setup stanza, we typically want to allow the UserPackageDB for
+    -- finding the Cabal lib when compiling any Setup.hs even if we're doing
+    -- a global install. However we also allow looking in a specific package
+    -- db.
+    packageDBs' :: PackageDBStack
+    index'      :: Maybe InstalledPackageIndex
+    (packageDBs', index') =
+      case packageDBs of
+        (GlobalPackageDB:dbs) | UserPackageDB `notElem` dbs
+                              , Nothing <- explicitSetupDeps
+            -> (GlobalPackageDB:UserPackageDB:dbs, Nothing)
+        -- but if the user is using an odd db stack, don't touch it
+        _otherwise -> (packageDBs, Just index)
+
+    explicitSetupDeps :: Maybe [(InstalledPackageId, PackageId)]
+    explicitSetupDeps = do
+      ReadyPackage (SourcePackage _ gpkg _ _) _ _ deps <- mpkg
+      -- Check if there is an explicit setup stanza
+      _buildInfo <- PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg)
+      -- Return the setup dependencies computed by the solver
+      return [ ( Installed.installedPackageId deppkg
+               , Installed.sourcePackageId    deppkg
+               )
+             | deppkg <- CD.setupDeps deps
+             ]
+
 -- | Make an 'InstallPlan' for the unpacked package in the current directory,
 -- and all its dependencies.
 --
diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
@@ -63,7 +63,7 @@ import System.IO.Error
 
 import Distribution.Client.Targets
 import Distribution.Client.Configure
-         ( chooseCabalVersion )
+         ( chooseCabalVersion, configureSetupScript )
 import Distribution.Client.Dependency
 import Distribution.Client.Dependency.Types
          ( Solver(..) )
@@ -1005,7 +1005,7 @@ performInstallations verbosity
         installLocalPackage verbosity buildLimit
                             (packageId pkg) src' distPref $ \mpath ->
           installUnpackedPackage verbosity buildLimit installLock numJobs pkg_key
-                                 (setupScriptOptions installedPkgIndex cacheLock)
+                                 (setupScriptOptions installedPkgIndex cacheLock rpkg)
                                  miscOptions configFlags' installFlags haddockFlags
                                  cinfo platform pkg pkgoverride mpath useLogFile
 
@@ -1019,31 +1019,19 @@ performInstallations verbosity
     distPref        = fromFlagOrDefault (useDistPref defaultSetupScriptOptions)
                       (configDistPref configFlags)
 
-    setupScriptOptions index lock = SetupScriptOptions {
-      useCabalVersion  = chooseCabalVersion configExFlags
-                         (libVersion miscOptions),
-      useCompiler      = Just comp,
-      usePlatform      = Just platform,
-      -- Hack: we typically want to allow the UserPackageDB for finding the
-      -- Cabal lib when compiling any Setup.hs even if we're doing a global
-      -- install. However we also allow looking in a specific package db.
-      usePackageDB     = if UserPackageDB `elem` packageDBs
-                           then packageDBs
-                           else let (db@GlobalPackageDB:dbs) = packageDBs
-                                 in db : UserPackageDB : dbs,
-                                --TODO: use Ord instance:
-                                -- insert UserPackageDB packageDBs
-      usePackageIndex  = if UserPackageDB `elem` packageDBs
-                           then Just index
-                           else Nothing,
-      useProgramConfig = conf,
-      useDistPref      = distPref,
-      useLoggingHandle = Nothing,
-      useWorkingDir    = Nothing,
-      forceExternalSetupMethod = parallelInstall,
-      useWin32CleanHack        = False,
-      setupCacheLock   = Just lock
-    }
+    setupScriptOptions index lock rpkg =
+      configureSetupScript
+        packageDBs
+        comp
+        platform
+        conf
+        distPref
+        (chooseCabalVersion configExFlags (libVersion miscOptions))
+        (Just lock)
+        parallelInstall
+        index
+        (Just rpkg)
+
     reportingLevel = fromFlag (installBuildReports installFlags)
     logsDir        = fromFlag (globalLogsDir globalFlags)
 
diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs
@@ -29,7 +29,7 @@ import Distribution.Version
          , withinRange )
 import Distribution.InstalledPackageInfo (installedPackageId)
 import Distribution.Package
-         ( InstalledPackageId(..), PackageIdentifier(..),
+         ( InstalledPackageId(..), PackageIdentifier(..), PackageId,
            PackageName(..), Package(..), packageName
          , packageVersion, Dependency(..) )
 import Distribution.PackageDescription
@@ -128,6 +128,19 @@ data SetupScriptOptions = SetupScriptOptions {
     useWorkingDir            :: Maybe FilePath,
     forceExternalSetupMethod :: Bool,
 
+    -- | List of dependencies to use when building Setup.hs
+    useDependencies :: [(InstalledPackageId, PackageId)],
+
+    -- | Is the list of setup dependencies exclusive?
+    --
+    -- This is here for legacy reasons. Before the introduction of the explicit
+    -- setup stanza in .cabal files we compiled Setup.hs scripts with all
+    -- packages in the environment visible, but we will needed to restrict
+    -- _some_ packages; in particular, we need to restrict the version of Cabal
+    -- that the setup script gets linked against (this was the only "dependency
+    -- constraint" that we had previously for Setup scripts).
+    useDependenciesExclusive :: Bool,
+
     -- Used only by 'cabal clean' on Windows.
     --
     -- Note: win32 clean hack
@@ -161,6 +174,8 @@ defaultSetupScriptOptions = SetupScriptOptions {
     usePlatform              = Nothing,
     usePackageDB             = [GlobalPackageDB, UserPackageDB],
     usePackageIndex          = Nothing,
+    useDependencies          = [],
+    useDependenciesExclusive = False,
     useProgramConfig         = emptyProgramConfiguration,
     useDistPref              = defaultDistPref,
     useLoggingHandle         = Nothing,
@@ -247,6 +262,7 @@ buildTypeAction (UnknownBuildType _) = error "buildTypeAction UnknownBuildType"
 externalSetupMethod :: SetupMethod
 externalSetupMethod verbosity options pkg bt mkargs = do
   debug verbosity $ "Using external setup method with build-type " ++ show bt
+  debug verbosity $ "Using explicit dependencies: " ++ show (useDependenciesExclusive options)
   createDirectoryIfMissingVerbose verbosity True setupDir
   (cabalLibVersion, mCabalLibInstalledPkgId, options') <- cabalLibVersionToUse
   debug verbosity $ "Using Cabal library version " ++ display cabalLibVersion
@@ -491,6 +507,9 @@ externalSetupMethod verbosity options pkg bt mkargs = do
             = case compilerFlavor compiler of
                       GHCJS -> (ghcjsProgram, ["-build-runner"])
                       _     -> (ghcProgram,   ["-threaded"])
+          cabalDep = maybe [] (\ipkgid -> [(ipkgid, cabalPkgid)])
+                              maybeCabalLibInstalledPkgId
+          addRenaming (ipid, pid) = (ipid, pid, defaultRenaming)
           ghcOptions = mempty {
               ghcOptVerbosity       = Flag verbosity
             , ghcOptMode            = Flag GhcModeMake
@@ -501,9 +520,13 @@ externalSetupMethod verbosity options pkg bt mkargs = do
             , ghcOptSourcePathClear = Flag True
             , ghcOptSourcePath      = toNubListR [workingDir]
             , ghcOptPackageDBs      = usePackageDB options''
+            , ghcOptHideAllPackages = Flag (useDependenciesExclusive options')
             , ghcOptPackages        = toNubListR $
-                maybe [] (\ipkgid -> [(ipkgid, cabalPkgid, defaultRenaming)])
-                maybeCabalLibInstalledPkgId
+                                        map addRenaming $
+                                        if useDependenciesExclusive options'
+                                          then useDependencies options'
+                                          else useDependencies options'
+                                                 ++ cabalDep
             , ghcOptExtra           = toNubListR extraOpts
             }
       let ghcCmdLine = renderGhcOptions compiler ghcOptions
