Add --cabal-ghc/-pkg flags to 'configure'

Add 'SetupWrapperFlags' with flags to configure a path to GHC and GHC-PKG to
build 'Setup.hs'.

This is an initial draft implementation done primarily for code review of the
basic design decision, so only the configure and the install commands respect
these flags.

Author: Sven Heyll

Diff for: cabal-install/Distribution/Client/Config.hs

@@ -44,6 +44,7 @@ import Distribution.Client.BuildReports.Types
          ( ReportLevel(..) )
 import Distribution.Client.Setup
          ( GlobalFlags(..), globalCommand, defaultGlobalFlags
+         , SetupWrapperFlags(..), setupWrapperOptions
          , ConfigExFlags(..), configureExOptions, defaultConfigExFlags
          , InstallFlags(..), installOptions, defaultInstallFlags
          , UploadFlags(..), uploadCommand
@@ -127,6 +128,7 @@ import qualified Data.Map as M
 
 data SavedConfig = SavedConfig {
     savedGlobalFlags       :: GlobalFlags,
+    savedSetupWrapperFlags :: SetupWrapperFlags,
     savedInstallFlags      :: InstallFlags,
     savedConfigureFlags    :: ConfigFlags,
     savedConfigureExFlags  :: ConfigExFlags,
@@ -140,6 +142,7 @@ data SavedConfig = SavedConfig {
 instance Monoid SavedConfig where
   mempty = SavedConfig {
     savedGlobalFlags       = mempty,
+    savedSetupWrapperFlags = mempty,
     savedInstallFlags      = mempty,
     savedConfigureFlags    = mempty,
     savedConfigureExFlags  = mempty,
@@ -151,6 +154,7 @@ instance Monoid SavedConfig where
   }
   mappend a b = SavedConfig {
     savedGlobalFlags       = combine savedGlobalFlags,
+    savedSetupWrapperFlags = combine savedSetupWrapperFlags,
     savedInstallFlags      = combine savedInstallFlags,
     savedConfigureFlags    = combine savedConfigureFlags,
     savedConfigureExFlags  = combine savedConfigureExFlags,
@@ -367,6 +371,7 @@ commentSavedConfig = do
   globalInstallDirs <- defaultInstallDirs defaultCompiler False True
   return SavedConfig {
     savedGlobalFlags       = defaultGlobalFlags,
+    savedSetupWrapperFlags = mempty,
     savedInstallFlags      = defaultInstallFlags,
     savedConfigureExFlags  = defaultConfigExFlags,
     savedConfigureFlags    = (defaultConfigFlags defaultProgramConfiguration) {
@@ -388,6 +393,10 @@ configFieldDescriptions =
        (commandOptions globalCommand ParseArgs)
        ["version", "numeric-version", "config-file", "sandbox-config-file"] []
 
+  ++ toSavedConfig liftSetupWrapperFlag
+       (setupWrapperOptions ParseArgs)
+       [] []
+
   ++ toSavedConfig liftConfigFlag
        (configureOptions ParseArgs)
        (["builddir", "constraint", "dependency"]
@@ -501,6 +510,10 @@ liftGlobalFlag :: FieldDescr GlobalFlags -> FieldDescr SavedConfig
 liftGlobalFlag = liftField
   savedGlobalFlags (\flags conf -> conf { savedGlobalFlags = flags })
 
+liftSetupWrapperFlag :: FieldDescr SetupWrapperFlags -> FieldDescr SavedConfig
+liftSetupWrapperFlag = liftField
+  savedSetupWrapperFlags (\flags conf -> conf { savedSetupWrapperFlags = flags })
+
 liftConfigFlag :: FieldDescr ConfigFlags -> FieldDescr SavedConfig
 liftConfigFlag = liftField
   savedConfigureFlags (\flags conf -> conf { savedConfigureFlags = flags })

Diff for: cabal-install/Distribution/Client/Configure.hs

@@ -22,10 +22,12 @@ import Distribution.Client.InstallPlan (InstallPlan)
 import Distribution.Client.IndexUtils as IndexUtils
          ( getSourcePackages, getInstalledPackages )
 import Distribution.Client.Setup
-         ( ConfigExFlags(..), configureCommand, filterConfigureFlags )
+         ( ConfigExFlags(..), configureCommand, filterConfigureFlags
+         , SetupWrapperFlags(..) )
 import Distribution.Client.Types as Source
 import Distribution.Client.SetupWrapper
-         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
+         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions
+         , updateSetupScriptOptions )
 import Distribution.Client.Targets
          ( userToPackageConstraint )
 
@@ -80,12 +82,13 @@ configure :: Verbosity
           -> Compiler
           -> Platform
           -> ProgramConfiguration
+          -> SetupWrapperFlags
           -> ConfigFlags
           -> ConfigExFlags
           -> [String]
           -> IO ()
 configure verbosity packageDBs repos comp platform conf
-  configFlags configExFlags extraArgs = do
+  setupWrapperFlags configFlags configExFlags extraArgs = do
 
   installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
   sourcePkgDb       <- getSourcePackages    verbosity repos
@@ -114,7 +117,8 @@ configure verbosity packageDBs repos comp platform conf
               ++ "one local ready package."
 
   where
-    setupScriptOptions index = SetupScriptOptions {
+    setupScriptOptions index =
+      updateSetupScriptOptions setupWrapperFlags $ defaultSetupScriptOptions {
       useCabalVersion  = chooseCabalVersion configExFlags
                          (flagToMaybe (configCabalVersion configExFlags)),
       useCompiler      = Just comp,

Diff for: cabal-install/Distribution/Client/Install.hs

@@ -72,6 +72,7 @@ import qualified Distribution.Client.InstallPlan as InstallPlan
 import Distribution.Client.InstallPlan (InstallPlan)
 import Distribution.Client.Setup
          ( GlobalFlags(..)
+         , SetupWrapperFlags(..)
          , ConfigFlags(..), configureCommand, filterConfigureFlags
          , ConfigExFlags(..), InstallFlags(..) )
 import Distribution.Client.Config
@@ -86,7 +87,8 @@ import Distribution.Client.Types as Source
 import Distribution.Client.BuildReports.Types
          ( ReportLevel(..) )
 import Distribution.Client.SetupWrapper
-         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
+         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions
+         , updateSetupScriptOptions )
 import qualified Distribution.Client.BuildReports.Anonymous as BuildReports
 import qualified Distribution.Client.BuildReports.Storage as BuildReports
          ( storeAnonymous, storeLocal, fromInstallPlan, fromPlanningFailure )
@@ -179,15 +181,16 @@ install
   -> UseSandbox
   -> Maybe SandboxPackageInfo
   -> GlobalFlags
+  -> SetupWrapperFlags
   -> ConfigFlags
   -> ConfigExFlags
   -> InstallFlags
   -> HaddockFlags
   -> [UserTarget]
   -> IO ()
 install verbosity packageDBs repos comp platform conf useSandbox mSandboxPkgInfo
-  globalFlags configFlags configExFlags installFlags haddockFlags
-  userTargets0 = do
+  globalFlags setupWrapperFlags configFlags configExFlags installFlags
+  haddockFlags userTargets0 = do
 
     installContext <- makeInstallContext verbosity args (Just userTargets0)
     planResult     <- foldProgress logMsg (return . Left) (return . Right) =<<
@@ -201,9 +204,9 @@ install verbosity packageDBs repos comp platform conf useSandbox mSandboxPkgInfo
             processInstallPlan verbosity args installContext installPlan
   where
     args :: InstallArgs
-    args = (packageDBs, repos, comp, platform, conf, useSandbox, mSandboxPkgInfo,
-            globalFlags, configFlags, configExFlags, installFlags,
-            haddockFlags)
+    args = (packageDBs, repos, comp, platform, conf, useSandbox,
+            mSandboxPkgInfo, globalFlags, setupWrapperFlags, configFlags,
+            configExFlags, installFlags, haddockFlags)
 
     die' message = die (message ++ if isUseSandbox useSandbox
                                    then installFailedInSandbox else [])
@@ -231,6 +234,7 @@ type InstallArgs = ( PackageDBStack
                    , UseSandbox
                    , Maybe SandboxPackageInfo
                    , GlobalFlags
+                   , SetupWrapperFlags
                    , ConfigFlags
                    , ConfigExFlags
                    , InstallFlags
@@ -241,7 +245,7 @@ makeInstallContext :: Verbosity -> InstallArgs -> Maybe [UserTarget]
                       -> IO InstallContext
 makeInstallContext verbosity
   (packageDBs, repos, comp, _, conf,_,_,
-   globalFlags, _, _, _, _) mUserTargets = do
+   globalFlags, _, _, _, _, _) mUserTargets = do
 
     installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
     sourcePkgDb       <- getSourcePackages    verbosity repos
@@ -271,7 +275,7 @@ makeInstallPlan :: Verbosity -> InstallArgs -> InstallContext
                 -> IO (Progress String String InstallPlan)
 makeInstallPlan verbosity
   (_, _, comp, platform, _, _, mSandboxPkgInfo,
-   _, configFlags, configExFlags, installFlags,
+   _, _, configFlags, configExFlags, installFlags,
    _)
   (installedPkgIndex, sourcePkgDb,
    _, pkgSpecifiers) = do
@@ -288,7 +292,7 @@ processInstallPlan :: Verbosity -> InstallArgs -> InstallContext
                    -> InstallPlan
                    -> IO ()
 processInstallPlan verbosity
-  args@(_,_, comp, _, _, _, _, _, _, _, installFlags, _)
+  args@(_,_, comp, _, _, _, _, _, _, _, _, installFlags, _)
   (installedPkgIndex, sourcePkgDb,
    userTargets, pkgSpecifiers) installPlan = do
     checkPrintPlan verbosity comp installedPkgIndex installPlan sourcePkgDb
@@ -654,7 +658,7 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of
 -- 'postInstallActions', as (by definition) we don't have an install plan.
 reportPlanningFailure :: Verbosity -> InstallArgs -> InstallContext -> String -> IO ()
 reportPlanningFailure verbosity
-  (_, _, comp, platform, _, _, _
+  (_, _, comp, platform, _, _, _, _
   ,_, configFlags, _, installFlags, _)
   (_, sourcePkgDb, _, pkgSpecifiers)
   message = do
@@ -730,7 +734,7 @@ postInstallActions :: Verbosity
                    -> IO ()
 postInstallActions verbosity
   (packageDBs, _, comp, platform, conf, useSandbox, mSandboxPkgInfo
-  ,globalFlags, configFlags, _, installFlags, _)
+  ,globalFlags, _, configFlags, _, installFlags, _)
   targets installPlan = do
 
   unless oneShot $
@@ -966,7 +970,8 @@ performInstallations :: Verbosity
                      -> IO InstallPlan
 performInstallations verbosity
   (packageDBs, _, comp, _, conf, useSandbox, _,
-   globalFlags, configFlags, configExFlags, installFlags, haddockFlags)
+   globalFlags, setupWrapperFlags, configFlags, configExFlags, installFlags,
+   haddockFlags)
   installedPkgIndex installPlan = do
 
   -- With 'install -j' it can be a bit hard to tell whether a sandbox is used.
@@ -1006,7 +1011,8 @@ performInstallations verbosity
     distPref        = fromFlagOrDefault (useDistPref defaultSetupScriptOptions)
                       (configDistPref configFlags)
 
-    setupScriptOptions index lock = SetupScriptOptions {
+    setupScriptOptions index lock =
+      updateSetupScriptOptions setupWrapperFlags $ defaultSetupScriptOptions {
       useCabalVersion  = chooseCabalVersion configExFlags
                          (libVersion miscOptions),
       useCompiler      = Just comp,

Diff for: cabal-install/Distribution/Client/Sandbox.hs

@@ -41,8 +41,9 @@ module Distribution.Client.Sandbox (
 
 import Distribution.Client.Setup
   ( SandboxFlags(..), ConfigFlags(..), ConfigExFlags(..), InstallFlags(..)
-  , GlobalFlags(..), defaultConfigExFlags, defaultInstallFlags
-  , defaultSandboxLocation, globalRepos )
+  , GlobalFlags(..), SetupWrapperFlags(..)
+  , defaultConfigExFlags, defaultInstallFlags, defaultSandboxLocation
+  , globalRepos )
 import Distribution.Client.Sandbox.Timestamp  ( listModifiedDeps
                                               , maybeAddCompilerTimestampRecord
                                               , withAddTimestamps
@@ -549,12 +550,13 @@ data WereDepsReinstalled = ReinstalledSomeDeps | NoDepsReinstalled
 -- | Reinstall those add-source dependencies that have been modified since
 -- we've last installed them. Assumes that we're working inside a sandbox.
 reinstallAddSourceDeps :: Verbosity
-                          -> ConfigFlags  -> ConfigExFlags
-                          -> InstallFlags -> GlobalFlags
+                          -> ConfigFlags  -> ConfigExFlags -> InstallFlags
+                          -> GlobalFlags -> SetupWrapperFlags
                           -> FilePath
                           -> IO WereDepsReinstalled
-reinstallAddSourceDeps verbosity configFlags' configExFlags
-                       installFlags globalFlags sandboxDir = topHandler' $ do
+reinstallAddSourceDeps verbosity configFlags' configExFlags installFlags
+                       globalFlags setupWrapperFlags
+                       sandboxDir = topHandler' $ do
   let sandboxDistPref     = sandboxBuildDir sandboxDir
       configFlags         = configFlags'
                             { configDistPref  = Flag sandboxDistPref }
@@ -572,7 +574,8 @@ reinstallAddSourceDeps verbosity configFlags' configExFlags
                  ,(globalRepos globalFlags)
                  ,comp, platform, conf
                  ,UseSandbox sandboxDir, Just sandboxPkgInfo
-                 ,globalFlags, configFlags, configExFlags, installFlags
+                 ,globalFlags, setupWrapperFlags
+                 ,configFlags, configExFlags, installFlags
                  ,haddockFlags)
 
       -- This can actually be replaced by a call to 'install', but we use a
@@ -682,34 +685,40 @@ maybeReinstallAddSourceDeps :: Verbosity
                                -> ConfigFlags      -- ^ Saved configure flags
                                                    -- (from dist/setup-config)
                                -> GlobalFlags
+                               -> SetupWrapperFlags
                                -> IO (UseSandbox, SavedConfig
                                      ,WereDepsReinstalled)
-maybeReinstallAddSourceDeps verbosity numJobsFlag configFlags' globalFlags' = do
+maybeReinstallAddSourceDeps verbosity
+                            numJobsFlag
+                            configFlags'
+                            globalFlags'
+                            setupWrapperFlags' = do
   (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags'
                           (configUserInstall configFlags')
   case useSandbox of
     NoSandbox             -> return (NoSandbox, config, NoDepsReinstalled)
     UseSandbox sandboxDir -> do
       -- Reinstall the modified add-source deps.
-      let configFlags    = savedConfigureFlags config
-                           `mappendSomeSavedFlags`
-                           configFlags'
-          configExFlags  = defaultConfigExFlags
-                           `mappend` savedConfigureExFlags config
-          installFlags'  = defaultInstallFlags
-                           `mappend` savedInstallFlags config
-          installFlags   = installFlags' {
-            installNumJobs    = installNumJobs installFlags'
-                                `mappend` numJobsFlag
+      let configFlags       = savedConfigureFlags config
+                              `mappendSomeSavedFlags` configFlags'
+          configExFlags     = defaultConfigExFlags
+                              `mappend` savedConfigureExFlags config
+          installFlags'     = defaultInstallFlags
+                              `mappend` savedInstallFlags config
+          installFlags      = installFlags' {
+            installNumJobs      = installNumJobs installFlags'
+                                  `mappend` numJobsFlag
             }
-          globalFlags    = savedGlobalFlags config
           -- This makes it possible to override things like 'remote-repo-cache'
           -- from the command line. These options are hidden, and are only
           -- useful for debugging, so this should be fine.
-                           `mappend` globalFlags'
+          globalFlags       = savedGlobalFlags config
+                              `mappend` globalFlags'
+          setupWrapperFlags = savedSetupWrapperFlags config
+                              `mappend` setupWrapperFlags'
       depsReinstalled <- reinstallAddSourceDeps verbosity
                          configFlags configExFlags installFlags globalFlags
-                         sandboxDir
+                         setupWrapperFlags sandboxDir
       return (UseSandbox sandboxDir, config, depsReinstalled)
 
   where