Remove last uses of runDbProgram

runDbProgram doesn't take into account the working directory (so will normally produce incorrect results when used in `Cabal`). This replaces the last uses which weren't found by testing, they were found by grepping.
haskell · Aug 21, 2024 · 2e70095 · 2e70095
1 parent 096529a
commit 2e70095
Show file tree

Hide file tree

Showing 4 changed files with 25 additions and 22 deletions.
diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs
@@ -1850,7 +1850,7 @@ installExe
         exeFileName = exeName'
         fixedExeBaseName = progprefix ++ exeName' ++ progsuffix
         installBinary dest = do
-          runDbProgram verbosity ghcjsProgram (withPrograms lbi) $
+          runDbProgramCwd verbosity (mbWorkDirLBI lbi) ghcjsProgram (withPrograms lbi) $
             [ "--install-executable"
             , buildPref </> exeName' </> exeFileName
             , "-o"

diff --git a/Cabal/src/Distribution/Simple/HaskellSuite.hs b/Cabal/src/Distribution/Simple/HaskellSuite.hs
@@ -181,23 +181,23 @@ buildLib verbosity pkg_descr lbi lib clbi = do
 
   let odir = buildDir lbi
       bi = libBuildInfo lib
-      srcDirs = map i (hsSourceDirs bi) ++ [i odir]
+      srcDirs = map u (hsSourceDirs bi) ++ [u odir]
       dbStack = withPackageDB lbi
       language = fromMaybe Haskell98 (defaultLanguage bi)
       progdb = withPrograms lbi
       pkgid = packageId pkg_descr
-      i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
-  runDbProgram verbosity haskellSuiteProgram progdb $
-    ["compile", "--build-dir", i odir]
+      u = interpretSymbolicPathCWD -- See Note [Symbolic paths] in Distribution.Utils.Path
+  runDbProgramCwd verbosity (mbWorkDirLBI lbi) haskellSuiteProgram progdb $
+    ["compile", "--build-dir", u odir]
       ++ concat [["-i", d] | d <- srcDirs]
       ++ concat
         [ ["-I", d]
         | d <-
-            [ i $ autogenComponentModulesDir lbi clbi
-            , i $ autogenPackageModulesDir lbi
-            , i odir
+            [ u $ autogenComponentModulesDir lbi clbi
+            , u $ autogenPackageModulesDir lbi
+            , u odir
             ]
-              ++ map i (includeDirs bi)
+              ++ map u (includeDirs bi)
         ]
       ++ [packageDbOpt pkgDb | pkgDb <- dbStack]
       ++ ["--package-name", prettyShow pkgid]
@@ -225,7 +225,8 @@ installLib
   -> IO ()
 installLib verbosity lbi targetDir dynlibTargetDir builtDir pkg lib clbi = do
   let progdb = withPrograms lbi
-  runDbProgram verbosity haskellSuitePkgProgram progdb $
+      wdir   = mbWorkDirLBI lbi
+  runDbProgramCwd verbosity wdir haskellSuitePkgProgram progdb $
     [ "install-library"
     , "--build-dir"
     , builtDir

diff --git a/Cabal/src/Distribution/Simple/PreProcess.hs b/Cabal/src/Distribution/Simple/PreProcess.hs
@@ -390,8 +390,9 @@ ppGreenCard _ lbi _ =
     { platformIndependent = False
     , ppOrdering = unsorted
     , runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
-        runDbProgram
+        runDbProgramCwd
           verbosity
+          (mbWorkDirLBI lbi)
           greencardProgram
           (withPrograms lbi)
           (["-tffi", "-o" ++ outFile, inFile])
@@ -863,8 +864,9 @@ standardPP lbi prog args =
     { platformIndependent = False
     , ppOrdering = unsorted
     , runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
-        runDbProgram
+        runDbProgramCwd
           verbosity
+          (mbWorkDirLBI lbi)
           prog
           (withPrograms lbi)
           (args ++ ["-o", outFile, inFile])

diff --git a/Cabal/src/Distribution/Simple/UHC.hs b/Cabal/src/Distribution/Simple/UHC.hs
@@ -251,8 +251,8 @@ buildExe verbosity _pkg_descr lbi exe clbi = do
   userPkgDir <- getUserPackageDir
   let mbWorkDir = mbWorkDirLBI lbi
   srcMainPath <- findFileCwd verbosity mbWorkDir (hsSourceDirs $ buildInfo exe) (modulePath exe)
-  let runUhcProg = runDbProgram verbosity uhcProgram (withPrograms lbi)
-      i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
+  let runUhcProg = runDbProgramCwd verbosity (mbWorkDirLBI lbi) uhcProgram (withPrograms lbi)
+      u = interpretSymbolicPathCWD
       uhcArgs =
         -- common flags lib/exe
         constructUHCCmdLine
@@ -264,9 +264,9 @@ buildExe verbosity _pkg_descr lbi exe clbi = do
           (buildDir lbi)
           verbosity
           -- output file
-          ++ ["--output", i $ buildDir lbi </> makeRelativePathEx (prettyShow (exeName exe))]
+          ++ ["--output", u $ buildDir lbi </> makeRelativePathEx (prettyShow (exeName exe))]
           -- main source module
-          ++ [i $ srcMainPath]
+          ++ [u $ srcMainPath]
   runUhcProg uhcArgs
 
 constructUHCCmdLine
@@ -297,22 +297,22 @@ constructUHCCmdLine user system lbi bi clbi odir verbosity =
     ++ ["--package=uhcbase"]
     ++ ["--package=" ++ prettyShow (mungedName pkgid) | (_, pkgid) <- componentPackageDeps clbi]
     -- search paths
-    ++ ["-i" ++ i odir]
-    ++ ["-i" ++ i l | l <- nub (hsSourceDirs bi)]
-    ++ ["-i" ++ i (autogenComponentModulesDir lbi clbi)]
-    ++ ["-i" ++ i (autogenPackageModulesDir lbi)]
+    ++ ["-i" ++ u odir]
+    ++ ["-i" ++ u l | l <- nub (hsSourceDirs bi)]
+    ++ ["-i" ++ u (autogenComponentModulesDir lbi clbi)]
+    ++ ["-i" ++ u (autogenPackageModulesDir lbi)]
     -- cpp options
     ++ ["--optP=" ++ opt | opt <- cppOptions bi]
     -- output path
-    ++ ["--odir=" ++ i odir]
+    ++ ["--odir=" ++ u odir]
     -- optimization
     ++ ( case withOptimization lbi of
           NoOptimisation -> ["-O0"]
           NormalOptimisation -> ["-O1"]
           MaximumOptimisation -> ["-O2"]
        )
   where
-    i = interpretSymbolicPathCWD -- See Note [Symbolic paths] in Distribution.Utils.Path
+    u = interpretSymbolicPathCWD -- See Note [Symbolic paths] in Distribution.Utils.Path
 
 uhcPackageDbOptions :: FilePath -> FilePath -> PackageDBStack -> [String]
 uhcPackageDbOptions user system db =