diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,12 +1,14 @@ -## Upcoming +# v1.1.0 -## 1.0.1 +* Drop support for GHC < 8.6 +# v1.0.1 + Bug fix: * Don't error if the `packages` field in `stack.yaml` doesn't exist -## 1.0.0 +# v1.0.0 Initial release of `hpc-lcov`: diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,8 +1,8 @@ # hpc-lcov -[![codecov](https://codecov.io/gh/LeapYear/hpc-lcov/branch/master/graph/badge.svg?token=8TErU2ntw9)](https://codecov.io/gh/LeapYear/hpc-lcov) -![CircleCI](https://img.shields.io/circleci/build/github/LeapYear/hpc-lcov) -![Hackage](https://img.shields.io/hackage/v/hpc-lcov) +[![GitHub Actions](https://img.shields.io/github/workflow/status/LeapYear/hpc-lcov/CI/main)](https://github.com/LeapYear/hpc-lcov/actions?query=branch%3Amain) +[![codecov](https://codecov.io/gh/LeapYear/hpc-lcov/branch/main/graph/badge.svg?token=8TErU2ntw9)](https://codecov.io/gh/LeapYear/hpc-lcov) +[![Hackage](https://img.shields.io/hackage/v/hpc-lcov)](https://hackage.haskell.org/package/hpc-lcov) Convert HPC output into `lcov.info` files that can be uploaded to coverage services, like [Codecov](https://codecov.io). @@ -24,11 +24,9 @@ ### How do I convert coverage for an executable? -Note: If you have both tests and executables, HPC will write outputs to the -same file. Because of this, you'll have to load the coverage for each -separately, with a `stack clean` in between. +Note: If you have both tests and executables, HPC will write module information to the same file. Because of this, you'll have to load the coverage for each separately, with a `stack clean` in between. -1. Build the executable with coverage enabled (e.g. `stack build --coverage`) +1. Build a single executable with coverage enabled (e.g. `stack build :my-exe --coverage`) 1. Run the executable 1. This should generate a `.tix` file in the current directory 1. Run the following, specifying the package that builds the executable: diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -1,9 +1,11 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} +import Control.Exception (ErrorCall (..), evaluate, throwIO, try) import Control.Monad (forM) import qualified Data.Aeson as JSON import qualified Data.Aeson.Types as JSON @@ -18,43 +20,55 @@ import Path (Abs, Dir, File, Path, Rel, reldir, relfile, ()) import qualified Path import Path.IO (listDir, listDirRecur, resolveFile') +import System.Exit (ExitCode (..)) import System.Process (readProcessWithExitCode) import Trace.Hpc.Lcov (generateLcovFromTix, writeReport) -import Trace.Hpc.Mix (Mix(..), readMix) -import Trace.Hpc.Tix (Tix(..), TixModule, readTix, tixModuleName) +import Trace.Hpc.Mix (Mix (..), readMix) +import Trace.Hpc.Tix (Tix (..), TixModule, readTix, tixModuleName) data CLIOptions = CLIOptions - { cliTixFiles :: [FilePath] + { cliTixFiles :: [FilePath] , cliMainPackage :: Maybe String - , cliOutput :: FilePath + , cliOutput :: FilePath } getCLIOptions :: IO CLIOptions -getCLIOptions = Opt.execParser - $ Opt.info (Opt.helper <*> parseCLIOptions) $ Opt.progDesc description +getCLIOptions = + Opt.execParser $ + Opt.info (Opt.helper <*> parseCLIOptions) $ + Opt.progDesc description where - parseCLIOptions = CLIOptions - <$> parseCLITixFiles - <*> parseCLIMainPackage - <*> parseCLIOutput - parseCLITixFiles = Opt.many $ Opt.strOption $ mconcat - [ Opt.long "file" - , Opt.short 'f' - , Opt.metavar "FILE" - , Opt.help "Manually specify .tix file(s) to convert" - ] - parseCLIMainPackage = Opt.optional $ Opt.strOption $ mconcat - [ Opt.long "main-package" - , Opt.metavar "PACKAGE" - , Opt.help "The package that built the coverage-enabled executable" - ] - parseCLIOutput = Opt.strOption $ mconcat - [ Opt.long "output" - , Opt.short 'o' - , Opt.metavar "FILE" - , Opt.help "The file to save coverage information (default: lcov.info)" - , Opt.value "lcov.info" - ] + parseCLIOptions = + CLIOptions + <$> parseCLITixFiles + <*> parseCLIMainPackage + <*> parseCLIOutput + parseCLITixFiles = + Opt.many $ + Opt.strOption $ + mconcat + [ Opt.long "file" + , Opt.short 'f' + , Opt.metavar "FILE" + , Opt.help "Manually specify .tix file(s) to convert" + ] + parseCLIMainPackage = + Opt.optional $ + Opt.strOption $ + mconcat + [ Opt.long "main-package" + , Opt.metavar "PACKAGE" + , Opt.help "The package that built the coverage-enabled executable" + ] + parseCLIOutput = + Opt.strOption $ + mconcat + [ Opt.long "output" + , Opt.short 'o' + , Opt.metavar "FILE" + , Opt.help "The file to save coverage information (default: lcov.info)" + , Opt.value "lcov.info" + ] description = "Convert HPC coverage output into the LCOV format" @@ -63,9 +77,10 @@ CLIOptions{..} <- getCLIOptions stackRoot <- getStackRoot - tixFiles <- if null cliTixFiles - then findTixModules - else mapM resolveFile' cliTixFiles + tixFiles <- + if null cliTixFiles + then findTixModules + else mapM resolveFile' cliTixFiles tixModules <- filter (not . isPathsModule) . concat <$> mapM readTixPath tixFiles distDir <- getStackDistPath @@ -73,14 +88,34 @@ let mixDirectories = map (getMixDirectory distDir . snd) packages moduleToMixList <- forM tixModules $ \tixModule -> do - Mix fileLoc _ _ _ mixEntries <- readMixPath mixDirectories (Right tixModule) - fileLocRelPath <- Path.parseRelFile fileLoc + (modulePackageName, Mix fileLoc _ _ _ mixEntries) <- + -- tixModuleName is either just the module name or in the format `PACKAGE-VERSION-HASH/MODULE` + case Text.splitOn "/" . Text.pack . tixModuleName $ tixModule of + [packageVersionHash, _] -> do + let dropEnd n xs = take (length xs - n) xs + let pkgName = Text.intercalate "-" . dropEnd 2 . Text.splitOn "-" $ packageVersionHash + mix <- readMixPathThrow mixDirectories (Right tixModule) + return (Text.unpack pkgName, mix) + ["Main"] -> do + let pkgName = + fromMaybe + (error "Found executable in coverage file, --main-package was not provided") + cliMainPackage + mix <- + readMixPath mixDirectories (Right tixModule) >>= \case + Right x -> return x + Left (ErrorCallWithLocation msg _) + | "does not match hash" `Text.isInfixOf` Text.pack msg -> + error . unlines $ + [ "Coverage file for a Main module contained a different hash from the Mix file." + , "Did you forget to load the coverage separately?" + , "See the README of hpc-lcov for more information." + ] + Left e -> throwIO e + return (pkgName, mix) + _ -> error $ "Could not load Mix file from tix module: " ++ show tixModule - let modulePackageName = case tixModuleName tixModule of - "Main" -> fromMaybe - (error "Found executable in coverage file, --main-package was not provided") - cliMainPackage - _ -> getPackageName tixModule + fileLocRelPath <- Path.parseRelFile fileLoc modulePath <- case modulePackageName `lookup` packages of Just packagePath -> do @@ -92,9 +127,10 @@ return (tixModuleName tixModule, (Path.toFilePath modulePath, mixEntries)) let moduleToMix = Map.toList . Map.fromListWith checkDupeMix $ moduleToMixList - checkDupeMix mix1 mix2 = if mix1 == mix2 - then mix1 - else error $ ".mix files differ: " ++ show (mix1, mix2) + checkDupeMix mix1 mix2 = + if mix1 == mix2 + then mix1 + else error $ ".mix files differ: " ++ show (mix1, mix2) report = generateLcovFromTix moduleToMix tixModules writeReport cliOutput report @@ -113,7 +149,7 @@ -- if multiple .tix files are generated. mAllTix = find ((== [relfile|all.tix|]) . Path.filename) tixFiles - return $ maybe tixFiles (:[]) mAllTix + return $ maybe tixFiles (: []) mAllTix getMixDirectory :: Path Rel Dir -> Path Abs Dir -> Path Abs Dir getMixDirectory distDir packageDir = packageDir distDir [reldir|hpc|] @@ -122,25 +158,18 @@ readTixPath :: Path b File -> IO [TixModule] readTixPath path = do - Tix tixModules <- readTix (Path.toFilePath path) >>= - maybe (fail $ "Could not find tix file: " ++ Path.toFilePath path) return + Tix tixModules <- + readTix (Path.toFilePath path) + >>= maybe (fail $ "Could not find tix file: " ++ Path.toFilePath path) return return tixModules -readMixPath :: [Path b Dir] -> Either String TixModule -> IO Mix -readMixPath = readMix . map Path.toFilePath - -{- Haskell package/module helpers -} +readMixPathThrow :: [Path b Dir] -> Either String TixModule -> IO Mix +readMixPathThrow = readMix . map Path.toFilePath -getPackageName :: TixModule -> String -getPackageName = Text.unpack . takePackageName . Text.pack . tixModuleName - where - -- Tix module name is either just the module name or in the format `PACKAGE-VERSION-HASH/MODULE` - takePackageName s = case Text.splitOn "/" s of - [packageVersionHash, _] -> - Text.intercalate "-" . dropEnd 2 . Text.splitOn "-" $ packageVersionHash - _ -> s +readMixPath :: [Path b Dir] -> Either String TixModule -> IO (Either ErrorCall Mix) +readMixPath dirs tix = try (readMixPathThrow dirs tix >>= evaluate) - dropEnd n xs = take (length xs - n) xs +{- Haskell package/module helpers -} isPathsModule :: TixModule -> Bool isPathsModule = ("Paths_" `isPrefixOf`) . tixModuleName @@ -164,8 +193,9 @@ getPackages :: IO [(String, Path Abs Dir)] getPackages = do stackConfigPath <- readStack ["path", "--config-location"] - stackConfig <- Yaml.decodeFileEither @(HashMap String JSON.Value) stackConfigPath >>= - either (\e -> fail $ "Could not decode file `" ++ stackConfigPath ++ "`: " ++ show e) return + stackConfig <- + Yaml.decodeFileEither @(HashMap String JSON.Value) stackConfigPath + >>= either (\e -> fail $ "Could not decode file `" ++ stackConfigPath ++ "`: " ++ show e) return stackConfigDir <- Path.parent <$> Path.parseAbsFile stackConfigPath @@ -194,14 +224,23 @@ readStack :: [String] -> IO String readStack args = do - (_, stdout, _) <- readProcessWithExitCode "stack" args "" - return . head . lines $ stdout + (code, stdout, stderr) <- readProcessWithExitCode "stack" args "" + case (code, lines stdout) of + (ExitSuccess, line : _) -> return line + _ -> + error . unlines $ + [ "Reading Stack output failed." + , "Code: " ++ show code + , "Stdout: " ++ stdout + , "Stderr: " ++ stderr + ] {- Utilities -} hasExt :: String -> Path b File -> Bool hasExt ext = (== ext') . Path.fileExtension where + #if MIN_VERSION_path(0,7,0) ext' = Just ext #else @@ -209,6 +248,7 @@ #endif removeExtension :: Path b File -> IO (Path b File) + #if MIN_VERSION_path(0,7,0) removeExtension = fmap fst . Path.splitExtension #else diff --git a/hpc-lcov.cabal b/hpc-lcov.cabal --- a/hpc-lcov.cabal +++ b/hpc-lcov.cabal @@ -1,13 +1,11 @@ cabal-version: >= 1.10 --- This file has been generated from package.yaml by hpack version 0.31.1. +-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack --- --- hash: fcb5afe73b641055dbaa90b0e976ead73d6bf55fa27df7c61574f3762fc26ad6 name: hpc-lcov -version: 1.0.1 +version: 1.1.0 synopsis: Convert HPC output into LCOV format description: Convert HPC output into LCOV format. category: Control @@ -40,11 +38,11 @@ base >=4.9 && <5 , containers >=0.5.7.1 && <0.7 , hpc >=0.6.0.3 && <0.7 + default-language: Haskell2010 if impl(ghc >= 8.0) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances if impl(ghc < 8.8) ghc-options: -Wnoncanonical-monadfail-instances - default-language: Haskell2010 executable hpc-lcov main-is: Main.hs @@ -54,23 +52,23 @@ exe ghc-options: -Wall build-depends: - aeson >=1.1.2.0 && <1.6 + aeson >=1.1.2.0 && <3 , base >=4.9 && <5 , containers >=0.5.7.1 && <0.7 , hpc >=0.6.0.3 && <0.7 , hpc-lcov - , optparse-applicative >=0.13.2.0 && <0.16 - , path >=0.6.0 && <0.8 - , path-io >=1.2.2 && <1.7 + , optparse-applicative >=0.13.2.0 && <0.18 + , path >=0.6.0 && <0.10 + , path-io >=1.2.2 && <1.8 , process >=1.4.3.0 && <1.7 , text >=1.2.2.2 && <1.4 , unordered-containers >=0.2.8.0 && <0.3 , yaml >=0.8.24 && <0.12 + default-language: Haskell2010 if impl(ghc >= 8.0) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances if impl(ghc < 8.8) ghc-options: -Wnoncanonical-monadfail-instances - default-language: Haskell2010 test-suite hpc-lcov-test type: exitcode-stdio-1.0 @@ -91,8 +89,8 @@ , tasty-discover , tasty-golden , tasty-hunit + default-language: Haskell2010 if impl(ghc >= 8.0) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances if impl(ghc < 8.8) ghc-options: -Wnoncanonical-monadfail-instances - default-language: Haskell2010 diff --git a/src/Trace/Hpc/Lcov.hs b/src/Trace/Hpc/Lcov.hs --- a/src/Trace/Hpc/Lcov.hs +++ b/src/Trace/Hpc/Lcov.hs @@ -1,16 +1,16 @@ -module Trace.Hpc.Lcov - ( generateLcovFromTix - , writeReport - , FileInfo - ) where +module Trace.Hpc.Lcov ( + generateLcovFromTix, + writeReport, + FileInfo, +) where import Control.Arrow ((&&&)) import Data.List (intercalate, maximumBy) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromMaybe) import Data.Ord (comparing) -import Trace.Hpc.Mix (BoxLabel(..), MixEntry) -import Trace.Hpc.Tix (TixModule(..), tixModuleName, tixModuleTixs) +import Trace.Hpc.Mix (BoxLabel (..), MixEntry) +import Trace.Hpc.Tix (TixModule (..), tixModuleName, tixModuleTixs) import Trace.Hpc.Util (HpcPos, fromHpcPos, toHash) import Trace.Hpc.Lcov.Report @@ -19,10 +19,11 @@ type FileInfo = (FilePath, [MixEntry]) -- | Generate LCOV format from HPC coverage data. -generateLcovFromTix - :: [(String, FileInfo)] -- ^ Mapping from module name to file info - -> [TixModule] - -> LcovReport +generateLcovFromTix :: + -- | Mapping from module name to file info + [(String, FileInfo)] -> + [TixModule] -> + LcovReport generateLcovFromTix moduleToMix = LcovReport . map mkFileReport . mergeTixModules where mkFileReport tixModule = @@ -33,17 +34,18 @@ (error $ "Could not find .mix file for: " ++ moduleName) $ moduleName `lookup` moduleToMix overTixMix f = catMaybes $ zipWith f tickCounts mixEntries - in FileReport - { fileReportLocation = fileLoc - , fileReportFunctions = overTixMix parseFunctionReport - , fileReportBranches = mergeBranchReports $ overTixMix parseBranchReport - , fileReportLines = mergeLineReports $ overTixMix parseLineReport - } + in FileReport + { fileReportLocation = fileLoc + , fileReportFunctions = overTixMix parseFunctionReport + , fileReportBranches = mergeBranchReports $ overTixMix parseBranchReport + , fileReportLines = mergeLineReports $ overTixMix parseLineReport + } --- | Merge all tix modules representing the same module. --- --- If tix modules are duplicated, we are treating them as being hit in different test suites, so all --- tick counts should be added together. +{- | Merge all tix modules representing the same module. + + If tix modules are duplicated, we are treating them as being hit in different test suites, so all + tick counts should be added together. +-} mergeTixModules :: [TixModule] -> [TixModule] mergeTixModules = Map.elems . Map.fromListWith mergeTixs . map (tixModuleName &&& id) where @@ -53,11 +55,12 @@ parseFunctionReport :: Integer -> MixEntry -> Maybe FunctionReport parseFunctionReport tickCount (hpcPos, boxLabel) = mkFunctionReport <$> mFunctionName where - mkFunctionReport names = FunctionReport - { functionReportLine = hpcPosLine hpcPos - , functionReportName = intercalate "$" names - , functionReportHits = tickCount - } + mkFunctionReport names = + FunctionReport + { functionReportLine = hpcPosLine hpcPos + , functionReportName = intercalate "$" names + , functionReportHits = tickCount + } mFunctionName = case boxLabel of TopLevelBox names -> Just names @@ -68,27 +71,30 @@ parseBranchReport tickCount (hpcPos, boxLabel) = case boxLabel of BinBox _ isTrue -> let branchHits = if isTrue then (tickCount, 0) else (0, tickCount) - in Just (hpcPos, branchHits) + in Just (hpcPos, branchHits) _ -> Nothing mergeBranchReports :: [(HpcPos, (Integer, Integer))] -> [BranchReport] mergeBranchReports = map mkBranchReport . Map.toList . Map.fromListWith addPairs where - mkBranchReport (hpcPos, (trueHits, falseHits)) = BranchReport - { branchReportLine = hpcPosLine hpcPos - , branchReportHash = toHash hpcPos - , branchReportTrueHits = trueHits - , branchReportFalseHits = falseHits - } + mkBranchReport (hpcPos, (trueHits, falseHits)) = + BranchReport + { branchReportLine = hpcPosLine hpcPos + , branchReportHash = toHash hpcPos + , branchReportTrueHits = trueHits + , branchReportFalseHits = falseHits + } addPairs (a1, b1) (a2, b2) = (a1 + a2, b1 + b2) parseLineReport :: Integer -> MixEntry -> Maybe LineReport parseLineReport tickCount (hpcPos, boxLabel) = case boxLabel of - ExpBox _ -> Just LineReport - { lineReportLine = hpcPosLine hpcPos - , lineReportHits = tickCount - } + ExpBox _ -> + Just + LineReport + { lineReportLine = hpcPosLine hpcPos + , lineReportHits = tickCount + } _ -> Nothing mergeLineReports :: [LineReport] -> [LineReport] diff --git a/src/Trace/Hpc/Lcov/Report.hs b/src/Trace/Hpc/Lcov/Report.hs --- a/src/Trace/Hpc/Lcov/Report.hs +++ b/src/Trace/Hpc/Lcov/Report.hs @@ -1,14 +1,14 @@ {-# LANGUAGE RecordWildCards #-} -module Trace.Hpc.Lcov.Report - ( LcovReport(..) - , FileReport(..) - , FunctionReport(..) - , BranchReport(..) - , LineReport(..) - , writeReport - , showReport - ) where +module Trace.Hpc.Lcov.Report ( + LcovReport (..), + FileReport (..), + FunctionReport (..), + BranchReport (..), + LineReport (..), + writeReport, + showReport, +) where import Data.List (intercalate) import Trace.Hpc.Util (Hash) @@ -17,29 +17,33 @@ newtype LcovReport = LcovReport [FileReport] data FileReport = FileReport - { fileReportLocation :: FilePath + { fileReportLocation :: FilePath , fileReportFunctions :: [FunctionReport] -- anything top level is considered a function - , fileReportBranches :: [BranchReport] - , fileReportLines :: [LineReport] - } deriving (Show, Eq) + , fileReportBranches :: [BranchReport] + , fileReportLines :: [LineReport] + } + deriving (Show, Eq) data FunctionReport = FunctionReport { functionReportLine :: Int , functionReportName :: String , functionReportHits :: Integer - } deriving (Show, Eq) + } + deriving (Show, Eq) data BranchReport = BranchReport - { branchReportLine :: Int - , branchReportHash :: Hash - , branchReportTrueHits :: Integer + { branchReportLine :: Int + , branchReportHash :: Hash + , branchReportTrueHits :: Integer , branchReportFalseHits :: Integer - } deriving (Show, Eq) + } + deriving (Show, Eq) data LineReport = LineReport { lineReportLine :: Int , lineReportHits :: Integer - } deriving (Show, Eq) + } + deriving (Show, Eq) writeReport :: FilePath -> LcovReport -> IO () writeReport fp = writeFile fp . showReport @@ -47,34 +51,37 @@ showReport :: LcovReport -> String showReport (LcovReport fileReports) = unlines $ concatMap generateFileReport fileReports where - generateFileReport FileReport{..} = concat - [ [line "TN" []] - , [line "SF" [fileReportLocation]] - , map showFunctionDefinition fileReportFunctions - , map showFunctionHits fileReportFunctions - , [line "FNF" [show $ length fileReportFunctions]] - , [line "FNH" [countHits functionReportHits fileReportFunctions]] - , concatMap generateBranchReport fileReportBranches - , [line "BRF" [show $ length fileReportBranches * 2]] -- multiplying by 2 for true and false branches - , [line "BRH" [countHits branchReportHits fileReportBranches]] - , map showLineReport fileReportLines - , [line "LF" [show $ length fileReportLines]] - , [line "LH" [countHits lineReportHits fileReportLines]] - , ["end_of_record"] - ] + generateFileReport FileReport{..} = + concat + [ [line "TN" []] + , [line "SF" [fileReportLocation]] + , map showFunctionDefinition fileReportFunctions + , map showFunctionHits fileReportFunctions + , [line "FNF" [show $ length fileReportFunctions]] + , [line "FNH" [countHits functionReportHits fileReportFunctions]] + , concatMap generateBranchReport fileReportBranches + , [line "BRF" [show $ length fileReportBranches * 2]] -- multiplying by 2 for true and false branches + , [line "BRH" [countHits branchReportHits fileReportBranches]] + , map showLineReport fileReportLines + , [line "LF" [show $ length fileReportLines]] + , [line "LH" [countHits lineReportHits fileReportLines]] + , ["end_of_record"] + ] showFunctionDefinition FunctionReport{..} = line "FN" [show functionReportLine, functionReportName] showFunctionHits FunctionReport{..} = line "FNDA" [show functionReportHits, functionReportName] generateBranchReport BranchReport{..} = - let mkBranchLine branchNum hits = line "BRDA" - [ show branchReportLine - , show branchReportHash - , show (branchNum :: Int) - , show hits - ] - in [mkBranchLine 0 branchReportTrueHits, mkBranchLine 1 branchReportFalseHits] + let mkBranchLine branchNum hits = + line + "BRDA" + [ show branchReportLine + , show branchReportHash + , show (branchNum :: Int) + , show hits + ] + in [mkBranchLine 0 branchReportTrueHits, mkBranchLine 1 branchReportFalseHits] showLineReport LineReport{..} = line "DA" [show lineReportLine, show lineReportHits] diff --git a/test/Lcov.hs b/test/Lcov.hs --- a/test/Lcov.hs +++ b/test/Lcov.hs @@ -3,112 +3,138 @@ module Lcov where +import Data.Bifunctor (first) import Data.List (sortOn) import Test.Tasty (TestTree) import Test.Tasty.HUnit (testCase, (@?=)) -import Trace.Hpc.Mix (BoxLabel(..), CondBox(..)) -import Trace.Hpc.Tix (TixModule(..)) +import Trace.Hpc.Mix (BoxLabel (..), CondBox (..)) +import Trace.Hpc.Tix (TixModule (..)) import Trace.Hpc.Util (Hash, HpcPos, toHash, toHpcPos) import Trace.Hpc.Lcov import Trace.Hpc.Lcov.Report test_generate_lcov_top_level :: TestTree -test_generate_lcov_top_level = testCase "generateLcovFromTix FunctionReport TopLevelBox" $ - let report = generateLcovFromTixMix - [ TixMix "Test" "Test.hs" - [ TixMixEntry 1 (TopLevelBox ["foo"]) 0 - , TixMixEntry 2 (TopLevelBox ["bar"]) 10 +test_generate_lcov_top_level = + testCase "generateLcovFromTix FunctionReport TopLevelBox" $ + let report = + generateLcovFromTixMix + [ TixMix + "Test" + "Test.hs" + [ TixMixEntry 1 (TopLevelBox ["foo"]) 0 + , TixMixEntry 2 (TopLevelBox ["bar"]) 10 + ] + ] + in fromReport report + @?= [ FileReport + "Test.hs" + [ FunctionReport 1 "foo" 0 + , FunctionReport 2 "bar" 10 + ] + [] + [] ] - ] - in fromReport report @?= - [ FileReport "Test.hs" - [ FunctionReport 1 "foo" 0 - , FunctionReport 2 "bar" 10 - ] - [] - [] - ] test_generate_lcov_local :: TestTree -test_generate_lcov_local = testCase "generateLcovFromTix FunctionReport LocalBox" $ - let report = generateLcovFromTixMix - [ TixMix "Test" "Test.hs" - [ TixMixEntry 1 (LocalBox ["foo", "bar"]) 0 - , TixMixEntry 2 (LocalBox ["foo", "baz"]) 10 +test_generate_lcov_local = + testCase "generateLcovFromTix FunctionReport LocalBox" $ + let report = + generateLcovFromTixMix + [ TixMix + "Test" + "Test.hs" + [ TixMixEntry 1 (LocalBox ["foo", "bar"]) 0 + , TixMixEntry 2 (LocalBox ["foo", "baz"]) 10 + ] + ] + in fromReport report + @?= [ FileReport + "Test.hs" + [ FunctionReport 1 "foo$bar" 0 + , FunctionReport 2 "foo$baz" 10 + ] + [] + [] ] - ] - in fromReport report @?= - [ FileReport "Test.hs" - [ FunctionReport 1 "foo$bar" 0 - , FunctionReport 2 "foo$baz" 10 - ] - [] - [] - ] test_generate_lcov_branch :: TestTree -test_generate_lcov_branch = testCase "generateLcovFromTix BranchReport" $ - let report = generateLcovFromTixMix - [ TixMix "Test" "Test.hs" - [ TixMixEntry 1 (BinBox GuardBinBox True) 0 - , TixMixEntry 1 (BinBox GuardBinBox False) 10 +test_generate_lcov_branch = + testCase "generateLcovFromTix BranchReport" $ + let report = + generateLcovFromTixMix + [ TixMix + "Test" + "Test.hs" + [ TixMixEntry 1 (BinBox GuardBinBox True) 0 + , TixMixEntry 1 (BinBox GuardBinBox False) 10 + ] + ] + in fromReport report + @?= [ FileReport + "Test.hs" + [] + [ BranchReport 1 (getHash 1) 0 10 + ] + [] ] - ] - in fromReport report @?= - [ FileReport "Test.hs" - [] - [ BranchReport 1 (getHash 1) 0 10 - ] - [] - ] test_generate_lcov_line :: TestTree -test_generate_lcov_line = testCase "generateLcovFromTix LineReport" $ - let report = generateLcovFromTixMix - [ TixMix "Test" "Test.hs" - [ TixMixEntry 1 (ExpBox True) 0 - , TixMixEntry 2 (ExpBox False) 10 - , TixMixEntry 2 (ExpBox True) 4 - , TixMixEntry 3 (ExpBox False) 0 - , TixMixEntry 3 (ExpBox True) 2 +test_generate_lcov_line = + testCase "generateLcovFromTix LineReport" $ + let report = + generateLcovFromTixMix + [ TixMix + "Test" + "Test.hs" + [ TixMixEntry 1 (ExpBox True) 0 + , TixMixEntry 2 (ExpBox False) 10 + , TixMixEntry 2 (ExpBox True) 4 + , TixMixEntry 3 (ExpBox False) 0 + , TixMixEntry 3 (ExpBox True) 2 + ] + ] + in fromReport report + @?= [ FileReport + "Test.hs" + [] + [] + [ LineReport 1 0 + , -- these take the highest hit count for the line + LineReport 2 10 + , LineReport 3 2 + ] ] - ] - in fromReport report @?= - [ FileReport "Test.hs" - [] - [] - [ LineReport 1 0 - -- these take the highest hit count for the line - , LineReport 2 10 - , LineReport 3 2 - ] - ] test_generate_lcov_merge_tixs :: TestTree -test_generate_lcov_merge_tixs = testCase "generateLcovFromTix merge .tix files" $ - let report = generateLcovFromTix - [ mkModuleToMix "Test" "Test.hs" - [ (1, TopLevelBox ["foo"]) - , (2, LocalBox ["foo", "bar"]) - , (3, ExpBox True) - , (3, BinBox CondBinBox True) - , (3, BinBox CondBinBox False) +test_generate_lcov_merge_tixs = + testCase "generateLcovFromTix merge .tix files" $ + let report = + generateLcovFromTix + [ mkModuleToMix + "Test" + "Test.hs" + [ (1, TopLevelBox ["foo"]) + , (2, LocalBox ["foo", "bar"]) + , (3, ExpBox True) + , (3, BinBox CondBinBox True) + , (3, BinBox CondBinBox False) + ] ] - ] - [ mkTix "Test" [1, 2, 3, 4, 0] - , mkTix "Test" [2, 3, 4, 5, 0] - ] - in fromReport report @?= - [ FileReport "Test.hs" - [ FunctionReport 1 "foo" 3 - , FunctionReport 2 "foo$bar" 5 - ] - [ BranchReport 3 (getHash 3) 9 0 - ] - [ LineReport 3 7 - ] - ] + [ mkTix "Test" [1, 2, 3, 4, 0] + , mkTix "Test" [2, 3, 4, 5, 0] + ] + in fromReport report + @?= [ FileReport + "Test.hs" + [ FunctionReport 1 "foo" 3 + , FunctionReport 2 "foo$bar" 5 + ] + [ BranchReport 3 (getHash 3) 9 0 + ] + [ LineReport 3 7 + ] + ] {- Helpers -} @@ -118,17 +144,17 @@ mkModuleToMix :: String -> FilePath -> [(Int, BoxLabel)] -> (String, FileInfo) mkModuleToMix moduleName filePath mixEntries = (moduleName, (filePath, mixs)) where - mixs = flip map mixEntries $ \(line, boxLabel) -> (getHpcPos line, boxLabel) + mixs = map (first getHpcPos) mixEntries data TixMix = TixMix - { tixMixModule :: String + { tixMixModule :: String , tixMixFilePath :: FilePath - , tixMixEntries :: [TixMixEntry] + , tixMixEntries :: [TixMixEntry] } data TixMixEntry = TixMixEntry - { tixMixEntryLine :: Int - , tixMixBoxLabel :: BoxLabel + { tixMixEntryLine :: Int + , tixMixBoxLabel :: BoxLabel , tixMixEntryTicks :: Integer } @@ -139,7 +165,7 @@ let toMixEntry (TixMixEntry line boxLabel _) = (line, boxLabel) moduleToMix = mkModuleToMix tixMixModule tixMixFilePath $ map toMixEntry tixMixEntries tix = mkTix tixMixModule $ map tixMixEntryTicks tixMixEntries - in (moduleToMix, tix) + in (moduleToMix, tix) fromReport :: LcovReport -> [FileReport] fromReport (LcovReport fileReports) = sortOn fileReportLocation fileReports diff --git a/test/Report.hs b/test/Report.hs --- a/test/Report.hs +++ b/test/Report.hs @@ -11,64 +11,65 @@ test_report_serialization :: TestTree test_report_serialization = goldenVsString "report serialization" "test/golden/report_serialization.golden" $ - pure . fromString . showReport $ LcovReport - [ FileReport - { fileReportLocation = "src/MyModule/Foo.hs" - , fileReportFunctions = - [ FunctionReport - { functionReportLine = 1 - , functionReportName = "foo1" - , functionReportHits = 0 - } - , FunctionReport - { functionReportLine = 5 - , functionReportName = "foo2" - , functionReportHits = 1 - } - ] - , fileReportBranches = - [ BranchReport - { branchReportLine = 1 - , branchReportHash = 100 - , branchReportTrueHits = 10 - , branchReportFalseHits = 5 - } - ] - , fileReportLines = - [ LineReport - { lineReportLine = 1 - , lineReportHits = 10 - } - ] - } - , FileReport - { fileReportLocation = "src/MyModule/Bar.hs" - , fileReportFunctions = [] - , fileReportBranches = [] - , fileReportLines = [] - } - , FileReport - { fileReportLocation = "src/MyModule/Bar/Baz.hs" - , fileReportFunctions = - [ FunctionReport - { functionReportLine = 1 - , functionReportName = "baz1" - , functionReportHits = 10 - } - ] - , fileReportBranches = - [ BranchReport - { branchReportLine = 1 - , branchReportHash = 200 - , branchReportTrueHits = 0 - , branchReportFalseHits = 0 - } - ] - , fileReportLines = - [ LineReport - { lineReportLine = 1 - , lineReportHits = 0 - } - ] - } - ] + pure . fromString . showReport $ + LcovReport + [ FileReport + { fileReportLocation = "src/MyModule/Foo.hs" + , fileReportFunctions = + [ FunctionReport + { functionReportLine = 1 + , functionReportName = "foo1" + , functionReportHits = 0 + } + , FunctionReport + { functionReportLine = 5 + , functionReportName = "foo2" + , functionReportHits = 1 + } + ] + , fileReportBranches = + [ BranchReport + { branchReportLine = 1 + , branchReportHash = 100 + , branchReportTrueHits = 10 + , branchReportFalseHits = 5 + } + ] + , fileReportLines = + [ LineReport + { lineReportLine = 1 + , lineReportHits = 10 + } + ] + } + , FileReport + { fileReportLocation = "src/MyModule/Bar.hs" + , fileReportFunctions = [] + , fileReportBranches = [] + , fileReportLines = [] + } + , FileReport + { fileReportLocation = "src/MyModule/Bar/Baz.hs" + , fileReportFunctions = + [ FunctionReport + { functionReportLine = 1 + , functionReportName = "baz1" + , functionReportHits = 10 + } + ] + , fileReportBranches = + [ BranchReport + { branchReportLine = 1 + , branchReportHash = 200 + , branchReportTrueHits = 0 + , branchReportFalseHits = 0 + } + ] + , fileReportLines = + [ LineReport + { lineReportLine = 1 + , lineReportHits = 0 + } + ] + } + ]