HPC artifacts are written and read from pkg-db

TODO: Describe design

Cabal/src/Distribution/Simple/Configure.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -44,6 +45,7 @@ module Distribution.Simple.Configure
   , localBuildInfoFile
   , getInstalledPackages
   , getInstalledPackagesMonitorFiles
+  , getInstalledPackageById
   , getPackageDBContents
   , configCompilerEx
   , configCompilerAuxEx
@@ -78,7 +80,7 @@ import Distribution.Simple.BuildTarget
 import Distribution.Simple.BuildToolDepends
 import Distribution.Simple.Compiler
 import Distribution.Simple.LocalBuildInfo
-import Distribution.Simple.PackageIndex (InstalledPackageIndex)
+import Distribution.Simple.PackageIndex (InstalledPackageIndex, lookupUnitId)
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 import Distribution.Simple.PreProcess
 import Distribution.Simple.Program
@@ -877,6 +879,12 @@ configure (pkg_descr0, pbi) cfg = do
           Map.empty
           buildComponents
 
+  -- ROMES:TODO: For per-package configure, we have to determine
+  -- configureCoverageFor here. Should we enforce something here on that
+  -- --coverage-for should not include indefinite or instantiations?
+  -- Then, whatever we discover about package unit ids here, we should write
+  -- into configFlags, or should we really have a distinct field in LBI?
+
   let lbi =
         (setCoverageLBI . setProfLBI)
           LocalBuildInfo
@@ -1747,6 +1755,14 @@ getInstalledPackagesMonitorFiles verbosity comp packageDBs progdb platform =
           ++ prettyShow other
       return []
 
+-- | Looks up the 'InstalledPackageInfo' of a given 'UnitId' from the
+-- 'PackageDBStack' in the 'LocalBuildInfo'.
+getInstalledPackageById :: Verbosity -> LocalBuildInfo -> UnitId -> IO (Maybe InstalledPackageInfo)
+getInstalledPackageById verbosity LocalBuildInfo{compiler,withPackageDB,withPrograms} unitid = do
+  ipindex <- getInstalledPackages verbosity compiler withPackageDB withPrograms
+  return $ lookupUnitId ipindex unitid
+
+
 -- | The user interface specifies the package dbs to use with a combination of
 -- @--global@, @--user@ and @--package-db=global|user|clear|$file@.
 -- This function combines the global/user flag and interprets the package-db

Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs

@@ -19,7 +19,6 @@ import Distribution.PackageDescription.Utils (cabalBug)
 import Distribution.Pretty
 import Distribution.Simple.BuildPaths
 import Distribution.Simple.Compiler
-import Distribution.Simple.Flag (Flag (..), fromFlag, toFlag)
 import Distribution.Simple.GHC.Build
   ( checkNeedsRecompilation
   , componentGhcOptions
@@ -39,7 +38,7 @@ import Distribution.Simple.LocalBuildInfo
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 import Distribution.Simple.Program
 import Distribution.Simple.Program.GHC
-import Distribution.Simple.Setup.Config
+import Distribution.Simple.Setup.Common
 import Distribution.Simple.Setup.Repl
 import Distribution.Simple.Utils
 import Distribution.System
@@ -399,10 +398,9 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
   -- Determine if program coverage should be enabled and if so, what
   -- '-hpcdir' should be.
   let isCoverageEnabled = exeCoverage lbi
-      distPref = fromFlag $ configDistPref $ configFlags lbi
       hpcdir way
         | gbuildIsRepl bm = mempty -- HPC is not supported in ghci
-        | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way
+        | isCoverageEnabled = toFlag $ Hpc.mixDir (tmpDir </> extraCompilationArtifacts) way
         | otherwise = mempty
 
   rpaths <- getRPaths lbi clbi

Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs

@@ -9,7 +9,6 @@ import Distribution.Package
 import Distribution.PackageDescription as PD
 import Distribution.Simple.BuildPaths
 import Distribution.Simple.Compiler
-import Distribution.Simple.Flag (Flag (..), fromFlag, toFlag)
 import Distribution.Simple.GHC.Build
   ( checkNeedsRecompilation
   , componentGhcOptions
@@ -27,7 +26,7 @@ import Distribution.Simple.Program
 import qualified Distribution.Simple.Program.Ar as Ar
 import Distribution.Simple.Program.GHC
 import qualified Distribution.Simple.Program.Ld as Ld
-import Distribution.Simple.Setup.Config
+import Distribution.Simple.Setup.Common
 import Distribution.Simple.Setup.Repl
 import Distribution.Simple.Utils
 import Distribution.System
@@ -96,10 +95,9 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
   -- Determine if program coverage should be enabled and if so, what
   -- '-hpcdir' should be.
   let isCoverageEnabled = libCoverage lbi
-      distPref = fromFlag $ configDistPref $ configFlags lbi
       hpcdir way
         | forRepl = mempty -- HPC is not supported in ghci
-        | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way
+        | isCoverageEnabled = toFlag $ Hpc.mixDir (libTargetDir </> extraCompilationArtifacts) way
         | otherwise = mempty
 
   createDirectoryIfMissingVerbose verbosity True libTargetDir

Cabal/src/Distribution/Simple/GHCJS.hs

@@ -72,7 +72,7 @@ import Distribution.Simple.Program
 import Distribution.Simple.Program.GHC
 import qualified Distribution.Simple.Program.HcPkg as HcPkg
 import qualified Distribution.Simple.Program.Strip as Strip
-import Distribution.Simple.Setup.Config
+import Distribution.Simple.Setup.Common
 import Distribution.Simple.Utils
 import Distribution.System
 import Distribution.Types.ComponentLocalBuildInfo
@@ -515,10 +515,9 @@ buildOrReplLib mReplFlags verbosity numJobs _pkg_descr lbi lib clbi = do
   -- Determine if program coverage should be enabled and if so, what
   -- '-hpcdir' should be.
   let isCoverageEnabled = libCoverage lbi
-      distPref = fromFlag $ configDistPref $ configFlags lbi
       hpcdir way
         | forRepl = mempty -- HPC is not supported in ghci
-        | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way
+        | isCoverageEnabled = toFlag $ Hpc.mixDir (libTargetDir </> extraCompilationArtifacts) way
         | otherwise = mempty
 
   createDirectoryIfMissingVerbose verbosity True libTargetDir
@@ -1235,10 +1234,9 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
   -- Determine if program coverage should be enabled and if so, what
   -- '-hpcdir' should be.
   let isCoverageEnabled = exeCoverage lbi
-      distPref = fromFlag $ configDistPref $ configFlags lbi
       hpcdir way
         | gbuildIsRepl bm = mempty -- HPC is not supported in ghci
-        | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way
+        | isCoverageEnabled = toFlag $ Hpc.mixDir (tmpDir </> extraCompilationArtifacts) way
         | otherwise = mempty
 
   rpaths <- getRPaths lbi clbi

Cabal/src/Distribution/Simple/Hpc.hs

@@ -28,21 +28,19 @@ module Distribution.Simple.Hpc
 import Distribution.Compat.Prelude
 import Prelude ()
 
-import Distribution.ModuleName (main)
+import Distribution.ModuleName (main, ModuleName)
 import Distribution.PackageDescription
   ( TestSuite (..)
   , testModules
   )
 import qualified Distribution.PackageDescription as PD
 import Distribution.Pretty
-import Distribution.Simple.Flag (fromFlagOrDefault)
 import Distribution.Simple.LocalBuildInfo (LocalBuildInfo (..))
 import Distribution.Simple.Program
   ( hpcProgram
   , requireProgramVersion
   )
 import Distribution.Simple.Program.Hpc (markup, union)
-import Distribution.Simple.Setup (TestFlags (..))
 import Distribution.Simple.Utils (notice)
 import Distribution.Types.UnqualComponentName
 import Distribution.Verbosity (Verbosity ())
@@ -115,14 +113,15 @@ guessWay lbi
 -- | Generate the HTML markup for a package's test suites.
 markupPackage
   :: Verbosity
-  -> TestFlags
+  -> [FilePath]
+  -> [ModuleName]
   -> LocalBuildInfo
   -> FilePath
   -- ^ Testsuite \"dist/\" prefix
   -> PD.PackageDescription
   -> [TestSuite]
   -> IO ()
-markupPackage verbosity TestFlags{testCoverageDistPrefs, testCoverageLibsModules} lbi testDistPref pkg_descr suites = do
+markupPackage verbosity testCoverageDistPrefs testCoverageLibsModules lbi testDistPref pkg_descr suites = do
   let tixFiles = map (tixFilePath testDistPref way) testNames
   tixFilesExist <- traverse doesFileExist tixFiles
   when (and tixFilesExist) $ do
@@ -168,5 +167,5 @@ markupPackage verbosity TestFlags{testCoverageDistPrefs, testCoverageLibsModules
   where
     way = guessWay lbi
     testNames = fmap (unUnqualComponentName . testName) suites
-    mixDirs = map (`mixDir` way) (fromFlagOrDefault [] testCoverageDistPrefs)
-    included = fromFlagOrDefault [] testCoverageLibsModules
+    mixDirs = map (`mixDir` way) (testCoverageDistPrefs)
+    included = testCoverageLibsModules

Cabal/src/Distribution/Simple/Setup/Config.hs

@@ -54,6 +54,7 @@ import Distribution.Types.DumpBuildInfo
 import Distribution.Types.GivenComponent
 import Distribution.Types.Module
 import Distribution.Types.PackageVersionConstraint
+import Distribution.Types.UnitId
 import Distribution.Utils.NubList
 import Distribution.Verbosity
 import qualified Text.PrettyPrint as Disp
@@ -220,6 +221,11 @@ data ConfigFlags = ConfigFlags
   -- ^ Allow depending on private sublibraries. This is used by external
   -- tools (like cabal-install) so they can add multiple-public-libraries
   -- compatibility to older ghcs by checking visibility externally.
+  , configCoverageFor :: Flag [UnitId]
+  -- ^ The list of libraries to be included in the hpc coverage report for
+  -- testsuites run with @--enable-coverage@. Notably, this list must exclude
+  -- indefinite libraries and instantiations because HPC does not support
+  -- backpack (Nov. 2023).
   }
   deriving (Generic, Read, Show, Typeable)
 
@@ -288,6 +294,7 @@ instance Eq ConfigFlags where
       && equal configDebugInfo
       && equal configDumpBuildInfo
       && equal configUseResponseFiles
+      && equal configCoverageFor
     where
       equal f = on (==) f a b
 
@@ -828,6 +835,22 @@ configureOptions showOrParseArgs =
           configAllowDependingOnPrivateLibs
           (\v flags -> flags{configAllowDependingOnPrivateLibs = v})
           trueArg
+       , option
+           ""
+           ["coverage-for"]
+           "Module of a project-local library to include in the HPC report"
+           configCoverageFor
+           ( \v flags ->
+               flags
+                 { configCoverageFor =
+                     mergeListFlag (configCoverageFor flags) v
+                 }
+           )
+           ( reqArg'
+               "MODULE"
+               (Flag . (: []) . fromString)
+               (fmap prettyShow . fromFlagOrDefault [])
+           )
        ]
   where
     liftInstallDirs =

Cabal/src/Distribution/Simple/Setup/Test.hs

@@ -40,7 +40,6 @@ import Distribution.Simple.Utils
 import Distribution.Verbosity
 import qualified Text.PrettyPrint as Disp
 
-import Distribution.ModuleName (ModuleName)
 import Distribution.Simple.Setup.Common
 
 -- ------------------------------------------------------------
@@ -89,15 +88,6 @@ data TestFlags = TestFlags
   , testKeepTix :: Flag Bool
   , testWrapper :: Flag FilePath
   , testFailWhenNoTestSuites :: Flag Bool
-  , testCoverageLibsModules :: Flag [ModuleName]
-  -- ^ The list of all modules from libraries in the local project that should
-  -- be included in the hpc coverage report.
-  , testCoverageDistPrefs :: Flag [FilePath]
-  -- ^ The path to each library local to this project and to the test
-  -- components being built, to include in coverage reporting (notably, this
-  -- excludes indefinite libraries and instantiations because HPC does not
-  -- support backpack - Nov. 2023).  Cabal uses these paths as dist prefixes to
-  -- determine the path to the `mix` dirs of each component to cover.
   , -- TODO: think about if/how options are passed to test exes
     testOptions :: [PathTemplate]
   }
@@ -114,8 +104,6 @@ defaultTestFlags =
     , testKeepTix = toFlag False
     , testWrapper = NoFlag
     , testFailWhenNoTestSuites = toFlag False
-    , testCoverageLibsModules = NoFlag
-    , testCoverageDistPrefs = NoFlag
     , testOptions = []
     }
 
@@ -221,38 +209,6 @@ testOptions' showOrParseArgs =
       testFailWhenNoTestSuites
       (\v flags -> flags{testFailWhenNoTestSuites = v})
       trueArg
-  , option
-      []
-      ["coverage-module"]
-      "Module of a project-local library to include in the HPC report"
-      testCoverageLibsModules
-      ( \v flags ->
-          flags
-            { testCoverageLibsModules =
-                mergeListFlag (testCoverageLibsModules flags) v
-            }
-      )
-      ( reqArg'
-          "MODULE"
-          (Flag . (: []) . fromString)
-          (fmap prettyShow . fromFlagOrDefault [])
-      )
-  , option
-      []
-      ["coverage-dist-dir"]
-      "The directory where Cabal puts generated build files of an HPC enabled component"
-      testCoverageDistPrefs
-      ( \v flags ->
-          flags
-            { testCoverageDistPrefs =
-                mergeListFlag (testCoverageDistPrefs flags) v
-            }
-      )
-      ( reqArg'
-          "DIR"
-          (Flag . (: []))
-          (fromFlagOrDefault [])
-      )
   , option
       []
       ["test-options"]