From 06c2501e48608024c1d80887c485c4596b8cf9e3 Mon Sep 17 00:00:00 2001 From: Sven Heyll Date: Sun, 2 Nov 2014 15:19:44 +0100 Subject: [PATCH] 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. --- cabal-install/Distribution/Client/Config.hs | 13 +++ .../Distribution/Client/Configure.hs | 12 ++- cabal-install/Distribution/Client/Install.hs | 32 ++++--- cabal-install/Distribution/Client/Sandbox.hs | 51 ++++++----- cabal-install/Distribution/Client/Setup.hs | 72 ++++++++++++++-- .../Distribution/Client/SetupWrapper.hs | 32 ++++++- cabal-install/Main.hs | 84 +++++++++++-------- 7 files changed, 213 insertions(+), 83 deletions(-) diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index 870b55b661e..6f845a168f5 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/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 --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index 4e1b7287bb3..8c5015a2598 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/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 --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index c6f1868028d..957c13b7a02 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/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,6 +181,7 @@ install -> UseSandbox -> Maybe SandboxPackageInfo -> GlobalFlags + -> SetupWrapperFlags -> ConfigFlags -> ConfigExFlags -> InstallFlags @@ -186,8 +189,8 @@ install -> [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 --git a/cabal-install/Distribution/Client/Sandbox.hs b/cabal-install/Distribution/Client/Sandbox.hs index 61bcee2d0ba..e3ad023c276 100644 --- a/cabal-install/Distribution/Client/Sandbox.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index d48148004ab..2fdf13650d9 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -12,6 +12,7 @@ ----------------------------------------------------------------------------- module Distribution.Client.Setup ( globalCommand, GlobalFlags(..), defaultGlobalFlags, globalRepos + , SetupWrapperFlags(..), setupWrapperOptions , configureCommand, ConfigFlags(..), filterConfigureFlags , configureExCommand, ConfigExFlags(..), defaultConfigExFlags , configureExOptions @@ -255,6 +256,48 @@ globalRepos globalFlags = remoteRepos ++ localRepos [ Repo (Right LocalRepo) local | local <- fromNubList $ globalLocalRepos globalFlags ] +-- ------------------------------------------------------------ +-- * Setup Wrapper flags +-- ------------------------------------------------------------ + +-- | Configure how `SetupWrapper` compiles `Setup.hs'. +-- +-- Allow configuration of the compiler that us used to compile +-- the setup program when the external setup method is used. +-- Configuration of these flags is currently hooked to the +-- configure command. Additionally the user can set these flags +-- in the cabal user configuration file, e.g. `~/.cabal/config'. +-- +-- As mentioned in `SetupWrapper' currently this is limited to +-- GHC. +data SetupWrapperFlags = SetupWrapperFlags + { setupWrapperGhcPath :: Flag FilePath + , setupWrapperPkgPath :: Flag FilePath + } + +setupWrapperOptions :: ShowOrParseArgs -> [OptionField SetupWrapperFlags] +setupWrapperOptions _showOrParseArgs = + [ option [] ["cabal-ghc"] + "Select the 'ghc' executable to compile 'Setup.[l]hs' with." + setupWrapperGhcPath (\v flags -> flags { setupWrapperGhcPath = v }) + (reqArgFlag "PATH") + , option [] ["cabal-pkg"] + "Select the 'ghc-pkg' to use when compiling 'Setup.[l]hs'." + setupWrapperPkgPath (\v flags -> flags { setupWrapperPkgPath = v }) + (reqArgFlag "PATH") + ] + +instance Monoid SetupWrapperFlags where + mempty = SetupWrapperFlags { + setupWrapperGhcPath = mempty, + setupWrapperPkgPath = mempty + } + mappend a b = SetupWrapperFlags { + setupWrapperGhcPath = combine setupWrapperGhcPath, + setupWrapperPkgPath = combine setupWrapperPkgPath + } + where combine field = field a `mappend` field b + -- ------------------------------------------------------------ -- * Config flags -- ------------------------------------------------------------ @@ -315,18 +358,29 @@ defaultConfigExFlags :: ConfigExFlags defaultConfigExFlags = mempty { configSolver = Flag defaultSolver , configAllowNewer = Flag AllowNewerNone } -configureExCommand :: CommandUI (ConfigFlags, ConfigExFlags) +configureExCommand :: CommandUI (SetupWrapperFlags, ConfigFlags, ConfigExFlags) configureExCommand = configureCommand { - commandDefaultFlags = (mempty, defaultConfigExFlags), - commandOptions = \showOrParseArgs -> - liftOptions fst setFst - (filter ((`notElem` ["constraint", "dependency", "exact-configuration"]) - . optionName) $ configureOptions showOrParseArgs) - ++ liftOptions snd setSnd (configureExOptions showOrParseArgs) + commandDefaultFlags = (mempty, mempty, defaultConfigExFlags), + commandOptions = \ sOrP -> liftFirst ( setupWrapperOptions sOrP ) + ++ liftSecond ( visConfigureOptions sOrP ) + ++ liftThird ( configureExOptions sOrP ) } where - setFst a (_,b) = (a,b) - setSnd b (a,_) = (a,b) + visConfigureOptions = filter (not . hidden . optionName) . configureOptions + where + hidden = (`elem` ["constraint", "dependency", "exact-configuration"]) + + liftFirst = liftOptions getFirst setFirst + where getFirst (a,_,_) = a + setFirst a (_,b,c) = (a,b,c) + + liftSecond = liftOptions getSecond setSecond + where getSecond (_,b,_) = b + setSecond b (a,_,c) = (a,b,c) + + liftThird = liftOptions getThird setThird + where getThird (_,_,c) = c + setThird c (a,b,_) = (a,b,c) configureExOptions :: ShowOrParseArgs -> [OptionField ConfigExFlags] configureExOptions _showOrParseArgs = diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs index 874acc881af..3caf8837b45 100644 --- a/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/Distribution/Client/SetupWrapper.hs @@ -19,6 +19,7 @@ module Distribution.Client.SetupWrapper ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions, + updateSetupScriptOptions ) where import qualified Distribution.Make as Make @@ -59,10 +60,14 @@ import Distribution.Simple.Command ( CommandUI(..), commandShowOptions ) import Distribution.Simple.Program.GHC ( GhcMode(..), GhcOptions(..), renderGhcOptions ) +import Distribution.Simple.Setup + ( flagToMaybe ) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.Client.Config ( defaultCabalDir ) +import Distribution.Client.Setup + ( SetupWrapperFlags(..) ) import Distribution.Client.IndexUtils ( getInstalledPackages ) import Distribution.Client.JobControl @@ -95,7 +100,7 @@ import Control.Applicative ( (<$>), (<*>) ) import Control.Monad ( when, unless ) import Data.List ( foldl1' ) import Data.Maybe ( fromMaybe, isJust ) -import Data.Monoid ( mempty ) +import Data.Monoid ( mempty, mappend ) import Data.Char ( isSpace ) #ifdef mingw32_HOST_OS @@ -108,8 +113,23 @@ import System.Directory ( doesDirectoryExist ) import qualified System.Win32 as Win32 #endif +-- | Update options based on flags. +-- +-- If a flag is missing the corresponding field is not updated. +updateSetupScriptOptions :: SetupWrapperFlags + -> SetupScriptOptions + -> SetupScriptOptions +updateSetupScriptOptions flags opts = + opts { useGhcPath = flagToMaybe (setupWrapperGhcPath flags) + `mappend` useGhcPath opts + , usePkgPath = flagToMaybe (setupWrapperPkgPath flags) + `mappend` usePkgPath opts + } + data SetupScriptOptions = SetupScriptOptions { useCabalVersion :: VersionRange, + useGhcPath :: Maybe FilePath, + usePkgPath :: Maybe FilePath, useCompiler :: Maybe Compiler, usePlatform :: Maybe Platform, usePackageDB :: PackageDBStack, @@ -144,6 +164,8 @@ data SetupScriptOptions = SetupScriptOptions { defaultSetupScriptOptions :: SetupScriptOptions defaultSetupScriptOptions = SetupScriptOptions { useCabalVersion = anyVersion, + useGhcPath = Nothing, + usePkgPath = Nothing, useCompiler = Nothing, usePlatform = Nothing, usePackageDB = [GlobalPackageDB, UserPackageDB], @@ -392,8 +414,12 @@ externalSetupMethod verbosity options pkg bt mkargs = do (comp, conf) <- case useCompiler options' of Just comp -> return (comp, useProgramConfig options') Nothing -> do (comp, _, conf) <- - configCompilerEx (Just GHC) Nothing Nothing - (useProgramConfig options') verbosity + configCompilerEx + (Just GHC) + (useGhcPath options') + (usePkgPath options') + (useProgramConfig options') + verbosity return (comp, conf) -- Whenever we need to call configureCompiler, we also need to access the -- package index, so let's cache it here. diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index c48b8a2de76..850f50a8abf 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -17,6 +17,7 @@ module Main (main) where import Distribution.Client.Setup ( GlobalFlags(..), globalCommand, globalRepos + , SetupWrapperFlags(..) , ConfigFlags(..) , ConfigExFlags(..), defaultConfigExFlags, configureExCommand , BuildFlags(..), BuildExFlags(..), SkipAddSourceDepsCheck(..) @@ -270,16 +271,23 @@ wrapperAction command verbosityFlag distPrefFlag = setupWrapper verbosity setupScriptOptions Nothing command (const flags) extraArgs -configureAction :: (ConfigFlags, ConfigExFlags) +configureAction :: (SetupWrapperFlags, ConfigFlags, ConfigExFlags) -> [String] -> GlobalFlags -> IO () -configureAction (configFlags, configExFlags) extraArgs globalFlags = do +configureAction (setupWrapperFlags, configFlags, configExFlags) + extraArgs + globalFlags = do let verbosity = fromFlagOrDefault normal (configVerbosity configFlags) (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags (configUserInstall configFlags) - let configFlags' = savedConfigureFlags config `mappend` configFlags - configExFlags' = savedConfigureExFlags config `mappend` configExFlags - globalFlags' = savedGlobalFlags config `mappend` globalFlags + let globalFlags' = savedGlobalFlags config + `mappend` globalFlags + setupWrapperFlags' = savedSetupWrapperFlags config + `mappend` setupWrapperFlags + configFlags' = savedConfigureFlags config + `mappend` configFlags + configExFlags' = savedConfigureExFlags config + `mappend` configExFlags (comp, platform, conf) <- configCompilerAuxEx configFlags' -- If we're working inside a sandbox and the user has set the -w option, we @@ -304,10 +312,16 @@ configureAction (configFlags, configExFlags) extraArgs globalFlags = do configure verbosity (configPackageDB' configFlags'') (globalRepos globalFlags') - comp platform conf configFlags'' configExFlags' extraArgs - -buildAction :: (BuildFlags, BuildExFlags) -> [String] -> GlobalFlags -> IO () -buildAction (buildFlags, buildExFlags) extraArgs globalFlags = do + comp platform conf setupWrapperFlags' configFlags'' + configExFlags' extraArgs + +buildAction :: (BuildFlags, BuildExFlags) + -> [String] + -> GlobalFlags + -> IO () +buildAction (buildFlags, buildExFlags) + extraArgs + globalFlags = do let distPref = fromFlagOrDefault (useDistPref defaultSetupScriptOptions) (buildDistPref buildFlags) verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags) @@ -317,7 +331,7 @@ buildAction (buildFlags, buildExFlags) extraArgs globalFlags = do -- Calls 'configureAction' to do the real work, so nothing special has to be -- done to support sandboxes. (useSandbox, config) <- reconfigure verbosity distPref - mempty [] globalFlags noAddSource + mempty [] globalFlags mempty noAddSource (buildNumJobs buildFlags) (const Nothing) maybeWithSandboxDirOnSearchPath useSandbox $ @@ -390,7 +404,7 @@ replAction (replFlags, buildExFlags) extraArgs globalFlags = do -- Calls 'configureAction' to do the real work, so nothing special has to -- be done to support sandboxes. (useSandbox, _config) <- reconfigure verbosity distPref - mempty [] globalFlags noAddSource NoFlag + mempty [] globalFlags mempty noAddSource NoFlag (const Nothing) maybeWithSandboxDirOnSearchPath useSandbox $ @@ -423,7 +437,7 @@ replAction (replFlags, buildExFlags) extraArgs globalFlags = do -- LocalBuildInfo), we must configure first, using the default options. -- -- If the package has been configured, there will be a 'LocalBuildInfo'. --- If there no package description file, we assume that the +-- If there is no package description file, we assume that the -- 'PackageDescription' is up to date, though the configuration may need -- to be updated for other reasons (see above). If there is a package -- description file, and it has been modified since the 'LocalBuildInfo' @@ -449,6 +463,8 @@ reconfigure :: Verbosity -- ^ Verbosity setting -- set them here. -> [String] -- ^ Extra arguments -> GlobalFlags -- ^ Global flags + -> SetupWrapperFlags + -- ^ Setup-wrapper flags -> SkipAddSourceDepsCheck -- ^ Should we skip the timestamp check for modified -- add-source dependencies? @@ -464,8 +480,8 @@ reconfigure :: Verbosity -- ^ Verbosity setting -- automatically; this function need not check -- for it. -> IO (UseSandbox, SavedConfig) -reconfigure verbosity distPref addConfigFlags extraArgs globalFlags - skipAddSourceDepsCheck numJobsFlag checkFlags = do +reconfigure verbosity distPref addConfigFlags extraArgs globalFlags + setupWrpFlags skipAddSourceDepsCheck numJobsFlag checkFlags = do eLbi <- tryGetPersistBuildConfig distPref case eLbi of Left (err, errCode) -> onNoBuildConfig err errCode @@ -490,7 +506,7 @@ reconfigure verbosity distPref addConfigFlags extraArgs globalFlags _ -> do notice verbosity $ msg ++ " Configuring with default flags." ++ configureManually - configureAction (defaultFlags, defaultConfigExFlags) + configureAction (setupWrpFlags, defaultFlags, defaultConfigExFlags) extraArgs globalFlags loadConfigOrSandboxConfig verbosity globalFlags mempty @@ -522,7 +538,8 @@ reconfigure verbosity distPref addConfigFlags extraArgs globalFlags (useSandbox, config, depsReinstalled) <- case skipAddSourceDepsCheck' of DontSkipAddSourceDepsCheck -> - maybeReinstallAddSourceDeps verbosity numJobsFlag flags globalFlags + maybeReinstallAddSourceDeps verbosity numJobsFlag flags + globalFlags setupWrpFlags SkipAddSourceDepsCheck -> do (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags (configUserInstall flags) @@ -548,7 +565,7 @@ reconfigure verbosity distPref addConfigFlags extraArgs globalFlags -- Show the message and reconfigure. Just msg -> do notice verbosity msg - configureAction (flags, defaultConfigExFlags) + configureAction (setupWrpFlags, flags, defaultConfigExFlags) extraArgs globalFlags return (useSandbox, config) @@ -651,15 +668,16 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags) let sandboxDistPref = case useSandbox of NoSandbox -> NoFlag UseSandbox sandboxDir -> Flag $ sandboxBuildDir sandboxDir - configFlags' = maybeForceTests installFlags' $ - savedConfigureFlags config `mappend` configFlags - configExFlags' = defaultConfigExFlags `mappend` - savedConfigureExFlags config `mappend` configExFlags - installFlags' = defaultInstallFlags `mappend` - savedInstallFlags config `mappend` installFlags - haddockFlags' = defaultHaddockFlags `mappend` - savedHaddockFlags config `mappend` haddockFlags - globalFlags' = savedGlobalFlags config `mappend` globalFlags + configFlags' = maybeForceTests installFlags' $ + savedConfigureFlags config `mappend` configFlags + configExFlags' = defaultConfigExFlags `mappend` + savedConfigureExFlags config `mappend` configExFlags + installFlags' = defaultInstallFlags `mappend` + savedInstallFlags config `mappend` installFlags + haddockFlags' = defaultHaddockFlags `mappend` + savedHaddockFlags config `mappend` haddockFlags + globalFlags' = savedGlobalFlags config `mappend` globalFlags + setupWrapperFlags = savedSetupWrapperFlags config (comp, platform, conf) <- configCompilerAux' configFlags' -- If we're working inside a sandbox and the user has set the -w option, we @@ -692,8 +710,8 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags) (globalRepos globalFlags') comp platform conf useSandbox mSandboxPkgInfo - globalFlags' configFlags'' configExFlags' - installFlags' haddockFlags' + globalFlags' setupWrapperFlags + configFlags'' configExFlags' installFlags' haddockFlags' targets where @@ -722,7 +740,7 @@ testAction (testFlags, buildFlags, buildExFlags) extraArgs globalFlags = do -- reconfigure also checks if we're in a sandbox and reinstalls add-source -- deps if needed. (useSandbox, config) <- reconfigure verbosity distPref addConfigFlags [] - globalFlags noAddSource + globalFlags mempty noAddSource (buildNumJobs buildFlags') checkFlags -- the package was just configured, so the LBI must be available @@ -767,8 +785,8 @@ benchmarkAction (benchmarkFlags, buildFlags, buildExFlags) -- reconfigure also checks if we're in a sandbox and reinstalls add-source -- deps if needed. (useSandbox, config) <- reconfigure verbosity distPref addConfigFlags [] - globalFlags noAddSource (buildNumJobs buildFlags') - checkFlags + globalFlags mempty noAddSource + (buildNumJobs buildFlags') checkFlags -- the package was just configured, so the LBI must be available lbi <- getPersistBuildConfig distPref @@ -993,8 +1011,8 @@ runAction (buildFlags, buildExFlags) extraArgs globalFlags = do -- reconfigure also checks if we're in a sandbox and reinstalls add-source -- deps if needed. (useSandbox, config) <- reconfigure verbosity distPref mempty [] - globalFlags noAddSource (buildNumJobs buildFlags) - (const Nothing) + globalFlags mempty noAddSource + (buildNumJobs buildFlags) (const Nothing) lbi <- getPersistBuildConfig distPref (exe, exeArgs) <- splitRunArgs lbi extraArgs