Add separate cache for getPkgConfigDb

Querying pkg-config for the version of every module can be a very expensive operation on some systems. This change adds a separate, per-project, cache for PkgConfigDB; reducing the cost from "every plan change" to "every pkg-config-db change per project". The cache key is composed by the pkg-config configured program and the list of directories reported by pkg-config's pc_path variable.
haskell · Jan 24, 2024 · bff5359 · bff5359
1 parent ae3c40a
commit bff5359
Show file tree

Hide file tree

Showing 9 changed files with 120 additions and 15 deletions.
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs
@@ -50,6 +50,7 @@ module Distribution.Client.ProjectConfig
   , resolveSolverSettings
   , BuildTimeSettings (..)
   , resolveBuildTimeSettings
+  , resolveProgramDb
 
     -- * Checking configuration
   , checkBadPerPackageCompilerPaths
@@ -154,6 +155,13 @@ import Distribution.Simple.InstallDirs
   )
 import Distribution.Simple.Program
   ( ConfiguredProgram (..)
+  , ProgramSearchPathEntry (..)
+  )
+import Distribution.Simple.Program.Db
+  ( ProgramDb
+  , defaultProgramDb
+  , modifyProgramSearchPath
+  , userSpecifyPaths
   )
 import Distribution.Simple.Setup
   ( Flag (Flag)
@@ -496,6 +504,18 @@ resolveBuildTimeSettings
         | isParallelBuild buildSettingNumJobs = False
         | otherwise = False
 
+-- | ProgramDb with directly user specified paths
+resolveProgramDb :: ProjectConfig -> ProgramDb
+resolveProgramDb ProjectConfig{projectConfigLocalPackages = PackageConfig{..}} =
+  userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths))
+    . modifyProgramSearchPath
+      ( [ ProgramSearchPathDir dir
+        | dir <- fromNubList packageConfigProgramPathExtra
+        ]
+          ++
+      )
+    $ defaultProgramDb
+
 ---------------------------------------------
 -- Reading and writing project config files
 --

diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -541,6 +541,9 @@ rebuildInstallPlan
       progsearchpath <- liftIO $ getSystemSearchPath
       let projectConfigMonitored = projectConfig{projectConfigBuildOnly = mempty}
 
+      let progdb = resolveProgramDb projectConfig
+      pkgConfigDB <- getPkgConfigDb verbosity distDirLayout progdb
+
       -- The overall improved plan is cached
       rerunIfChanged
         verbosity
@@ -561,15 +564,15 @@ rebuildInstallPlan
               $ do
                 compilerEtc <- phaseConfigureCompiler projectConfig
                 _ <- phaseConfigurePrograms projectConfig compilerEtc
-                (solverPlan, pkgConfigDB, totalIndexState, activeRepos) <-
+                (solverPlan, totalIndexState, activeRepos) <-
                   phaseRunSolver
                     projectConfig
                     compilerEtc
+                    pkgConfigDB
                     localPackages
                     (fromMaybe mempty mbInstalledPackages)
-                ( elaboratedPlan
-                  , elaboratedShared
-                  ) <-
+
+                (elaboratedPlan, elaboratedShared) <-
                   phaseElaboratePlan
                     projectConfig
                     compilerEtc
@@ -603,7 +606,8 @@ rebuildInstallPlan
       phaseConfigureCompiler
         :: ProjectConfig
         -> Rebuild (Compiler, Platform, ProgramDb)
-      phaseConfigureCompiler = configureCompiler verbosity distDirLayout
+      phaseConfigureCompiler projectConfig =
+        configureCompiler verbosity distDirLayout projectConfig
 
       -- Configuring other programs.
       --
@@ -643,15 +647,17 @@ rebuildInstallPlan
       phaseRunSolver
         :: ProjectConfig
         -> (Compiler, Platform, ProgramDb)
+        -> PkgConfigDb
         -> [PackageSpecifier UnresolvedSourcePackage]
         -> InstalledPackageIndex
-        -> Rebuild (SolverInstallPlan, PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)
+        -> Rebuild (SolverInstallPlan, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)
       phaseRunSolver
         projectConfig@ProjectConfig
           { projectConfigShared
           , projectConfigBuildOnly
           }
         (compiler, platform, progdb)
+        pkgConfigDB
         localPackages
         installedPackages =
           rerunIfChanged
@@ -678,7 +684,6 @@ rebuildInstallPlan
                   withRepoCtx
                   (solverSettingIndexState solverSettings)
                   (solverSettingActiveRepos solverSettings)
-              pkgConfigDB <- getPkgConfigDb verbosity progdb
 
               -- TODO: [code cleanup] it'd be better if the Compiler contained the
               -- ConfiguredPrograms that it needs, rather than relying on the progdb
@@ -703,7 +708,7 @@ rebuildInstallPlan
                   Left msg -> do
                     reportPlanningFailure projectConfig compiler platform localPackages
                     dieWithException verbosity $ PhaseRunSolverErr msg
-                  Right plan -> return (plan, pkgConfigDB, tis, ar)
+                  Right plan -> return (plan, tis, ar)
           where
             corePackageDbs :: [PackageDB]
             corePackageDbs =
@@ -992,13 +997,23 @@ getSourcePackages verbosity withRepoCtx idxState activeRepos = do
     $ repos
   return sourcePkgDbWithTIS
 
-getPkgConfigDb :: Verbosity -> ProgramDb -> Rebuild PkgConfigDb
-getPkgConfigDb verbosity progdb = do
-  dirs <- liftIO $ getPkgConfigDbDirs verbosity progdb
-  -- Just monitor the dirs so we'll notice new .pc files.
-  -- Alternatively we could monitor all the .pc files too.
-  traverse_ monitorDirectoryStatus dirs
-  liftIO $ readPkgConfigDb verbosity progdb
+getPkgConfigDb :: Verbosity -> DistDirLayout -> ProgramDb -> Rebuild PkgConfigDb
+getPkgConfigDb verbosity distDirLayout progdb = do
+  mpkgConfig <- liftIO $ needProgram verbosity pkgConfigProgram progdb
+  case mpkgConfig of
+    Nothing -> do
+      liftIO $ info verbosity "Cannot find pkg-config program. Cabal will continue without solving for pkg-config constraints."
+      return NoPkgConfigDb
+    Just (pkgConfig, progdb') -> do
+      dirs <- liftIO $ getPkgConfigDbDirs verbosity progdb'
+      rerunIfChanged verbosity fileMonitorPkgConfigDb (pkgConfig, dirs) $ do
+        -- By monitoring the dirs, we'll notice new .pc files. We do not monitor the .pc files.
+        traverse_ monitorDirectoryStatus dirs
+        liftIO $ do
+          info verbosity "Querying pkg-config database..."
+          readPkgConfigDb verbosity progdb'
+  where
+    fileMonitorPkgConfigDb = newFileMonitor $ distProjectCacheFile distDirLayout "pkg-config-db"
 
 -- | Select the config values to monitor for changes package source hashes.
 packageLocationsSignature

diff --git a/cabal-testsuite/PackageTests/MonitorPkgConfig/P.hs b/cabal-testsuite/PackageTests/MonitorPkgConfig/P.hs
@@ -0,0 +1 @@
+module P where
diff --git a/cabal-testsuite/PackageTests/MonitorPkgConfig/cabal.out b/cabal-testsuite/PackageTests/MonitorPkgConfig/cabal.out
@@ -0,0 +1,6 @@
+# cabal v2-build
+# cabal v2-build
+# cabal v2-build
+# cabal v2-build
+# cabal v2-build
+# cabal v2-build
diff --git a/cabal-testsuite/PackageTests/MonitorPkgConfig/cabal.project b/cabal-testsuite/PackageTests/MonitorPkgConfig/cabal.project
@@ -0,0 +1 @@
+packages: .
diff --git a/cabal-testsuite/PackageTests/MonitorPkgConfig/cabal.test.hs b/cabal-testsuite/PackageTests/MonitorPkgConfig/cabal.test.hs
@@ -0,0 +1,35 @@
+import Distribution.Compat.Environment (setEnv)
+import System.Directory (copyFile, createDirectoryIfMissing, removeDirectoryRecursive)
+import Test.Cabal.Prelude
+
+main = cabalTest $ do
+  env <- getTestEnv
+
+  cabal' "v2-build" ["--dry-run", "p", "-v2"]
+    >>= assertOutputContains "Querying pkg-config database..."
+
+  cabal' "v2-build" ["--dry-run", "p", "-v2"]
+    >>= assertOutputDoesNotContain "Querying pkg-config database..."
+
+  -- Check that changing PKG_CONFIG_PATH invalidates the cache
+
+  let pkgConfigPath = testWorkDir env </> "pkgconfig"
+  liftIO $ do
+    createDirectoryIfMissing True pkgConfigPath
+    setEnv "PKG_CONFIG_PATH" pkgConfigPath
+
+  cabal' "v2-build" ["--dry-run", "p", "-v2"]
+    >>= assertOutputContains "Querying pkg-config database..."
+
+  cabal' "v2-build" ["--dry-run", "p", "-v2"]
+    >>= assertOutputDoesNotContain "Querying pkg-config database..."
+
+  -- Check that changing a file in PKG_CONFIG_PATH invalidates the cache
+
+  liftIO $ copyFile (testCurrentDir env </> "test.pc") (pkgConfigPath </> "test.pc")
+
+  cabal' "v2-build" ["--dry-run", "p", "-v2"]
+    >>= assertOutputContains "Querying pkg-config database..."
+
+  cabal' "v2-build" ["--dry-run", "p", "-v2"]
+    >>= assertOutputDoesNotContain "Querying pkg-config database..."
diff --git a/cabal-testsuite/PackageTests/MonitorPkgConfig/p.cabal b/cabal-testsuite/PackageTests/MonitorPkgConfig/p.cabal
@@ -0,0 +1,12 @@
+name:                p
+version:             1.0
+license:             BSD3
+author:              Somebody
+maintainer:          [email protected]
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     P
+  build-depends:       base
+  default-language:    Haskell2010
diff --git a/cabal-testsuite/PackageTests/MonitorPkgConfig/test.pc b/cabal-testsuite/PackageTests/MonitorPkgConfig/test.pc
@@ -0,0 +1,3 @@
+Name: test
+Version: 0
+Description: a test .pc file
diff --git a/changelog.d/pr-9422 b/changelog.d/pr-9422
@@ -0,0 +1,12 @@
+synopsis: Add separate cache for getPkgConfigDb
+packages: cabal-install
+prs: #9422
+issues: #8930
+
+description: {
+  Querying pkg-config for the version of every module can be a very expensive
+  operation on some systems. This change adds a separate, per-project, cache for
+  pkgConfigDB; reducing the cost from "every plan change" to "every pkg-config-db
+  change per project". A notice is also presented to the user when refreshing the
+  packagedb.
+}