diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 3db3c79c13d..fef2ca5dda9 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -35,6 +35,7 @@ module Distribution.Client.Setup , initCommand, IT.InitFlags(..) , sdistCommand, SDistFlags(..), SDistExFlags(..), ArchiveFormat(..) , win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..) + , actAsSetupCommand, ActAsSetupFlags(..) , sandboxCommand, defaultSandboxLocation, SandboxFlags(..) , execCommand, ExecFlags(..) , userConfigCommand, UserConfigFlags(..) @@ -79,7 +80,7 @@ import Distribution.Version import Distribution.Package ( PackageIdentifier, packageName, packageVersion, Dependency(..) ) import Distribution.PackageDescription - ( RepoKind(..) ) + ( BuildType(..), RepoKind(..) ) import Distribution.Text ( Text(..), display ) import Distribution.ReadE @@ -1813,6 +1814,47 @@ instance Monoid Win32SelfUpgradeFlags where } where combine field = field a `mappend` field b +-- ------------------------------------------------------------ +-- * ActAsSetup flags +-- ------------------------------------------------------------ + +data ActAsSetupFlags = ActAsSetupFlags { + actAsSetupBuildType :: Flag BuildType +} + +defaultActAsSetupFlags :: ActAsSetupFlags +defaultActAsSetupFlags = ActAsSetupFlags { + actAsSetupBuildType = toFlag Simple +} + +actAsSetupCommand :: CommandUI ActAsSetupFlags +actAsSetupCommand = CommandUI { + commandName = "act-as-setup", + commandSynopsis = "Run as-if this was a Setup.hs", + commandDescription = Nothing, + commandNotes = Nothing, + commandUsage = \pname -> + "Usage: " ++ pname ++ " act-as-setup\n", + commandDefaultFlags = defaultActAsSetupFlags, + commandOptions = \_ -> + [option "" ["build-type"] + "Use the given build type." + actAsSetupBuildType (\v flags -> flags { actAsSetupBuildType = v }) + (reqArg "BUILD-TYPE" (readP_to_E ("Cannot parse build type: "++) + (fmap toFlag parse)) + (map display . flagToList)) + ] +} + +instance Monoid ActAsSetupFlags where + mempty = ActAsSetupFlags { + actAsSetupBuildType = mempty + } + mappend a b = ActAsSetupFlags { + actAsSetupBuildType = combine actAsSetupBuildType + } + where combine field = field a `mappend` field b + -- ------------------------------------------------------------ -- * Sandbox-related flags -- ------------------------------------------------------------ diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs index d92dcb61544..90ca68c92c6 100644 --- a/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/Distribution/Client/SetupWrapper.hs @@ -105,6 +105,7 @@ import Control.Monad ( when, unless ) import Data.List ( foldl1' ) import Data.Maybe ( fromMaybe, isJust ) import Data.Char ( isSpace ) +import Distribution.Client.Compat.ExecutablePath ( getExecutablePath ) #ifdef mingw32_HOST_OS import Distribution.Simple.Utils @@ -222,12 +223,22 @@ setupWrapper verbosity options mpkg cmd flags extraArgs = do -- determineSetupMethod :: SetupScriptOptions -> BuildType -> SetupMethod determineSetupMethod options buildType' - | forceExternalSetupMethod options = externalSetupMethod + -- This order is picked so that it's stable. The build type and + -- required cabal version are external info, coming from .cabal + -- files and the command line. Those do switch between the + -- external and self & internal methods, but that info itself can + -- be considered stable. The logging and force-external conditions + -- are internally generated choices but now these only switch + -- between the self and internal setup methods, which are + -- consistent with each other. + | buildType' == Custom = externalSetupMethod + | not (cabalVersion `withinRange` + useCabalVersion options) = externalSetupMethod | isJust (useLoggingHandle options) - || buildType' == Custom = externalSetupMethod - | cabalVersion `withinRange` - useCabalVersion options = internalSetupMethod - | otherwise = externalSetupMethod + -- Forcing is done to use an external process e.g. due to parallel + -- build concerns. + || forceExternalSetupMethod options = selfExecSetupMethod + | otherwise = internalSetupMethod type SetupMethod = Verbosity -> SetupScriptOptions @@ -255,6 +266,34 @@ buildTypeAction Make = Make.defaultMainArgs buildTypeAction Custom = error "buildTypeAction Custom" buildTypeAction (UnknownBuildType _) = error "buildTypeAction UnknownBuildType" +-- ------------------------------------------------------------ +-- * Self-Exec SetupMethod +-- ------------------------------------------------------------ + +selfExecSetupMethod :: SetupMethod +selfExecSetupMethod verbosity options _pkg bt mkargs = do + let args = ["act-as-setup", + "--build-type=" ++ display bt, + "--"] ++ mkargs cabalVersion + debug verbosity $ "Using self-exec internal setup method with build-type " + ++ show bt ++ " and args:\n " ++ show args + path <- getExecutablePath + info verbosity $ unwords (path : args) + case useLoggingHandle options of + Nothing -> return () + Just logHandle -> info verbosity $ "Redirecting build log to " + ++ show logHandle + + searchpath <- programSearchPathAsPATHVar + (getProgramSearchPath (useProgramConfig options)) + env <- getEffectiveEnvironment [("PATH", Just searchpath)] + + process <- runProcess path args + (useWorkingDir options) env Nothing + (useLoggingHandle options) (useLoggingHandle options) + exitCode <- waitForProcess process + unless (exitCode == ExitSuccess) $ exitWith exitCode + -- ------------------------------------------------------------ -- * External SetupMethod -- ------------------------------------------------------------ diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index 5289e82820f..5beb93f330e 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -37,6 +37,7 @@ import Distribution.Client.Setup , InitFlags(initVerbosity), initCommand , SDistFlags(..), SDistExFlags(..), sdistCommand , Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand + , ActAsSetupFlags(..), actAsSetupCommand , SandboxFlags(..), sandboxCommand , ExecFlags(..), execCommand , UserConfigFlags(..), userConfigCommand @@ -112,12 +113,14 @@ import Distribution.Client.Utils (determineNumJobs ,existsAndIsMoreRecentThan) import Distribution.PackageDescription - ( Executable(..), benchmarkName, benchmarkBuildInfo, testName - , testBuildInfo, buildable ) + ( BuildType(..), Executable(..), benchmarkName, benchmarkBuildInfo + , testName, testBuildInfo, buildable ) import Distribution.PackageDescription.Parse ( readPackageDescription ) import Distribution.PackageDescription.PrettyPrint ( writeGenericPackageDescription ) +import qualified Distribution.Simple as Simple +import qualified Distribution.Make as Make import Distribution.Simple.Build ( startInterpreter ) import Distribution.Simple.Command @@ -262,6 +265,8 @@ mainWorker args = topHandler $ upgradeCommand `commandAddAction` upgradeAction ,hiddenCommand $ win32SelfUpgradeCommand`commandAddAction` win32SelfUpgradeAction + ,hiddenCommand $ + actAsSetupCommand`commandAddAction` actAsSetupAction ] wrapperAction :: Monoid flags @@ -1155,3 +1160,17 @@ win32SelfUpgradeAction selfUpgradeFlags (pid:path:_extraArgs) _globalFlags = do let verbosity = fromFlag (win32SelfUpgradeVerbosity selfUpgradeFlags) Win32SelfUpgrade.deleteOldExeFile verbosity (read pid) path win32SelfUpgradeAction _ _ _ = return () + +-- | Used as an entry point when cabal-install needs to invoke itself +-- as a setup script. This can happen e.g. when doing parallel builds. +-- +actAsSetupAction :: ActAsSetupFlags -> [String] -> GlobalFlags -> IO () +actAsSetupAction actAsSetupFlags args _globalFlags = + let bt = fromFlag (actAsSetupBuildType actAsSetupFlags) + in case bt of + Simple -> Simple.defaultMainArgs args + Configure -> Simple.defaultMainWithHooksArgs + Simple.autoconfUserHooks args + Make -> Make.defaultMainArgs args + Custom -> error "actAsSetupAction Custom" + (UnknownBuildType _) -> error "actAsSetupAction UnknownBuildType"