direct ghc package-db flags

shayne-fletcher · Jul 22, 2024 · 3cb2142 · 3cb2142
1 parent e0b31d9
commit 3cb2142
Showing 1 changed file with 17 additions and 23 deletions.
diff --git a/ghc-lib-gen/src/Ghclibgen.hs b/ghc-lib-gen/src/Ghclibgen.hs
@@ -302,19 +302,13 @@ cygpath p = systemOutput_ $ "bash -c 'echo -n $(cygpath -u \"" ++ p ++ "\")'"
 
 cabalPackageDb :: String -> IO String
 cabalPackageDb ghcNumericVersion = do
-  cabalStoreDir <-
-    if not isWindows then
-      systemOutput_ "cabal path --store-dir"
-    else
-      cygpath . replace "\\" "\\\\" =<< systemOutput_ "cabal path --store-dir"
+  cabalStoreDir <- replace "\\" "\\\\" <$> systemOutput_ "cabal path --store-dir"
   ghcInfo <- getGhcInfo
   let ghcInfoMap = Map.fromList ghcInfo
   let ghcDir =
         case Map.lookup "Project Unit Id" ghcInfoMap of
           Just projectUnitId -> projectUnitId -- e.g. ghc-9.10.1-2e29
           Nothing -> "ghc-" ++ ghcNumericVersion
-  msg <- systemOutput_ $ "bash -c 'echo \"cabal store contents: \" && ls " ++ cabalStoreDir ++ "'"
-  putStrLn msg
   pure $ cabalStoreDir ++ "/" ++ ghcDir ++ "/package.db"
 
 ghcPackageDb :: String -> IO String
@@ -358,18 +352,12 @@ setupModuleDepsPlaceholders _ = do
               createDirectoryIfMissing True dir
               copyFile file new_p
 
-calcModuleDeps :: [FilePath] -> [FilePath] -> [FilePath] -> GhcFlavor -> String -> String -> String
-calcModuleDeps includeDirs _hsSrcDirs hsSrcIncludes ghcFlavor ghcPackagePath ghcMakeModeOutputFile =
-  let cmd = unwords $
-        [ "ghc", "-M"
-        , "-dep-suffix ''"
-        , "-dep-makefile " ++ ghcMakeModeOutputFile
-        ]  ++
-        [ "-optP -DGHCI" | series < GHC_8_10 ] ++
-        [ "-package semaphore-compat" | series >= GHC_9_8 ] ++
-        includeDirs ++ hsSrcIncludes ++ [ placeholderModulesDir </> "Main.hs" ]
-      cmd' = "bash -c \"" ++ ghcPackagePath ++ " " ++ cmd ++ "\""
-  in cmd'
+calcModuleDeps :: [FilePath] -> [FilePath] -> [FilePath] -> GhcFlavor -> FilePath -> FilePath -> String -> String
+calcModuleDeps includeDirs _hsSrcDirs hsSrcIncludes ghcFlavor _ghcPackageDb cabalPackageDb ghcMakeModeOutputFile = unwords $
+  [ "ghc -M -dep-suffix '' -dep-makefile " ++ ghcMakeModeOutputFile]  ++
+  [ "-clear-package-db -global-package-db -user-package-db -package-db " ++ cabalPackageDb ] ++ [ "-package semaphore-compat" | series >= GHC_9_8 ] ++
+  [ "-optP -DGHCI" | series < GHC_8_10 ] ++
+  includeDirs ++ hsSrcIncludes ++ [ placeholderModulesDir </> "Main.hs" ]
   where
     series = ghcSeries ghcFlavor
 
@@ -410,11 +398,14 @@ calcParserModules ghcFlavor = do
       mainFile = "../ghc-lib-gen/ghc-lib-parser" </> show series </> "Main.hs"
   copyFile mainFile rootModulePath
   lib <- mapM readCabalFile (cabalFileLibraries ghcFlavor)
-  ghcPackagePath <- ghcPackagePath'
+  ghcNumericVersion <- ghcNumericVersion
+  ghcPackageDb <- ghcPackageDb ghcNumericVersion
+  cabalPackageDb <- cabalPackageDb ghcNumericVersion
+  ghcPackagePath ghcPackageDb cabalPackageDb ghcNumericVersion
   let includeDirs = map ("-I" ++ ) (ghcLibParserIncludeDirs ghcFlavor)
       hsSrcDirs = placeholderModulesDir : ghcLibParserHsSrcDirs True ghcFlavor lib
       hsSrcIncludes = map ("-i" ++ ) hsSrcDirs
-      cmd' = calcModuleDeps includeDirs hsSrcDirs hsSrcIncludes ghcFlavor ghcPackagePath ".parser-depends"
+      cmd' = calcModuleDeps includeDirs hsSrcDirs hsSrcIncludes ghcFlavor ghcPackageDb cabalPackageDb ".parser-depends"
   putStrLn "# Generating 'ghc/.parser-depends'..."
   putStrLn $ "\n\n# Running: " ++ cmd'
   system_ cmd'
@@ -427,11 +418,14 @@ calcLibModules ghcFlavor = do
       mainFile = "../ghc-lib-gen/ghc-lib" </> show series </> "Main.hs"
   copyFile mainFile rootModulePath
   lib <- mapM readCabalFile (cabalFileLibraries ghcFlavor)
-  ghcPackagePath <- ghcPackagePath'
+  ghcNumericVersion <- ghcNumericVersion
+  ghcPackageDb <- ghcPackageDb ghcNumericVersion
+  cabalPackageDb <- cabalPackageDb ghcNumericVersion
+  ghcPackagePath ghcPackageDb cabalPackageDb ghcNumericVersion
   let includeDirs = map ("-I" ++ ) (ghcLibIncludeDirs ghcFlavor)
       hsSrcDirs = placeholderModulesDir : ghcLibHsSrcDirs True ghcFlavor lib
       hsSrcIncludes = map ("-i" ++ ) hsSrcDirs
-      cmd' = calcModuleDeps includeDirs hsSrcDirs hsSrcIncludes ghcFlavor ghcPackagePath ".lib-depends"
+      cmd' = calcModuleDeps includeDirs hsSrcDirs hsSrcIncludes ghcFlavor ghcPackageDb cabalPackageDb ".lib-depends"
   putStrLn "# Generating 'ghc/.lib-depends'..."
   putStrLn $ "\n\n# Running: " ++ cmd'
   system_ cmd'