trim down ConfigEnv datatype

mpickering · Sep 28, 2023 · 8a5c4d3 · 8a5c4d3
1 parent d18d354
commit 8a5c4d3
Show file tree

Hide file tree

Showing 4 changed files with 64 additions and 47 deletions.
diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs
@@ -831,34 +831,31 @@ autoconfSetupHooks :: SetupHooks
 autoconfSetupHooks = simpleSetupHooks { preConfComponent = Just $ pre_conf }
   where
     pre_conf
-      :: Args
-      -> SetupHooks.ConfigEnv
+      :: SetupHooks.ConfigEnv
       -> IO ( Set ComponentName, Component -> IO SetupHooks.ComponentDiff )
-    pre_conf _args
-      cfg_env@(SetupHooks.ConfigEnv { SetupHooks.configFlags, SetupHooks.cabalFilePath, SetupHooks.buildDir })
-      = do
-          let verbosity = fromFlag (configVerbosity configFlags)
-              baseDir =
-                fromMaybe
-                  ""
-                  (takeDirectory <$> cabalFilePath)
-          confExists <- doesFileExist $ baseDir </> "configure"
-          if confExists
-          then
-            runConfigureScript
-              verbosity
-              cfg_env
-          else dieWithException verbosity ConfigureScriptNotFound
-
-          hbi <- getHookedBuildInfo verbosity buildDir
-          let comp_set = SetupHooks.hookedBuildInfoComponents hbi
-          return
-            ( comp_set
-            , \ component -> do
-              let comp_name = componentName component
-              fromMaybe (return $ SetupHooks.emptyComponentDiff comp_name) $
-                SetupHooks.hookedBuildInfoComponentDiff_maybe hbi comp_name
-            )
+    pre_conf cfg_env = do
+      let verbosity = SetupHooks.configEnvVerbosity cfg_env
+          buildDir = SetupHooks.configEnvBuildDir cfg_env
+          baseDir = SetupHooks.configEnvBaseDir cfg_env
+      confExists <- doesFileExist $ baseDir </> "configure"
+      if confExists
+      then
+        runConfigureScript
+          verbosity
+          cfg_env
+      else dieWithException verbosity ConfigureScriptNotFound
+
+      -- Read the ".buildinfo" file and use that to update
+      -- the components (main library + executables only).
+      hbi <- getHookedBuildInfo verbosity buildDir
+      let comp_set = SetupHooks.hookedBuildInfoComponents hbi
+      return
+        ( comp_set
+        , \ component -> do
+          let comp_name = componentName component
+          fromMaybe (return $ SetupHooks.emptyComponentDiff comp_name) $
+            SetupHooks.hookedBuildInfoComponentDiff_maybe hbi comp_name
+        )
 
 -- | Basic autoconf 'UserHooks':
 --
@@ -871,6 +868,8 @@ autoconfSetupHooks = simpleSetupHooks { preConfComponent = Just $ pre_conf }
 -- Thus @configure@ can use local system information to generate
 -- /package/@.buildinfo@ and possibly other files.
 autoconfUserHooks :: UserHooks
+-- SetupHooks TODO: remove this and migrate the documentation
+-- to the replacement, autoconfSetupHooks.
 autoconfUserHooks =
   simpleUserHooks
     { postConf = defaultPostConf
@@ -900,10 +899,8 @@ autoconfUserHooks =
             -- SetupHooks TODO: move this convenience function out of here.
             configEnv :: SetupHooks.ConfigEnv
             configEnv = SetupHooks.ConfigEnv
-              { SetupHooks.buildDir = buildDir lbi
-              , SetupHooks.configFlags = flags
+              { SetupHooks.configFlags = flags
               , SetupHooks.hostPlatform = hostPlatform lbi
-              , SetupHooks.cabalFilePath = cabalFilePath lbi
               , SetupHooks.programDb = withPrograms lbi
               , SetupHooks.flagAssignment = flagAssignment lbi }
         confExists <- doesFileExist $ baseDir </> "configure"

diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs
@@ -622,14 +622,11 @@ configure_maybeSetupHooks mb_preConfComponentHook (pkg_descr0, pbi) cfg = do
         let
           configEnv :: SetupHooks.ConfigEnv
           configEnv = SetupHooks.ConfigEnv
-            { SetupHooks.buildDir = buildDir
-            , SetupHooks.configFlags = cfg
-            , SetupHooks.hostPlatform = compPlatform
-            , SetupHooks.cabalFilePath = flagToMaybe (configCabalFilePath cfg)
-            , SetupHooks.programDb = programDb''
+            { SetupHooks.configFlags    = cfg
+            , SetupHooks.hostPlatform   = compPlatform
+            , SetupHooks.programDb      = programDb''
             , SetupHooks.flagAssignment = flags }
-          args = configArgs cfg
-        (_comps_to_modify, comp_traversal) <- pre_conf_component args configEnv
+        (_comps_to_modify, comp_traversal) <- pre_conf_component configEnv
         -- SetupHooks TODO: sanity check that all the components
         -- the hook wants to modify actually exist.
         -- (This is done for compatibility with Configure build-type... might

diff --git a/Cabal/src/Distribution/Simple/ConfigureScript.hs b/Cabal/src/Distribution/Simple/ConfigureScript.hs
@@ -48,7 +48,7 @@ import System.FilePath    (normalise, splitDrive)
 import Distribution.Compat.Directory (makeAbsolute)
 import Distribution.Compat.Environment (getEnvironment)
 import Distribution.Compat.GetShortPathName (getShortPathName)
-import Distribution.Simple.SetupHooks ( ConfigEnv(..) )
+import Distribution.Simple.SetupHooks
 
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Map as Map
@@ -58,9 +58,10 @@ runConfigureScript
   -> ConfigEnv
   -> IO ()
 runConfigureScript verbosity
-  (ConfigEnv { configFlags = cfgFlags
-             , programDb, buildDir
-             , cabalFilePath, flagAssignment, hostPlatform }) = do
+  cfg_env@(ConfigEnv { configFlags = cfgFlags
+                     , programDb, flagAssignment, hostPlatform }) = do
+  let buildDir = configEnvBuildDir cfg_env
+      cabalFilePath = configEnvCabalFilePath cfg_env
   env <- getEnvironment
   (ccProg, ccFlags) <- configureCCompiler verbosity programDb
   ccProgShort <- getShortPathName ccProg

diff --git a/Cabal/src/Distribution/Simple/SetupHooks.hs b/Cabal/src/Distribution/Simple/SetupHooks.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
 module Distribution.Simple.SetupHooks
   ( -- * The setup hooks datatype
     SetupHooks(..), simpleSetupHooks
@@ -6,6 +8,8 @@ module Distribution.Simple.SetupHooks
   , PreConfPackageHook, PreConfComponentHook
     -- ** Per-package setup configure hook
   , ConfigEnv(..), applyPackagePreConfDiff
+  , configEnvBuildDir, configEnvCabalFilePath
+  , configEnvVerbosity, configEnvBaseDir
     -- ** Per-component setup configure hook
   , ComponentDiff(..), emptyComponentDiff
   , LibraryDiff, ForeignLibDiff, ExecutableDiff
@@ -21,7 +25,8 @@ where
 import Distribution.Compat.Prelude
 import Prelude ()
 
-import Distribution.Simple.Setup.Config ( ConfigFlags )
+import Distribution.Simple.Flag
+import Distribution.Simple.Setup.Config
 import Distribution.Simple.Errors
 import Distribution.Simple.Program.Db ( ProgramDb )
 import Distribution.Simple.Utils
@@ -40,13 +45,15 @@ import Distribution.PackageDescription
 import qualified Data.Set as Set
 import qualified Data.List.NonEmpty as NE
 
+import System.FilePath (takeDirectory, (</>))
+
 --------------------------------------------------------------------------------
 -- SetupHooks
 
 type Args2 = [String] -- SetupHooks TODO
 type PreConfPackageHook = Args2 -> IO LocalBuildConfig
-type PreConfComponentHook = Args2 -> ConfigEnv -> IO ( Set ComponentName
-                                                     , Component -> IO ComponentDiff)
+type PreConfComponentHook = ConfigEnv -> IO ( Set ComponentName
+                                            , Component -> IO ComponentDiff)
 
 data SetupHooks = SetupHooks
   { preConfPackage   :: Maybe PreConfPackageHook
@@ -70,17 +77,32 @@ simpleSetupHooks = SetupHooks
 
 --------------------------------------------------------------------------------
 -- Per-package configure hook.
-
 data ConfigEnv
   = ConfigEnv
   { configFlags    :: ConfigFlags
-  , buildDir       :: FilePath
   , programDb      :: ProgramDb
-  , cabalFilePath  :: Maybe FilePath
   , flagAssignment :: FlagAssignment
   , hostPlatform   :: Platform
   }
 
+configEnvBuildDir :: ConfigEnv -> FilePath
+configEnvBuildDir (ConfigEnv { configFlags = cfg })
+  = fromFlag (configDistPref cfg) </> "build"
+
+configEnvCabalFilePath :: ConfigEnv -> Maybe FilePath
+configEnvCabalFilePath (ConfigEnv { configFlags = cfg })
+  = flagToMaybe (configCabalFilePath cfg)
+
+configEnvVerbosity :: ConfigEnv -> Verbosity
+configEnvVerbosity (ConfigEnv { configFlags = cfg })
+  = fromFlag (configVerbosity cfg)
+
+configEnvBaseDir :: ConfigEnv -> FilePath
+configEnvBaseDir cfg_env =
+  fromMaybe
+    ""
+    (takeDirectory <$> configEnvCabalFilePath cfg_env)
+
 applyPackagePreConfDiff :: LocalBuildConfig -> LocalBuildInfo -> IO LocalBuildInfo
 applyPackagePreConfDiff cfg_diff lbi@(NewLocalBuildInfo { localBuildConfig = cfg0 })
   = return $ lbi { localBuildConfig = cfg0 <> cfg_diff }