From 2d07efe3580a9fe8f1191d26056307d47205462c Mon Sep 17 00:00:00 2001 From: sheaf Date: Fri, 3 May 2024 15:07:31 +0200 Subject: [PATCH] Use SetupHooks for Configure build-type This commit implements the Configure build-type in terms of Hooks, when build-type: Hooks is available (for Cabal >= 3.13). This moves Configure away from an implementation in terms of UserHooks, i.e. away from the Custom build-type. --- Cabal/src/Distribution/Simple.hs | 76 ++++++++++++++++--- .../Distribution/Simple/ConfigureScript.hs | 49 +++++++----- Cabal/src/Distribution/Simple/Errors.hs | 4 +- cabal-install/src/Distribution/Client/Main.hs | 4 +- .../src/Distribution/Client/SetupWrapper.hs | 18 +++-- changelog.d/pr-9969 | 18 +++++ 6 files changed, 132 insertions(+), 37 deletions(-) create mode 100644 changelog.d/pr-9969 diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs index 85eabcbe93c..1423ed8f992 100644 --- a/Cabal/src/Distribution/Simple.hs +++ b/Cabal/src/Distribution/Simple.hs @@ -67,6 +67,7 @@ module Distribution.Simple -- ** Standard sets of hooks , simpleUserHooks , autoconfUserHooks + , autoconfSetupHooks , emptyUserHooks ) where @@ -110,6 +111,7 @@ import Distribution.Simple.SetupHooks.Internal ) import Distribution.Simple.Test import Distribution.Simple.Utils +import qualified Distribution.Types.LocalBuildConfig as LBC import Distribution.Utils.Path import Distribution.Verbosity import Distribution.Version @@ -935,16 +937,11 @@ autoconfUserHooks = let common = configCommonFlags flags verbosity = fromFlag $ setupVerbosity common mbWorkDir = flagToMaybe $ setupWorkingDir common - baseDir = packageRoot common - confExists <- doesFileExist $ baseDir "configure" - if confExists - then - runConfigureScript - verbosity - flags - lbi - else dieWithException verbosity ConfigureScriptNotFound - + runConfigureScript + flags + (flagAssignment lbi) + (withPrograms lbi) + (hostPlatform lbi) pbi <- getHookedBuildInfo verbosity mbWorkDir (buildDir lbi) sanityCheckHookedBuildInfo verbosity pkg_descr pbi let pkg_descr' = updatePackageDescription pbi pkg_descr @@ -991,6 +988,65 @@ getHookedBuildInfo verbosity mbWorkDir build_dir = do info verbosity $ "Reading parameters from " ++ getSymbolicPath infoFile readHookedBuildInfo verbosity mbWorkDir infoFile +autoconfSetupHooks :: SetupHooks +autoconfSetupHooks = + SetupHooks.noSetupHooks + { SetupHooks.configureHooks = + SetupHooks.noConfigureHooks + { SetupHooks.postConfPackageHook = Just post_conf_pkg + , SetupHooks.preConfComponentHook = Just pre_conf_comp + } + } + where + post_conf_pkg + :: SetupHooks.PostConfPackageInputs + -> IO () + post_conf_pkg + ( SetupHooks.PostConfPackageInputs + { SetupHooks.localBuildConfig = + LBC.LocalBuildConfig{LBC.withPrograms = progs} + , SetupHooks.packageBuildDescr = + LBC.PackageBuildDescr + { LBC.configFlags = cfg + , LBC.flagAssignment = flags + , LBC.hostPlatform = plat + } + } + ) = runConfigureScript cfg flags progs plat + + pre_conf_comp + :: SetupHooks.PreConfComponentInputs + -> IO SetupHooks.PreConfComponentOutputs + pre_conf_comp + ( SetupHooks.PreConfComponentInputs + { SetupHooks.packageBuildDescr = + LBC.PackageBuildDescr + { LBC.configFlags = cfg + , localPkgDescr = pkg_descr + } + , SetupHooks.component = component + } + ) = do + let verbosity = fromFlag $ configVerbosity cfg + mbWorkDir = flagToMaybe $ configWorkingDir cfg + distPref = configDistPref cfg + dist_dir <- findDistPrefOrDefault distPref + -- Read the ".buildinfo" file and use that to update + -- the components (main library + executables only). + hbi <- getHookedBuildInfo verbosity mbWorkDir (dist_dir makeRelativePathEx "build") + sanityCheckHookedBuildInfo verbosity pkg_descr hbi + -- SetupHooks TODO: we are reading getHookedBuildInfo once + -- for each component. I think this is inherent to the SetupHooks + -- approach. + let comp_name = componentName component + diff <- case SetupHooks.hookedBuildInfoComponentDiff_maybe hbi comp_name of + Nothing -> return $ SetupHooks.emptyComponentDiff comp_name + Just do_diff -> do_diff + return $ + SetupHooks.PreConfComponentOutputs + { SetupHooks.componentDiff = diff + } + defaultTestHook :: Args -> PackageDescription diff --git a/Cabal/src/Distribution/Simple/ConfigureScript.hs b/Cabal/src/Distribution/Simple/ConfigureScript.hs index 3661c683ceb..cf2a18297ee 100644 --- a/Cabal/src/Distribution/Simple/ConfigureScript.hs +++ b/Cabal/src/Distribution/Simple/ConfigureScript.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} @@ -23,6 +24,7 @@ import Prelude () -- local import Distribution.PackageDescription import Distribution.Pretty +import Distribution.Simple.Configure (findDistPrefOrDefault) import Distribution.Simple.Errors import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program @@ -30,12 +32,12 @@ import Distribution.Simple.Program.Db import Distribution.Simple.Setup.Common import Distribution.Simple.Setup.Config import Distribution.Simple.Utils -import Distribution.System (buildPlatform) +import Distribution.System (Platform, buildPlatform) import Distribution.Utils.NubList import Distribution.Utils.Path -import Distribution.Verbosity -- Base +import System.Directory (createDirectoryIfMissing, doesFileExist) import qualified System.FilePath as FilePath #ifdef mingw32_HOST_OS import System.FilePath (normalise, splitDrive) @@ -48,14 +50,25 @@ import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map as Map runConfigureScript - :: Verbosity - -> ConfigFlags - -> LocalBuildInfo + :: ConfigFlags + -> FlagAssignment + -> ProgramDb + -> Platform + -- ^ host platform -> IO () -runConfigureScript verbosity flags lbi = do +runConfigureScript cfg flags programDb hp = do + let commonCfg = configCommonFlags cfg + verbosity = fromFlag $ setupVerbosity commonCfg + dist_dir <- findDistPrefOrDefault $ setupDistPref commonCfg + let build_dir = dist_dir makeRelativePathEx "build" + mbWorkDir = flagToMaybe $ setupWorkingDir commonCfg + configureScriptPath = packageRoot commonCfg "configure" + confExists <- doesFileExist configureScriptPath + unless confExists $ + dieWithException verbosity (ConfigureScriptNotFound configureScriptPath) + configureFile <- + makeAbsolute $ configureScriptPath env <- getEnvironment - let commonFlags = configCommonFlags flags - programDb = withPrograms lbi (ccProg, ccFlags) <- configureCCompiler verbosity programDb ccProgShort <- getShortPathName ccProg -- The C compiler's compilation and linker flags (e.g. @@ -64,8 +77,8 @@ runConfigureScript verbosity flags lbi = do -- to ccFlags -- We don't try and tell configure which ld to use, as we don't have -- a way to pass its flags too - configureFile <- - makeAbsolute $ packageRoot commonFlags "configure" + + let configureFile' = toUnix configureFile -- autoconf is fussy about filenames, and has a set of forbidden -- characters that can't appear in the build directory, etc: -- https://www.gnu.org/software/autoconf/manual/autoconf.html#File-System-Conventions @@ -79,7 +92,6 @@ runConfigureScript verbosity flags lbi = do -- TODO: We don't check for colons, tildes or leading dashes. We -- also should check the builddir's path, destdir, and all other -- paths as well. - let configureFile' = toUnix configureFile for_ badAutoconfCharacters $ \(c, cname) -> when (c `elem` FilePath.dropDrive configureFile') $ warn verbosity $ @@ -111,7 +123,7 @@ runConfigureScript verbosity flags lbi = do Map.fromListWith (<>) [ (flagEnvVar flag, (flag, bool) :| []) - | (flag, bool) <- unFlagAssignment $ flagAssignment lbi + | (flag, bool) <- unFlagAssignment flags ] -- A map from env vars to flag names to the single flag we will go with cabalFlagMapDeconflicted :: Map String (FlagName, Bool) <- @@ -143,10 +155,10 @@ runConfigureScript verbosity flags lbi = do ] ++ [ ( "CABAL_FLAGS" - , Just $ unwords [showFlagValue fv | fv <- unFlagAssignment $ flagAssignment lbi] + , Just $ unwords [showFlagValue fv | fv <- unFlagAssignment flags] ) ] - let extraPath = fromNubList $ configProgramPathExtra flags + let extraPath = fromNubList $ configProgramPathExtra cfg let cflagsEnv = maybe (unwords ccFlags) (++ (" " ++ unwords ccFlags)) $ lookup "CFLAGS" env @@ -160,7 +172,6 @@ runConfigureScript verbosity flags lbi = do ("CFLAGS", Just cflagsEnv) : [("PATH", Just pathEnv) | not (null extraPath)] ++ cabalFlagEnv - hp = hostPlatform lbi maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)] args' = configureFile' : args ++ ["CC=" ++ ccProgShort] ++ maybeHostFlag shProg = simpleProgram "sh" @@ -169,14 +180,16 @@ runConfigureScript verbosity flags lbi = do lookupProgram shProg `fmap` configureProgram verbosity shProg progDb case shConfiguredProg of - Just sh -> + Just sh -> do + let build_in = interpretSymbolicPath mbWorkDir build_dir + createDirectoryIfMissing True build_in runProgramInvocation verbosity $ (programInvocation (sh{programOverrideEnv = overEnv}) args') - { progInvokeCwd = Just (interpretSymbolicPathLBI lbi $ buildDir lbi) + { progInvokeCwd = Just build_in } Nothing -> dieWithException verbosity NotFoundMsg where - args = configureArgs backwardsCompatHack flags + args = configureArgs backwardsCompatHack cfg backwardsCompatHack = False -- | Convert Windows path to Unix ones diff --git a/Cabal/src/Distribution/Simple/Errors.hs b/Cabal/src/Distribution/Simple/Errors.hs index 8513f92c7b9..67f97a7f889 100644 --- a/Cabal/src/Distribution/Simple/Errors.hs +++ b/Cabal/src/Distribution/Simple/Errors.hs @@ -115,7 +115,7 @@ data CabalException | CheckSemaphoreSupport | NoLibraryForPackage | SanityCheckHookedBuildInfo UnqualComponentName - | ConfigureScriptNotFound + | ConfigureScriptNotFound FilePath | NoValidComponent | ConfigureEitherSingleOrAll | ConfigCIDValidForPreComponent @@ -513,7 +513,7 @@ exceptionMessage e = case e of ++ prettyShow exe1 ++ "' but the package does not have a " ++ "executable with that name." - ConfigureScriptNotFound -> "configure script not found." + ConfigureScriptNotFound fp -> "configure script not found at " ++ fp ++ "." NoValidComponent -> "No valid component targets found" ConfigureEitherSingleOrAll -> "Can only configure either single component or all of them" ConfigCIDValidForPreComponent -> "--cid is only supported for per-component configure" diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index c1975e83094..46a653b8bf7 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -1470,8 +1470,8 @@ actAsSetupAction actAsSetupFlags args _globalFlags = in case bt of Simple -> Simple.defaultMainArgs args Configure -> - Simple.defaultMainWithHooksArgs - Simple.autoconfUserHooks + Simple.defaultMainWithSetupHooksArgs + Simple.autoconfSetupHooks args Make -> Make.defaultMainArgs args Hooks -> error "actAsSetupAction Hooks" diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs index 4040c26bcea..b214cabfc23 100644 --- a/cabal-install/src/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs @@ -557,8 +557,8 @@ internalSetupMethod verbosity options bt args = do buildTypeAction :: BuildType -> ([String] -> IO ()) buildTypeAction Simple = Simple.defaultMainArgs buildTypeAction Configure = - Simple.defaultMainWithHooksArgs - Simple.autoconfUserHooks + Simple.defaultMainWithSetupHooksArgs + Simple.autoconfSetupHooks buildTypeAction Make = Make.defaultMainArgs buildTypeAction Hooks = error "buildTypeAction Hooks" buildTypeAction Custom = error "buildTypeAction Custom" @@ -862,10 +862,18 @@ getExternalSetupMethod verbosity options pkg bt = do buildTypeScript cabalLibVersion = "{-# LANGUAGE NoImplicitPrelude #-}\n" <> case bt of Simple -> "import Distribution.Simple; main = defaultMain\n" Configure - | cabalLibVersion >= mkVersion [1, 3, 10] -> "import Distribution.Simple; main = defaultMainWithHooks autoconfUserHooks\n" - | otherwise -> "import Distribution.Simple; main = defaultMainWithHooks defaultUserHooks\n" + | cabalLibVersion >= mkVersion [3, 13, 0] + -> "import Distribution.Simple; main = defaultMainWithSetupHooks autoconfSetupHooks\n" + | cabalLibVersion >= mkVersion [1, 3, 10] + -> "import Distribution.Simple; main = defaultMainWithHooks autoconfUserHooks\n" + | otherwise + -> "import Distribution.Simple; main = defaultMainWithHooks defaultUserHooks\n" Make -> "import Distribution.Make; main = defaultMain\n" - Hooks -> "import Distribution.Simple; import SetupHooks; main = defaultMainWithSetupHooks setupHooks\n" + Hooks + | cabalLibVersion >= mkVersion [3, 13, 0] + -> "import Distribution.Simple; import SetupHooks; main = defaultMainWithSetupHooks setupHooks\n" + | otherwise + -> error "buildTypeScript Hooks with Cabal < 3.13" Custom -> error "buildTypeScript Custom" installedCabalVersion diff --git a/changelog.d/pr-9969 b/changelog.d/pr-9969 new file mode 100644 index 00000000000..17a60b88e99 --- /dev/null +++ b/changelog.d/pr-9969 @@ -0,0 +1,18 @@ +synopsis: Configure build-type in terms of Hooks +packages: Cabal cabal-install +prs: #9969 + +description: { + +The `build-type: Configure` is now implemented in terms of `build-type: Hooks` +rather than in terms of `build-type: Custom`. This moves the `Configure` +build-type away from the `Custom` issues. Eventually, `build-type: Hooks` will +no longer imply packages are built in legacy-fallback mode. Now, when that +happens, `Configure` will also stop implying `legacy-fallback`. + +The observable aspect of this change is `runConfigureScript` now having a +different type, and `autoconfSetupHooks` being exposed `Distribution.Simple`. +The former is motivated by internal implementation details, while the latter +provides the `SetupHooks` value for the `Configure` build type, which can be +consumed by other `Hooks` clients (e.g. eventually HLS). +}