Multiple test-suites with --coverage (WIP)

Unfortunately, this doesn't quite work right yet, because ".mix" files from the different test suites end up overwriting eachother.
commercialhaskell · Jul 9, 2015 · 66deefa · 66deefa
1 parent 9d252c6
commit 66deefa
Showing 1 changed file with 12 additions and 9 deletions.
diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
@@ -818,7 +818,7 @@ singleTest topts ac ee task =
                 -- directory.  Since the hpc program only takes one specification for "--hpcdir", this must be
                 -- the same for all packages (something which is currently true).
                 subdir <- stripDir pkgDir (hpcDir </> dotHpc)
-                generateHpcReport hpcDir subdir tixes
+                mapM_ (generateHpcReport hpcDir subdir . toFilePath . filename) tixes
 
             bs <- liftIO $
                 case mlogFile of
@@ -851,26 +851,29 @@ compareTestsComponents comps tests2 =
             ("test", y) -> Set.singleton $ T.drop 1 y
             _ -> Set.empty
 
--- | Generate the HTML report and textual report.
+-- | Generate the HTML report and show textual coverage summary.
 generateHpcReport
     :: M env m
-    => Path Abs Dir -> Path Rel Dir -> [Path Abs File] -> m ()
+    => Path Abs Dir -> Path Rel Dir -> String -> m ()
 generateHpcReport _ _ [] = return ()
-generateHpcReport hpcDir subdir tixes = do
+generateHpcReport hpcDir subdir tixName = do
     pkgDirs <- Map.keys . bcPackages <$> asks getBuildConfig
-    let args = concat
-            [ map (toFilePath . filename) tixes
+    outputSubdir <- parseRelDir (FP.dropExtension tixName)
+    let outputDir = hpcDir </> outputSubdir
+        args = concat
+            [ [tixName]
             , concatMap (\x -> ["--srcdir", toFilePath x]) pkgDirs
-            , ["--hpcdir", toFilePath subdir]]
+            , ["--hpcdir", toFilePath subdir, "--reset-hpcdirs"]]
+        markupArgs = "--destdir" : toFilePath outputDir : args
     menv <- getMinimalEnvOverride
     $logInfo "Generating HPC HTML ..."
-    _ <- readProcessStdout (Just hpcDir) menv "hpc" ("markup" : args)
+    _ <- readProcessStdout (Just hpcDir) menv "hpc" ("markup" : markupArgs)
     output <-
         readProcessStdout (Just hpcDir) menv "hpc" ("report" : args)
     forM_ (S8.lines output) ($logInfo . T.decodeUtf8)
     $logInfo
         ("The HTML report is available at " <>
-         T.pack (toFilePath (hpcDir </> $(mkRelFile "hpc_index.html"))))
+         T.pack (toFilePath (outputDir </> $(mkRelFile "hpc_index.html"))))
 
 singleBench :: M env m
             => BenchmarkOpts