Build extra sources as a standalone BuildM action

Refactors the duplicated `buildExtraSources` function from `gbuild` and `buildOrReplLib` into a standalone monadic computation in the context of building a component (namely, a 'BuildM' action). This refactor allows us to share the code for building an extra source amongst the two functions, and paves the way to fixing haskell#9389.
alt-romes · Jan 9, 2024 · 43eb6c0 · 43eb6c0
1 parent a36c4c0
commit 43eb6c0
Show file tree

Hide file tree

Showing 11 changed files with 320 additions and 270 deletions.
diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
@@ -88,6 +88,7 @@ library
     Distribution.Simple
     Distribution.Simple.Bench
     Distribution.Simple.Build
+    Distribution.Simple.Build.ExtraSources
     Distribution.Simple.Build.Macros
     Distribution.Simple.Build.Monad
     Distribution.Simple.Build.PackageInfoModule

diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs
@@ -163,7 +163,7 @@ build pkg_descr lbi flags suffixes = do
 
     mb_ipi <-
       buildComponent
-        verbosity
+        flags
         par_strat
         pkg_descr
         lbi'
@@ -303,7 +303,7 @@ repl pkg_descr lbi flags suffixes args = do
           lbi' = lbiForComponent comp lbi
       componentInitialBuildSteps distPref pkg_descr lbi clbi verbosity
       buildComponent
-        verbosity
+        mempty{buildVerbosity = toFlag verbosity}
         NoFlag
         pkg_descr
         lbi'
@@ -318,9 +318,8 @@ repl pkg_descr lbi flags suffixes args = do
   let clbi = targetCLBI target
       comp = targetComponent target
       lbi' = lbiForComponent comp lbi
-      replFlags = replReplOptions flags
   componentInitialBuildSteps distPref pkg_descr lbi clbi verbosity
-  replComponent replFlags verbosity pkg_descr lbi' suffixes comp clbi distPref
+  replComponent flags verbosity pkg_descr lbi' suffixes comp clbi distPref
 
 -- | Start an interpreter without loading any package files.
 startInterpreter
@@ -337,7 +336,7 @@ startInterpreter verbosity programDb comp platform packageDBs =
     _ -> dieWithException verbosity REPLNotSupported
 
 buildComponent
-  :: Verbosity
+  :: BuildFlags
   -> Flag ParStrat
   -> PackageDescription
   -> LocalBuildInfo
@@ -346,12 +345,12 @@ buildComponent
   -> ComponentLocalBuildInfo
   -> FilePath
   -> IO (Maybe InstalledPackageInfo)
-buildComponent verbosity _ _ _ _ (CTest TestSuite{testInterface = TestSuiteUnsupported tt}) _ _ =
-  dieWithException verbosity $ NoSupportBuildingTestSuite tt
-buildComponent verbosity _ _ _ _ (CBench Benchmark{benchmarkInterface = BenchmarkUnsupported tt}) _ _ =
-  dieWithException verbosity $ NoSupportBuildingBenchMark tt
+buildComponent flags _ _ _ _ (CTest TestSuite{testInterface = TestSuiteUnsupported tt}) _ _ =
+  dieWithException (fromFlag $ buildVerbosity flags) $ NoSupportBuildingTestSuite tt
+buildComponent flags _ _ _ _ (CBench Benchmark{benchmarkInterface = BenchmarkUnsupported tt}) _ _ =
+  dieWithException (fromFlag $ buildVerbosity flags) $ NoSupportBuildingBenchMark tt
 buildComponent
-  verbosity
+  flags
   numJobs
   pkg_descr
   lbi0
@@ -366,6 +365,7 @@ buildComponent
   -- built.
   distPref =
     do
+      let verbosity = fromFlag $ buildVerbosity flags
       pwd <- getCurrentDirectory
       let (pkg, lib, libClbi, lbi, ipi, exe, exeClbi) =
             testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd
@@ -380,7 +380,7 @@ buildComponent
         (maybeComponentInstantiatedWith clbi)
       let libbi = libBuildInfo lib
           lib' = lib{libBuildInfo = addSrcDir (addExtraOtherModules libbi generatedExtras) genDir}
-      buildLib verbosity numJobs pkg lbi lib' libClbi
+      buildLib flags numJobs pkg lbi lib' libClbi
       -- NB: need to enable multiple instances here, because on 7.10+
       -- the package name is the same as the library, and we still
       -- want the registration to go through.
@@ -401,7 +401,7 @@ buildComponent
       buildExe verbosity numJobs pkg_descr lbi exe' exeClbi
       return Nothing -- Can't depend on test suite
 buildComponent
-  verbosity
+  flags
   numJobs
   pkg_descr
   lbi
@@ -410,6 +410,7 @@ buildComponent
   clbi
   distPref =
     do
+      let verbosity = fromFlag $ buildVerbosity flags
       preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
       extras <- preprocessExtras verbosity comp lbi
       setupMessage'
@@ -432,7 +433,7 @@ buildComponent
                                 libbi
                   }
 
-          buildLib verbosity numJobs pkg_descr lbi lib' clbi
+          buildLib flags numJobs pkg_descr lbi lib' clbi
 
           let oneComponentRequested (OneComponentRequestedSpec _) = True
               oneComponentRequested _ = False
@@ -575,7 +576,7 @@ addSrcDir bi extra = bi{hsSourceDirs = new}
     new = ordNub (unsafeMakeSymbolicPath extra : hsSourceDirs bi)
 
 replComponent
-  :: ReplOptions
+  :: ReplFlags
   -> Verbosity
   -> PackageDescription
   -> LocalBuildInfo
@@ -606,7 +607,7 @@ replComponent
     extras <- preprocessExtras verbosity comp lbi
     let libbi = libBuildInfo lib
         lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ extras}}
-    replLib replFlags verbosity pkg lbi lib' libClbi
+    replLib replFlags pkg lbi lib' libClbi
 replComponent
   replFlags
   verbosity
@@ -617,29 +618,30 @@ replComponent
   clbi
   _ =
     do
+      let replOpts = replReplOptions replFlags
       preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
       extras <- preprocessExtras verbosity comp lbi
       case comp of
         CLib lib -> do
           let libbi = libBuildInfo lib
               lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ extras}}
-          replLib replFlags verbosity pkg_descr lbi lib' clbi
+          replLib replFlags pkg_descr lbi lib' clbi
         CFLib flib ->
-          replFLib replFlags verbosity pkg_descr lbi flib clbi
+          replFLib replOpts verbosity pkg_descr lbi flib clbi
         CExe exe -> do
           let ebi = buildInfo exe
               exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}
-          replExe replFlags verbosity pkg_descr lbi exe' clbi
+          replExe replOpts verbosity pkg_descr lbi exe' clbi
         CTest test@TestSuite{testInterface = TestSuiteExeV10{}} -> do
           let exe = testSuiteExeV10AsExe test
           let ebi = buildInfo exe
               exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}
-          replExe replFlags verbosity pkg_descr lbi exe' clbi
+          replExe replOpts verbosity pkg_descr lbi exe' clbi
         CBench bm@Benchmark{benchmarkInterface = BenchmarkExeV10{}} -> do
           let exe = benchmarkExeV10asExe bm
           let ebi = buildInfo exe
               exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}
-          replExe replFlags verbosity pkg_descr lbi exe' clbi
+          replExe replOpts verbosity pkg_descr lbi exe' clbi
 #if __GLASGOW_HASKELL__ < 811
 -- silence pattern-match warnings prior to GHC 9.0
         _ -> error "impossible"
@@ -824,16 +826,17 @@ addInternalBuildTools pkg lbi bi progs =
 -- TODO: build separate libs in separate dirs so that we can build
 -- multiple libs, e.g. for 'LibTest' library-style test suites
 buildLib
-  :: Verbosity
+  :: BuildFlags
   -> Flag ParStrat
   -> PackageDescription
   -> LocalBuildInfo
   -> Library
   -> ComponentLocalBuildInfo
   -> IO ()
-buildLib verbosity numJobs pkg_descr lbi lib clbi =
+buildLib flags numJobs pkg_descr lbi lib clbi =
+  let verbosity = fromFlag $ buildVerbosity flags in
   case compilerFlavor (compiler lbi) of
-    GHC -> GHC.buildLib verbosity numJobs pkg_descr lbi lib clbi
+    GHC -> GHC.buildLib flags numJobs pkg_descr lbi lib clbi
     GHCJS -> GHCJS.buildLib verbosity numJobs pkg_descr lbi lib clbi
     UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi
     HaskellSuite{} -> HaskellSuite.buildLib verbosity pkg_descr lbi lib clbi
@@ -872,19 +875,20 @@ buildExe verbosity numJobs pkg_descr lbi exe clbi =
     _ -> dieWithException verbosity BuildingNotSupportedWithCompiler
 
 replLib
-  :: ReplOptions
-  -> Verbosity
+  :: ReplFlags
   -> PackageDescription
   -> LocalBuildInfo
   -> Library
   -> ComponentLocalBuildInfo
   -> IO ()
-replLib replFlags verbosity pkg_descr lbi lib clbi =
-  case compilerFlavor (compiler lbi) of
+replLib replFlags pkg_descr lbi lib clbi =
+  let verbosity = fromFlag $ replVerbosity replFlags
+      opts = replReplOptions replFlags
+   in case compilerFlavor (compiler lbi) of
     -- 'cabal repl' doesn't need to support 'ghc --make -j', so we just pass
     -- NoFlag as the numJobs parameter.
-    GHC -> GHC.replLib replFlags verbosity NoFlag pkg_descr lbi lib clbi
-    GHCJS -> GHCJS.replLib (replOptionsFlags replFlags) verbosity NoFlag pkg_descr lbi lib clbi
+    GHC -> GHC.replLib replFlags NoFlag pkg_descr lbi lib clbi
+    GHCJS -> GHCJS.replLib (replOptionsFlags opts) verbosity NoFlag pkg_descr lbi lib clbi
     _ -> dieWithException verbosity REPLNotSupported
 
 replExe