content: {-# LANGUAGE NoImplicitPrelude     #-}
  {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE NoFieldSelectors      #-}
  {-# LANGUAGE OverloadedRecordDot   #-}
  {-# LANGUAGE OverloadedStrings     #-}
  
  {-|
  Module      : Stack.Coverage
  Description : Generate HPC (Haskell Program Coverage) reports.
  License     : BSD-3-Clause
  
  Generate HPC (Haskell Program Coverage) reports.
  -}
  
  module Stack.Coverage
    ( hpcReportCmd
    , deleteHpcReports
    , updateTixFile
    , generateHpcReport
    , generateHpcUnifiedReport
    , generateHpcMarkupIndex
    ) where
  
  import qualified Data.ByteString.Lazy.Char8 as L8
  import           Data.Conduit ( await )
  import qualified Data.List as L
  import qualified Data.Map.Strict as Map
  import qualified Data.Set as Set
  import qualified Data.Text as T
  import qualified Data.Text.Lazy as LT
  import           Distribution.Types.MungedPackageId ( computeCompatPackageId )
  import           Distribution.Types.UnqualComponentName
                     ( mkUnqualComponentName )
  import           Path
                     ( (</>), dirname, parent, parseAbsFile, parseRelDir
                     , parseRelFile, stripProperPrefix
                     )
  import           Path.Extra ( toFilePathNoTrailingSep )
  import           Path.IO
                     ( copyFile, doesDirExist, doesFileExist, ensureDir
                     , ignoringAbsence, listDir, removeDirRecur, removeFile
                     , resolveDir', resolveFile'
                     )
  import           RIO.ByteString.Lazy ( putStrLn )
  import           RIO.Process
                     ( ExitCodeException, ProcessException, proc, readProcess_ )
  import           Stack.Build.Target ( NeedTargets (..) )
  import           Stack.Constants
                     ( relDirAll, relDirCombined, relDirCustom
                     , relDirExtraTixFiles, relDirPackageConfInplace
                     , relFileHpcIndexHtml, relFileIndexHtml
                     )
  import           Stack.Constants.Config ( distDirFromDir, hpcRelativeDir )
  import           Stack.Package ( hasBuildableMainLibrary )
  import           Stack.PackageDump ( ghcPkgField )
  import           Stack.Prelude
  import           Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig )
  import           Stack.Types.BuildConfig
                     ( BuildConfig (..), HasBuildConfig (..) )
  import           Stack.Types.CompilerPaths ( getGhcPkgExe )
  import           Stack.Types.CompCollection ( getBuildableSetText )
  import           Stack.Types.ComponentUtils ( unqualCompToString )
  import           Stack.Types.BuildOptsCLI
                     ( BuildOptsCLI (..), defaultBuildOptsCLI )
  import           Stack.Types.EnvConfig
                     ( EnvConfig (..), HasEnvConfig (..), hpcReportDir )
  import           Stack.Types.HpcReportOpts ( HpcReportOpts (..) )
  import           Stack.Types.NamedComponent ( NamedComponent (..) )
  import           Stack.Types.Package ( Package (..), packageIdentifier )
  import           Stack.Types.Runner ( Runner )
  import           Stack.Types.SourceMap
                     ( PackageType (..), SMTargets (..), SMWanted (..)
                     , SourceMap (..), Target (..), ppRoot
                     )
  import           System.FilePath ( isPathSeparator )
  import           Trace.Hpc.Tix ( Tix (..), TixModule (..), readTix, writeTix )
  import           Web.Browser ( openBrowser )
  
  -- | Type representing \'pretty\' exceptions thrown by functions exported by the
  -- "Stack.Coverage" module.
  data CoveragePrettyException
    = NonTestSuiteTarget PackageName
    | NoTargetsOrTixSpecified
    | NotLocalPackage PackageName
    deriving Show
  
  instance Pretty CoveragePrettyException where
    pretty (NonTestSuiteTarget name) =
      "[S-6361]"
      <> line
      <> fillSep
           [ flow "Can't specify anything except test-suites as hpc report \
                  \targets"
           , parens (style Target . fromPackageName $ name)
           , flow "is used with a non test-suite target."
           ]
    pretty NoTargetsOrTixSpecified =
      "[S-2321]"
      <> line
      <> flow "Not generating combined report, because no targets or tix files \
              \are specified."
    pretty (NotLocalPackage name) =
      "[S-9975]"
      <> line
      <> fillSep
           [ flow "Expected a project package, but"
           , style Target . fromPackageName $ name
           , flow "is either an extra-dep or in the snapshot."
           ]
  
  instance Exception CoveragePrettyException
  
  -- | Function underlying the @stack hpc report@ command.
  hpcReportCmd :: HpcReportOpts -> RIO Runner ()
  hpcReportCmd hropts = do
    let (tixFiles, targetNames) =
          L.partition (".tix" `T.isSuffixOf`) hropts.inputs
        boptsCLI = defaultBuildOptsCLI
          { targetsCLI = if hropts.all then [] else targetNames }
    withConfig YesReexec $ withEnvConfig AllowNoTargets boptsCLI $
      generateHpcReportForTargets hropts tixFiles targetNames
  
  -- | Invoked at the beginning of running with "--coverage"
  deleteHpcReports :: HasEnvConfig env => RIO env ()
  deleteHpcReports = do
    hpcDir <- hpcReportDir
    liftIO $ ignoringAbsence (removeDirRecur hpcDir)
  
  -- | Move a tix file into a sub-directory of the hpc report directory. Deletes
  -- the old one if one is present.
  updateTixFile ::
       HasEnvConfig env
    => PackageName
    -> Path Abs File
    -> String
    -> RIO env ()
  updateTixFile pkgName' tixSrc testName = do
    exists <- doesFileExist tixSrc
    when exists $ do
      tixDest <- tixFilePath pkgName' testName
      liftIO $ ignoringAbsence (removeFile tixDest)
      ensureDir (parent tixDest)
      -- Remove exe modules because they are problematic. This could be
      -- revisited if there's a GHC version that fixes
      -- https://ghc.haskell.org/trac/ghc/ticket/1853
      readTixOrLog tixSrc >>= \case
        Nothing -> prettyError $
          "[S-2887]"
          <> line
          <> fillSep
               [ flow "Failed to read"
               , pretty tixSrc <> "."
               ]
        Just tix -> do
          liftIO $ writeTix (toFilePath tixDest) (removeExeModules tix)
          -- TODO: ideally we'd do a file move, but IIRC this can
          -- have problems. Something about moving between drives
          -- on windows?
          copyFile tixSrc =<< parseAbsFile (toFilePath tixDest ++ ".premunging")
          liftIO $ ignoringAbsence (removeFile tixSrc)
  
  -- | Get the directory used for hpc reports for the given pkgId.
  hpcPkgPath :: HasEnvConfig env => PackageName -> RIO env (Path Abs Dir)
  hpcPkgPath pkgName' = do
    outputDir <- hpcReportDir
    pkgNameRel <- parseRelDir (packageNameString pkgName')
    pure (outputDir </> pkgNameRel)
  
  -- | Get the tix file location, given the name of the file (without extension),
  -- and the package identifier string.
  tixFilePath :: HasEnvConfig env
              => PackageName -> String -> RIO env (Path Abs File)
  tixFilePath pkgName' testName = do
    pkgPath <- hpcPkgPath pkgName'
    tixRel <- parseRelFile (testName ++ "/" ++ testName ++ ".tix")
    pure (pkgPath </> tixRel)
  
  -- | Generates the HTML coverage report and shows a textual coverage summary for
  -- a package.
  generateHpcReport :: HasEnvConfig env
                    => Path Abs Dir -> Package -> [Text] -> RIO env ()
  generateHpcReport pkgDir package tests = do
    -- If we're using > GHC 7.10, the hpc 'include' parameter must specify a ghc
    -- package key. See
    -- https://github.com/commercialhaskell/stack/issues/785
    let pkgName' = packageNameString package.name
        hasLibrary = hasBuildableMainLibrary package
        subLibs = package.subLibraries
    eincludeName <-
      if not hasLibrary && null subLibs
        -- We don't expect to find a package key if there is no library.
        then pure $ Right Nothing
        -- Look in the inplace DB for the package key.
        -- See https://github.com/commercialhaskell/stack/issues/1181#issuecomment-148968986
        else do
          eincludeName <-
            findPackageFieldForBuiltPackage
              pkgDir
              (packageIdentifier package)
              (getBuildableSetText subLibs)
              -- GHC 8.0 uses package id instead of package key.
              -- See https://github.com/commercialhaskell/stack/issues/2424
              "id"
          case eincludeName of
            Left err -> do
              logError $ display err
              pure $ Left err
            Right includeNames -> pure $ Right $ Just $ map T.unpack includeNames
    forM_ tests $ \testName -> do
      tixSrc <- tixFilePath package.name (T.unpack testName)
      let report = fillSep
            [ flow "coverage report for"
            , style Current (fromString pkgName') <> "'s"
            , "test-suite"
            , style PkgComponent (fromString $ T.unpack testName)
            ]
          reportHtml =
               "coverage report for"
            <> T.pack pkgName'
            <> "'s test-suite \""
            <> testName
            <> "\""
          reportDir = parent tixSrc
      case eincludeName of
        Left err -> generateHpcErrorReport reportDir (display (sanitize (T.unpack err)))
        -- Restrict to just the current library code, if there is a library in the package (see
        -- #634 - this will likely be customizable in the future)
        Right mincludeName -> do
          let extraArgs = case mincludeName of
                Nothing -> []
                Just includeNames ->
                    "--include"
                  : L.intersperse "--include" (map (++ ":") includeNames)
          mreportPath <-
            generateHpcReportInternal tixSrc reportDir report reportHtml extraArgs extraArgs
          forM_ mreportPath (displayReportPath "The" report . pretty)
  
  generateHpcReportInternal ::
       HasEnvConfig env
    => Path Abs File
    -> Path Abs Dir
    -> StyleDoc
       -- ^ The pretty name for the report
    -> Text
       -- ^ The plain name for the report, used in HTML output
    -> [String]
    -> [String]
    -> RIO env (Maybe (Path Abs File))
  generateHpcReportInternal
      tixSrc
      reportDir
      report
      reportHtml
      extraMarkupArgs
      extraReportArgs
    = do
        -- If a .tix file exists, move it to the HPC output directory and generate
        -- a report for it.
        tixFileExists <- doesFileExist tixSrc
        if not tixFileExists
          then do
            prettyError $
              "[S-4634]"
              <> line
              <> fillSep
                   [ flow "Didn't find"
                   , style File ".tix"
                   , "for"
                   , report
                   , flow "- expected to find it at"
                   , pretty tixSrc <> "."
                   ]
            pure Nothing
          else (`catch` \(err :: ProcessException) -> do
                 logError $ displayShow err
                 generateHpcErrorReport reportDir $ display $ sanitize $
                     displayException err
                 pure Nothing) $
             (`onException`
                 prettyError
                   ( "[S-8215]"
                     <> line
                     <> fillSep
                          [ flow "Error occurred while producing"
                          , report <> "."
                          ]
                   )) $ do
            -- Directories for .mix files.
            hpcRelDir <- hpcRelativeDir
            -- Compute arguments used for both "hpc markup" and "hpc report".
            pkgDirs <- view $ buildConfigL . to
              (map ppRoot . Map.elems . (.smWanted.project))
            let args =
                  -- Use index files from all packages (allows cross-package
                  -- coverage results).
                  concatMap (\x -> ["--srcdir", toFilePathNoTrailingSep x]) pkgDirs ++
                  -- Look for index files in the correct dir (relative to each pkgdir).
                  ["--hpcdir", toFilePathNoTrailingSep hpcRelDir, "--reset-hpcdirs"]
            prettyInfoL
              [ "Generating"
              , report <> "."
              ]
            -- Strip @\r@ characters because Windows.
            outputLines <- map (L8.filter (/= '\r')) . L8.lines . fst <$>
              proc "hpc"
              ( "report"
              : toFilePath tixSrc
              : (args ++ extraReportArgs)
              )
              readProcess_
            if all ("(0/0)" `L8.isSuffixOf`) outputLines
              then do
                let msgHtml =
                         "Error: [S-6829]\n\
                         \The "
                      <> display reportHtml
                      <> " did not consider any code. One possible cause of this is \
                         \if your test-suite builds the library code (see Stack \
                         \<a href='https://github.com/commercialhaskell/stack/issues/1008'>\
                         \issue #1008\
                         \</a>\
                         \). It may also indicate a bug in Stack or the hpc program. \
                         \Please report this issue if you think your coverage report \
                         \should have meaningful results."
                prettyError $
                  "[S-6829]"
                  <> line
                  <> fillSep
                       [ "The"
                       , report
                       , flow "did not consider any code. One possible cause of this \
                              \is if your test-suite builds the library code (see \
                              \Stack issue #1008). It may also indicate a bug in \
                              \Stack or the hpc program. Please report this issue if \
                              \you think your coverage report should have meaningful \
                              \results."
                       ]
                generateHpcErrorReport reportDir msgHtml
                pure Nothing
              else do
                let reportPath = reportDir </> relFileHpcIndexHtml
                -- Print the summary report to the standard output stream.
                putUtf8Builder =<< displayWithColor
                  (  fillSep
                       [ "Summary"
                       , report <> ":"
                       ]
                  <> line
                  )
                forM_ outputLines putStrLn
                -- Generate the HTML markup.
                void $ proc "hpc"
                  ( "markup"
                  : toFilePath tixSrc
                  : ("--destdir=" ++ toFilePathNoTrailingSep reportDir)
                  : (args ++ extraMarkupArgs)
                  )
                  readProcess_
                pure (Just reportPath)
  
  generateHpcReportForTargets :: HasEnvConfig env
                              => HpcReportOpts -> [Text] -> [Text] -> RIO env ()
  generateHpcReportForTargets opts tixFiles targetNames = do
    targetTixFiles <-
      -- When there aren't any package component arguments, and --all
      -- isn't passed, default to not considering any targets.
      if not opts.all && null targetNames
      then pure []
      else do
        when (opts.all && not (null targetNames)) $
          prettyWarnL
            $ "Since"
            : style Shell "--all"
            : flow "is used, it is redundant to specify these targets:"
            : mkNarrativeList (Just Target) False
                (map (fromString . T.unpack) targetNames :: [StyleDoc])
        targets <-
          view $ envConfigL . to (.sourceMap.targets.targets)
        fmap concat $ forM (Map.toList targets) $ \(name, target) ->
          case target of
            TargetAll PTDependency -> prettyThrowIO $ NotLocalPackage name
            TargetComps comps -> do
              pkgPath <- hpcPkgPath name
              forM (toList comps) $
                \case
                  CTest testName -> (pkgPath </>) <$>
                    parseRelFile
                      (  testName'
                      ++ "/"
                      ++ testName'
                      ++ ".tix"
                      )
                   where
                    testName' = unqualCompToString testName
                  _ -> prettyThrowIO $ NonTestSuiteTarget name
            TargetAll PTProject -> do
              pkgPath <- hpcPkgPath name
              exists <- doesDirExist pkgPath
              if exists
                then do
                  (dirs, _) <- listDir pkgPath
                  fmap concat $ forM dirs $ \dir -> do
                    (_, files) <- listDir dir
                    pure (filter ((".tix" `L.isSuffixOf`) . toFilePath) files)
                else pure []
    tixPaths <- (++ targetTixFiles) <$>
      mapM (resolveFile' . T.unpack) tixFiles
    when (null tixPaths) $ prettyThrowIO NoTargetsOrTixSpecified
    outputDir <- hpcReportDir
    reportDir <- case opts.destDir of
      Nothing -> pure (outputDir </> relDirCombined </> relDirCustom)
      Just destDir -> do
        dest <- resolveDir' destDir
        ensureDir dest
        pure dest
    let report = flow "combined coverage report"
        reportHtml = "combined coverage report"
    mreportPath <- generateUnionReport report reportHtml reportDir tixPaths
    forM_ mreportPath $ \reportPath ->
      if opts.openBrowser
        then do
          prettyInfo $ "Opening" <+> pretty reportPath <+> "in the browser."
          void $ liftIO $ openBrowser (toFilePath reportPath)
        else displayReportPath "The" report (pretty reportPath)
  
  -- | Generates the HTML unified coverage report.
  generateHpcUnifiedReport :: HasEnvConfig env => RIO env ()
  generateHpcUnifiedReport = do
    outputDir <- hpcReportDir
    ensureDir outputDir
    (dirs, _) <- listDir outputDir
    tixFiles0 <-
      fmap (concat . concat) $ forM (filter (("combined" /=) . dirnameString) dirs) $ \dir -> do
        (dirs', _) <- listDir dir
        forM dirs' $ \dir' -> do
          (_, files) <- listDir dir'
          pure (filter ((".tix" `L.isSuffixOf`) . toFilePath) files)
    extraTixFiles <- findExtraTixFiles
    let tixFiles = tixFiles0  ++ extraTixFiles
        reportDir = outputDir </> relDirCombined </> relDirAll
  -- A single *.tix file does not necessarily mean that a unified coverage report
  -- is redundant. For example, one package may test the library of another
  -- package that does not test its own library. See
  -- https://github.com/commercialhaskell/stack/issues/5713
  --
  -- As an interim solution, a unified coverage report will always be produced
  -- even if may be redundant in some circumstances.
    if null tixFiles
      then prettyInfoL
        [ flow "No tix files found in"
        , pretty outputDir <> ","
        , flow "so not generating a unified coverage report."
        ]
      else do
        let report = flow "unified coverage report"
            reportHtml = "unified coverage report"
        mreportPath <- generateUnionReport report reportHtml reportDir tixFiles
        forM_ mreportPath (displayReportPath "The" report . pretty)
  
  generateUnionReport ::
       HasEnvConfig env
    => StyleDoc
       -- ^ Pretty description of the report.
    -> Text
       -- ^ Plain description of the report, used in HTML reporting.
    -> Path Abs Dir
    -> [Path Abs File]
    -> RIO env (Maybe (Path Abs File))
  generateUnionReport report reportHtml reportDir tixFiles = do
    (errs, tix) <- fmap (unionTixes . map removeExeModules) (mapMaybeM readTixOrLog tixFiles)
    logDebug $ "Using the following tix files: " <> fromString (show tixFiles)
    unless (null errs) $
      prettyWarn $
        fillSep
           [ flow "The following modules are left out of the"
           , report
           , flow "due to version mismatches:"
           ]
      <> line
      <> bulletedList (map fromString errs :: [StyleDoc])
    tixDest <-
      (reportDir </>) <$> parseRelFile (dirnameString reportDir ++ ".tix")
    ensureDir (parent tixDest)
    liftIO $ writeTix (toFilePath tixDest) tix
    generateHpcReportInternal tixDest reportDir report reportHtml [] []
  
  readTixOrLog :: HasTerm env => Path b File -> RIO env (Maybe Tix)
  readTixOrLog path = do
    mtix <- liftIO (readTix (toFilePath path)) `catchAny` \errorCall -> do
      prettyError $
        "[S-3521]"
        <> line
        <> flow "Error while reading tix:"
        <> line
        <> string (displayException errorCall)
      pure Nothing
    when (isNothing mtix) $
      prettyError $
        "[S-7786]"
        <> line
        <> fillSep
             [ flow "Failed to read tix file"
             , pretty path <> "."
             ]
    pure mtix
  
  -- | Module names which contain '/' have a package name, and so they weren't
  -- built into the executable.
  removeExeModules :: Tix -> Tix
  removeExeModules (Tix ms) =
    Tix (filter (\(TixModule name _ _ _) -> '/' `elem` name) ms)
  
  unionTixes :: [Tix] -> ([String], Tix)
  unionTixes tixes = (Map.keys errs, Tix (Map.elems outputs))
   where
    (errs, outputs) = Map.mapEither id $ Map.unionsWith merge $ map toMap tixes
    toMap (Tix ms) = Map.fromList (map (\x@(TixModule k _ _ _) -> (k, Right x)) ms)
    merge (Right (TixModule k hash1 len1 tix1))
        (Right (TixModule _ hash2 len2 tix2))
      | hash1 == hash2 && len1 == len2 =
          Right (TixModule k hash1 len1 (zipWith (+) tix1 tix2))
    merge _ _ = Left ()
  
  -- | Generates the HTML index report.
  generateHpcMarkupIndex :: HasEnvConfig env => RIO env ()
  generateHpcMarkupIndex = do
    outputDir <- hpcReportDir
    let outputFile = outputDir </> relFileIndexHtml
    ensureDir outputDir
    (dirs, _) <- listDir outputDir
    rows <- fmap (concatMap catMaybes) $ forM dirs $ \dir -> do
      (subdirs, _) <- listDir dir
      forM subdirs $ \subdir -> do
        let indexPath = subdir </> relFileHpcIndexHtml
        exists' <- doesFileExist indexPath
        if not exists' then pure Nothing else do
          relPath <- stripProperPrefix outputDir indexPath
          let package = dirname dir
              testsuite = dirname subdir
          pure $ Just $ T.concat
            [ "<tr><td>"
            , pathToHtml package
            , "</td><td><a href=\""
            , pathToHtml relPath
            , "\">"
            , pathToHtml testsuite
            , "</a></td></tr>"
            ]
    writeBinaryFileAtomic outputFile $
         "<html><head><meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">"
      <>
      -- Part of the css from HPC's output HTML
         "<style type=\"text/css\">"
      <> "table.dashboard { border-collapse: collapse; border: solid 1px black }"
      <> ".dashboard td { border: solid 1px black }"
      <> ".dashboard th { border: solid 1px black }"
      <> "</style>"
      <> "</head>"
      <> "<body>"
      <> ( if null rows
             then
                  "<b>No hpc_index.html files found in \""
               <> encodeUtf8Builder (pathToHtml outputDir)
               <> "\".</b>"
             else
                  "<table class=\"dashboard\" width=\"100%\" border=\"1\"><tbody>"
               <> "<p><b>NOTE: This is merely a listing of the html files found in the coverage reports directory.  Some of these reports may be old.</b></p>"
               <> "<tr><th>Package</th><th>TestSuite</th><th>Modification Time</th></tr>"
               <> foldMap encodeUtf8Builder rows
               <> "</tbody></table>"
         )
      <> "</body></html>"
    unless (null rows) $
      displayReportPath
        "\nAn" "index of the generated HTML coverage reports"
        (pretty outputFile)
  
  generateHpcErrorReport :: MonadIO m => Path Abs Dir -> Utf8Builder -> m ()
  generateHpcErrorReport dir err = do
    ensureDir dir
    let fp = toFilePath (dir </> relFileHpcIndexHtml)
    writeFileUtf8Builder fp $
         "<html><head><meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\"></head><body>"
      <> "<h1>HPC Report Generation Error</h1>"
      <> "<p>"
      <> err
      <> "</p>"
      <> "</body></html>"
  
  pathToHtml :: Path b t -> Text
  pathToHtml = T.dropWhileEnd (=='/') . sanitize . toFilePath
  
  -- | Escape HTML symbols (copied from Text.Hastache)
  htmlEscape :: LT.Text -> LT.Text
  htmlEscape = LT.concatMap proc_
   where
    proc_ '&'  = "&amp;"
    proc_ '\\' = "&#92;"
    proc_ '"'  = "&quot;"
    proc_ '\'' = "&#39;"
    proc_ '<'  = "&lt;"
    proc_ '>'  = "&gt;"
    proc_ h    = LT.singleton h
  
  sanitize :: String -> Text
  sanitize = LT.toStrict . htmlEscape . LT.pack
  
  dirnameString :: Path r Dir -> String
  dirnameString = L.dropWhileEnd isPathSeparator . toFilePath . dirname
  
  findPackageFieldForBuiltPackage ::
       HasEnvConfig env
    => Path Abs Dir -> PackageIdentifier -> Set.Set Text -> Text
    -> RIO env (Either Text [Text])
  findPackageFieldForBuiltPackage pkgDir pkgId subLibs field = do
    let subLibNames =
          Set.map (LSubLibName . mkUnqualComponentName . T.unpack) subLibs
        libraryNames = Set.insert LMainLibName subLibNames
        mungedPackageIds = Set.map (computeCompatPackageId pkgId) libraryNames
    distDir <- distDirFromDir pkgDir
    ghcPkgExe <- getGhcPkgExe
    let inplaceDir = distDir </> relDirPackageConfInplace
        pkgIdStr = packageIdentifierString pkgId
        notFoundErr = pure $
          Left $ "Failed to find package key for " <> T.pack pkgIdStr
        extractField mungedPkgId = do
          mContents <- catch
            (ghcPkgField ghcPkgExe inplaceDir mungedPkgId (T.unpack field) await)
            -- A .conf file may not exist in the package database for a library or
            -- sub-library, if that component has not been built yet.
            (\(_ :: ExitCodeException) -> pure Nothing)
          case mContents of
            Just result -> pure $ Right $ T.strip result
            Nothing -> notFoundErr
    logDebug $
         "Scanning "
      <> fromString (toFilePath inplaceDir)
      <> " for munged packages matching "
      <> fromString pkgIdStr
    (errors, keys) <-
      partitionEithers <$> traverse extractField (Set.toList mungedPackageIds)
    case errors of
      (a:_) -> pure $ Left a -- the first error only, since they're repeated anyway
      [] -> pure $ Right keys
  
  displayReportPath ::
       HasTerm env
    => StyleDoc
    -> StyleDoc
    -> StyleDoc
    -> RIO env ()
  displayReportPath prefix report reportPath =
    prettyInfoL
      [ prefix
      , report
      , flow "is available at"
      , reportPath <> "."
      ]
  
  findExtraTixFiles :: HasEnvConfig env => RIO env [Path Abs File]
  findExtraTixFiles = do
    outputDir <- hpcReportDir
    let dir = outputDir </> relDirExtraTixFiles
    dirExists <- doesDirExist dir
    if dirExists
      then do
        (_, files) <- listDir dir
        pure $ filter ((".tix" `L.isSuffixOf`) . toFilePath) files
      else pure []
  