Merge pull request #6255 from commercialhaskell/re6250-hpc

Re #6250 Output summary reports to stdout, not stderr

Author: mpilgrem

ChangeLog.md

@@ -10,8 +10,9 @@ Major changes:
 
 Behavior changes:
 
-* `stack list`, `stack templates` and `stack uninstall` output to the standard
-  output stream rather than to the standard error stream.
+* `stack hpc report`, `stack list`, `stack templates` and `stack uninstall`
+  output their information to the standard output stream rather than to the
+  standard error stream. Logging is still to the standard error stream.
 
 Other enhancements:
 

doc/hpc_command.md

@@ -63,8 +63,9 @@ unified report with just two, we can instead command:
 stack hpc report A B
 ~~~
 
-This will output a textual report for the combined coverage from `A` and `B`'s
-test suites, along with a path to the HTML for the report.
+This will output to the standard output stream a summary report for the combined
+coverage from `A` and `B`'s test suites. It will also log the path to the HTML
+for the corresponding full report.
 
 This command also supports taking extra `.tix` files.  If you've also built an
 executable, against exactly the same library versions of `A`, `B`, and `C`, then
@@ -101,13 +102,17 @@ This report will consider all test results as well as the newly generated
 
 When your project has these properties, you will get the following:
 
-1.  Textual coverage reports in the build output.
+1.  Summary coverage reports, sent to the standard output stream in the build
+    output, and a log of the paths to the HTML for the corresponding full
+    reports.
 
-2.  A unified textual and HTML report, considering the coverage on all local
-    libraries, based on all of the tests that were run.
+2.  A summary unified report, sent to the standard output stream, and a log of
+    the path to the HTML for the corresponding full report. These reports
+    consider the coverage on all local libraries, based on all of the tests that
+    were run.
 
 3.  An index of all generated HTML reports, in `index.html` in the local
-    HPC root directory.
+    HPC root directory, and a log of the path to the HTML for that index.
 
 ## Implementation details
 
@@ -147,10 +152,10 @@ However, advanced users may want to understand exactly how `--coverage` works:
    executable. See issue
    [#1359](https://github.com/commercialhaskell/stack/issues/1359).
 
-5. Once we have a `.tix` file for a test, we also generate a textual and HTML
-   report for it. The textual report is sent to the terminal. The index of the
-   test-specific HTML report is available `pkg-name/test-name/index.html` in the
-   local HPC root directory.
+5. Once we have a `.tix` file for a test, we also generate a summary report and
+   a corresponding full report using HTML. The summary report is sent to the
+   standard output stream. The index of the test-specific HTML report is
+   available at `pkg-name/test-name/index.html` in the local HPC root directory.
 
 6. After the build completes, if there are multiple output `*.tix` files, they
    get combined into a unified report. The index of this report will be

src/Stack/Coverage.hs

@@ -14,8 +14,7 @@ module Stack.Coverage
   , generateHpcMarkupIndex
   ) where
 
-import qualified Data.ByteString.Char8 as S8
-import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as L8
 import qualified Data.List as L
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
@@ -32,6 +31,7 @@ import           Path.IO
                    , ignoringAbsence, listDir, removeDirRecur, removeFile
                    , resolveDir', resolveFile'
                    )
+import           RIO.ByteString.Lazy ( putStrLn )
 import           RIO.Process ( ProcessException, proc, readProcess_ )
 import           Stack.Build.Target ( NeedTargets (..) )
 import           Stack.Constants
@@ -212,9 +212,9 @@ generateHpcReport pkgDir package tests = do
     tixSrc <- tixFilePath (packageName package) (T.unpack testName)
     let report = fillSep
           [ flow "coverage report for"
-          , fromString pkgName' <> "'s"
+          , style Current (fromString pkgName') <> "'s"
           , "test-suite"
-          , fromString $ "\"" <> T.unpack testName <> "\""
+          , style PkgComponent (fromString $ T.unpack testName)
           ]
         reportHtml =
              "coverage report for"
@@ -289,14 +289,15 @@ generateHpcReportInternal tixSrc reportDir report reportHtml extraMarkupArgs ext
         [ "Generating"
         , report <> "."
         ]
-      outputLines <- map (S8.filter (/= '\r')) . S8.lines . BL.toStrict . fst <$>
+      -- 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)" `S8.isSuffixOf`) outputLines
+      if all ("(0/0)" `L8.isSuffixOf`) outputLines
         then do
           let msgHtml =
                    "Error: [S-6829]\n\
@@ -327,9 +328,16 @@ generateHpcReportInternal tixSrc reportDir report reportHtml extraMarkupArgs ext
           pure Nothing
         else do
           let reportPath = reportDir </> relFileHpcIndexHtml
-          -- Print output, stripping @\r@ characters because Windows.
-          forM_ outputLines (logInfo . displayBytesUtf8)
-          -- Generate the markup.
+          -- 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
@@ -392,8 +400,8 @@ generateHpcReportForTargets opts tixFiles targetNames = do
       dest <- resolveDir' destDir
       ensureDir dest
       pure dest
-  let report = flow "combined report"
-      reportHtml = "combined report"
+  let report = flow "combined coverage report"
+      reportHtml = "combined coverage report"
   mreportPath <- generateUnionReport report reportHtml reportDir tixPaths
   forM_ mreportPath $ \reportPath ->
     if hroptsOpenBrowser opts
@@ -429,8 +437,8 @@ generateHpcUnifiedReport = do
       , flow "so not generating a unified coverage report."
       ]
     else do
-      let report = flow "unified report"
-          reportHtml = "unified report"
+      let report = flow "unified coverage report"
+          reportHtml = "unified coverage report"
       mreportPath <- generateUnionReport report reportHtml reportDir tixFiles
       forM_ mreportPath (displayReportPath "The" report . pretty)
 

tests/integration/tests/3997-coverage-with-cabal-3/Main.hs

@@ -6,5 +6,5 @@ main :: IO ()
 main = do
     stack ["setup"]
     stackCheckStderr ["test", "--coverage"] $ \out -> do
-        unless ("The coverage report for foo's test-suite \"foo-test\" is available at" `isInfixOf` out) $
+        unless ("The coverage report for foo's test-suite foo-test is available at" `isInfixOf` out) $
             fail "Coverage report didn't build"

tests/integration/tests/4105-test-coverage-of-internal-lib/Main.hs

@@ -1,19 +1,20 @@
-import Control.Monad (unless)
-import Data.List (isInfixOf, isPrefixOf)
+import Control.Monad ( unless )
+import Data.List ( isInfixOf, isPrefixOf )
 import StackTest
 
 main :: IO ()
 main = do
   stack ["clean"]
-  stack ["build"]
-  res <- getCoverageLines . snd <$> stackStderr ["test", "--coverage", "--color", "never"]
-  case res of
-    _:exprs:_ -> unless ("2/2" `isInfixOf` exprs) testFail
-    _ -> testFail
-  where
-    testFail = fail "Stack didn't generate coverage from both libraries"
+  stackCheckStdout ["test", "--coverage", "--color", "never"] check
+
+check :: String -> IO ()
+check output = case getCoverageLines output of
+  _:exprs:_ -> unless ("2/2" `isInfixOf` exprs) testFail
+  _ -> testFail
+ where
+  testFail = fail "Stack didn't generate coverage from both libraries"
 
 getCoverageLines :: String -> [String]
 getCoverageLines = dropWhile (not . isCoverageHeader) . lines
-  where
-    isCoverageHeader = isPrefixOf "Generating coverage report for "
+ where
+  isCoverageHeader = isPrefixOf "Summary coverage report for "

tests/integration/tests/multi-test/Main.hs

@@ -4,12 +4,10 @@ import StackTest
 
 main :: IO ()
 main = do
-    stack ["build"]
-    stack ["test"]
     -- FIXME: Make 'clean' unnecessary (see #1411)
     stack ["clean"]
     stackCheckStderr ["test", "--coverage"] $ \out -> do
-        unless ("The coverage report for multi-test-suite's test-suite \"multi-test-suite-test\" is available at" `isInfixOf` out) $
+        unless ("The coverage report for multi-test-suite's test-suite multi-test-suite-test is available at" `isInfixOf` out) $
             fail "Didn't get expected report for multi-test-suite-test"
         unless ("[S-6829]" `isInfixOf` out) $
             fail "Didn't get expected empty report for multi-test-suite-test-2"