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.
andreabedini · Jun 19, 2024 · ad13fcf · ad13fcf
1 parent 1c00507
commit ad13fcf
Show file tree

Hide file tree

Showing 11 changed files with 128 additions and 38 deletions.
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs
@@ -51,6 +51,7 @@ module Distribution.Client.ProjectConfig
   , resolveSolverSettings
   , BuildTimeSettings (..)
   , resolveBuildTimeSettings
+  , resolveProgramDb
 
     -- * Checking configuration
   , checkBadPerPackageCompilerPaths
@@ -158,6 +159,12 @@ import Distribution.Simple.InstallDirs
 import Distribution.Simple.Program
   ( ConfiguredProgram (..)
   )
+import Distribution.Simple.Program.Db
+  ( ProgramDb
+  , defaultProgramDb
+  , prependProgramSearchPath
+  , userSpecifyPaths
+  )
 import Distribution.Simple.Setup
   ( Flag (Flag)
   , flagToList
@@ -507,6 +514,14 @@ resolveBuildTimeSettings
         | isParallelBuild buildSettingNumJobs = False
         | otherwise = False
 
+-- | ProgramDb with user specified paths
+resolveProgramDb :: Verbosity -> PackageConfig -> IO ProgramDb
+resolveProgramDb verbosity packageConfig = do
+  let extraPath = fromNubList (packageConfigProgramPathExtra packageConfig)
+  programDb <- prependProgramSearchPath verbosity extraPath [] defaultProgramDb
+  let paths = Map.toList $ getMapLast (packageConfigProgramPaths packageConfig)
+  return $ userSpecifyPaths paths programDb
+
 ---------------------------------------------
 -- Reading and writing project config files
 --

diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -459,11 +459,7 @@ configureCompiler
         , projectConfigHcPath
         , projectConfigHcPkg
         }
-    , projectConfigLocalPackages =
-      PackageConfig
-        { packageConfigProgramPaths
-        , packageConfigProgramPathExtra
-        }
+    , projectConfigLocalPackages
     } = do
     let fileMonitorCompiler = newFileMonitor $ distProjectCacheFile "compiler"
 
@@ -475,35 +471,26 @@ configureCompiler
       , hcPath
       , hcPkg
       , progsearchpath
-      , packageConfigProgramPaths
-      , packageConfigProgramPathExtra
+      , projectConfigLocalPackages
       )
       $ do
         liftIO $ info verbosity "Compiler settings changed, reconfiguring..."
-        let extraPath = fromNubList packageConfigProgramPathExtra
-        progdb <- liftIO $ prependProgramSearchPath verbosity extraPath [] defaultProgramDb
-        let progdb' = userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) progdb
-        (comp, plat, progdb'') <-
-          liftIO $
-            Cabal.configCompilerEx
-              hcFlavor
-              hcPath
-              hcPkg
-              progdb'
-              verbosity
+        progdb <- liftIO $ resolveProgramDb verbosity projectConfigLocalPackages
+        (comp, plat, progdb') <-
+          liftIO $ Cabal.configCompilerEx hcFlavor hcPath hcPkg progdb verbosity
 
         -- Note that we added the user-supplied program locations and args
         -- for /all/ programs, not just those for the compiler prog and
         -- compiler-related utils. In principle we don't know which programs
         -- the compiler will configure (and it does vary between compilers).
         -- We do know however that the compiler will only configure the
         -- programs it cares about, and those are the ones we monitor here.
-        monitorFiles (programsMonitorFiles progdb'')
+        monitorFiles (programsMonitorFiles progdb')
 
         -- Configure the unconfigured programs in the program database,
         -- as we can't serialise unconfigured programs.
         -- See also #2241 and #9840.
-        finalProgDb <- liftIO $ configureAllKnownPrograms verbosity progdb''
+        finalProgDb <- liftIO $ configureAllKnownPrograms verbosity progdb'
 
         return (comp, plat, finalProgDb)
     where
@@ -555,9 +542,14 @@ rebuildInstallPlan
     { cabalStoreDirLayout
     } = \projectConfig localPackages mbInstalledPackages ->
     runRebuild distProjectRootDirectory $ do
-      progsearchpath <- liftIO $ getSystemSearchPath
+      progsearchpath <- liftIO getSystemSearchPath
       let projectConfigMonitored = projectConfig{projectConfigBuildOnly = mempty}
 
+      progdb <- liftIO $ resolveProgramDb verbosity (projectConfigLocalPackages projectConfig)
+      monitorFiles (programsMonitorFiles progdb)
+
+      pkgConfigDB <- getPkgConfigDb verbosity distDirLayout progdb
+
       -- The overall improved plan is cached
       rerunIfChanged
         verbosity
@@ -578,15 +570,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
@@ -620,7 +612,8 @@ rebuildInstallPlan
       phaseConfigureCompiler
         :: ProjectConfig
         -> Rebuild (Compiler, Platform, ProgramDb)
-      phaseConfigureCompiler = configureCompiler verbosity distDirLayout
+      phaseConfigureCompiler projectConfig =
+        configureCompiler verbosity distDirLayout projectConfig
 
       -- Configuring other programs.
       --
@@ -660,15 +653,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
@@ -695,7 +690,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
@@ -720,7 +714,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 =
@@ -1008,13 +1002,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 changes in the .pc files themselves.
+        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/ExtraProgPath/setup.out b/cabal-testsuite/PackageTests/ExtraProgPath/setup.out
@@ -1,6 +1,8 @@
 # cabal v2-build
 Warning: cannot determine version of <ROOT>/pkg-config :
 ""
+Warning: cannot determine version of <ROOT>/pkg-config :
+""
 Resolving dependencies...
 Error: [Cabal-7107]
 Could not resolve dependencies:

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/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs
@@ -17,8 +17,7 @@ testBody = withProjectFile "cabal.project" $ withRemoteRepo "repo" $ do
           . resultOutput
         <$> recordMode DoNotRecord (cabal' "update" [])
   -- update golden output with actual timestamp
-  shell "cp" ["cabal.out.in", "cabal.out"]
-  shell "sed" ["-i''", "-e", "s/REPLACEME/" <> output <> "/g", "cabal.out"]
+  shell "sed" ["-e", "s/REPLACEME/" <> output <> "/g; w cabal.out", "cabal.out.in"]
   -- This shall fail with an error message as specified in `cabal.out`
   fails $ cabal "build" ["--index-state=4000-01-01T00:00:00Z", "fake-pkg"]
   -- This shall fail by not finding the package, what indicates that it

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.
+}