From 2d07efe3580a9fe8f1191d26056307d47205462c Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
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 85eabcbe93..1423ed8f99 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 3661c683ce..cf2a18297e 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 8513f92c7b..67f97a7f88 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 c1975e8309..46a653b8bf 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 4040c26bce..b214cabfc2 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 0000000000..17a60b88e9
--- /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).
+}
--
GitLab