hpc-lcov (empty) → 1.0.0
raw patch · 11 files changed
+840/−0 lines, 11 filesdep +aesondep +basedep +containers
Dependencies added: aeson, base, containers, hpc, hpc-lcov, optparse-applicative, path, path-io, process, tasty, tasty-discover, tasty-golden, tasty-hunit, text, unordered-containers, yaml
Files
- CHANGELOG.md +9/−0
- LICENSE +11/−0
- README.md +51/−0
- exe/Main.hs +211/−0
- hpc-lcov.cabal +98/−0
- src/Trace/Hpc/Lcov.hs +103/−0
- src/Trace/Hpc/Lcov/Report.hs +92/−0
- test/Lcov.hs +151/−0
- test/Main.hs +1/−0
- test/Report.hs +74/−0
- test/golden/report_serialization.golden +39/−0
+ CHANGELOG.md view
@@ -0,0 +1,9 @@+## Upcoming++## 1.0.0++Initial release of `hpc-lcov`:++* Generates LCOV files from HPC `.tix` files+* Discovers `.tix` files generated by Stack test suites+* Allows manually specifying a `.tix` file (useful for executables with coverage enabled)
+ LICENSE view
@@ -0,0 +1,11 @@+Copyright 2020 LeapYear++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,51 @@+# hpc-lcov++[](https://codecov.io/gh/LeapYear/hpc-lcov)++++Convert HPC output into `lcov.info` files that can be uploaded to coverage+services, like [Codecov](https://codecov.io).++## Quickstart++### Stack++1. Run `stack build hpc-lcov`+1. Run your test(s) with coverage, e.g. `stack test --coverage`+1. Run `stack exec hpc-lcov`+1. Upload the generated `lcov.info` file to your coverage service++### Cabal++Coming soon! (https://github.com/LeapYear/hpc-lcov/issues/3)++## FAQs++### 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.++1. Build the executable with coverage enabled (e.g. `stack build --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:+ ```bash+ stack exec -- hpc-lcov --file my-exe.tix --main-package my-package+ ```++### How do I merge coverage files?++1. Install LCOV (e.g. `brew install lcov`)+1. Run++ ```bash+ lcov -a lcov1.info -a lcov2.info ... > lcov.info+ ```++## Resources++* [LCOV format description](http://ltp.sourceforge.net/coverage/lcov/geninfo.1.php)+* [More info on HPC](https://wiki.haskell.org/Haskell_program_coverage)
+ exe/Main.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}++import Control.Monad (forM)+import qualified Data.Aeson as JSON+import qualified Data.Aeson.Types as JSON+import Data.HashMap.Lazy (HashMap, (!))+import Data.List (find, isPrefixOf)+import qualified Data.Map as Map+import Data.Maybe (fromMaybe)+import qualified Data.Text as Text+import qualified Data.Yaml as Yaml+import qualified Options.Applicative as Opt+import Path (Abs, Dir, File, Path, Rel, reldir, relfile, (</>))+import qualified Path+import Path.IO (listDir, listDirRecur, resolveFile')+import System.Process (readProcessWithExitCode)+import Trace.Hpc.Lcov (generateLcovFromTix, writeReport)+import Trace.Hpc.Mix (Mix(..), readMix)+import Trace.Hpc.Tix (Tix(..), TixModule, readTix, tixModuleName)++data CLIOptions = CLIOptions+ { cliTixFiles :: [FilePath]+ , cliMainPackage :: Maybe String+ , cliOutput :: FilePath+ }++getCLIOptions :: IO CLIOptions+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"+ ]++ description = "Convert HPC coverage output into the LCOV format"++main :: IO ()+main = do+ CLIOptions{..} <- getCLIOptions+ stackRoot <- getStackRoot++ tixFiles <- if null cliTixFiles+ then findTixModules+ else mapM resolveFile' cliTixFiles+ tixModules <- filter (not . isPathsModule) . concat <$> mapM readTixPath tixFiles++ distDir <- getStackDistPath+ packages <- getPackages+ let mixDirectories = map (getMixDirectory distDir . snd) packages++ moduleToMixList <- forM tixModules $ \tixModule -> do+ Mix fileLoc _ _ _ mixEntries <- readMixPath mixDirectories (Right tixModule)+ fileLocRelPath <- Path.parseRelFile fileLoc++ let modulePackageName = case tixModuleName tixModule of+ "Main" -> fromMaybe+ (error "Found executable in coverage file, --main-package was not provided")+ cliMainPackage+ _ -> getPackageName tixModule++ modulePath <- case modulePackageName `lookup` packages of+ Just packagePath -> do+ let modulePathAbs = packagePath </> fileLocRelPath+ maybe (fail $ show modulePathAbs ++ " is not a subpath of " ++ show stackRoot) return $+ Path.stripProperPrefix stackRoot modulePathAbs+ Nothing -> fail $ "Could not find package: " ++ modulePackageName++ 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)+ report = generateLcovFromTix moduleToMix tixModules++ writeReport cliOutput report++{- HPC file discovery -}++-- | Find all .tix files in the HPC root.+findTixModules :: IO [Path Abs File]+findTixModules = do+ hpcRoot <- getStackHpcRoot++ (_, files) <- listDirRecur hpcRoot++ let tixFiles = filter (hasExt ".tix") files+ -- Find all.tix, if one exists, which Stack automatically generates+ -- if multiple .tix files are generated.+ mAllTix = find ((== [relfile|all.tix|]) . Path.filename) tixFiles++ return $ maybe tixFiles (:[]) mAllTix++getMixDirectory :: Path Rel Dir -> Path Abs Dir -> Path Abs Dir+getMixDirectory distDir packageDir = packageDir </> distDir </> [reldir|hpc|]++{- HPC file readers -}++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+ return tixModules++readMixPath :: [Path b Dir] -> Either String TixModule -> IO Mix+readMixPath = readMix . map Path.toFilePath++{- Haskell package/module helpers -}++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++ dropEnd n xs = take (length xs - n) xs++isPathsModule :: TixModule -> Bool+isPathsModule = ("Paths_" `isPrefixOf`) . tixModuleName++{- Stack helpers -}++-- | Get the root of the stack project.+getStackRoot :: IO (Path Abs Dir)+getStackRoot = do+ -- assume that the stack.yaml file is at the root of the stack projet+ configPath <- readStack ["path", "--config-location"]+ Path.parent <$> Path.parseAbsFile configPath++getStackHpcRoot :: IO (Path Abs Dir)+getStackHpcRoot = Path.parseAbsDir =<< readStack ["path", "--local-hpc-root"]++getStackDistPath :: IO (Path Rel Dir)+getStackDistPath = Path.parseRelDir =<< readStack ["path", "--dist-dir"]++-- | Get a list of package names in the stack project and their location.+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++ stackConfigDir <- Path.parent <$> Path.parseAbsFile stackConfigPath++ packagePaths <- maybe (fail $ "Invalid packages field: " ++ show stackConfig) return $+ JSON.parseMaybe JSON.parseJSON (stackConfig ! "packages")++ forM packagePaths $ \packagePath -> do+ packageDir <- case packagePath of+ -- special case since Path doesn't support `..`. Not spending too much effort on more complex+ -- cases+ ".." -> return $ Path.parent stackConfigDir+ package -> (stackConfigDir </>) <$> Path.parseRelDir package++ (_, files) <- listDir packageDir++ packageName <- case filter (hasExt ".cabal") files of+ [] -> fail $ "No .cabal file found in " ++ Path.toFilePath packageDir+ [cabal] -> Path.toFilePath . Path.filename <$> removeExtension cabal+ _ -> fail $ "Multiple .cabal files found in " ++ Path.toFilePath packageDir++ return (packageName, packageDir)++readStack :: [String] -> IO String+readStack args = do+ (_, stdout, _) <- readProcessWithExitCode "stack" args ""+ return . head . lines $ stdout++{- Utilities -}++hasExt :: String -> Path b File -> Bool+hasExt ext = (== ext') . Path.fileExtension+ where+#if MIN_VERSION_path(0,7,0)+ ext' = Just ext+#else+ ext' = ext+#endif++removeExtension :: Path b File -> IO (Path b File)+#if MIN_VERSION_path(0,7,0)+removeExtension = fmap fst . Path.splitExtension+#else+removeExtension = Path.setFileExtension ""+#endif
+ hpc-lcov.cabal view
@@ -0,0 +1,98 @@+cabal-version: >= 1.10++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: b79ca55a2aa6f2e6e21c1a0a8b3e7cd5351aa31bcdb45110c89044f6271aa51a++name: hpc-lcov+version: 1.0.0+synopsis: Convert HPC output into LCOV format+description: Convert HPC output into LCOV format.+category: Control+homepage: https://github.com/LeapYear/hpc-lcov#readme+bug-reports: https://github.com/LeapYear/hpc-lcov/issues+author: Brandon Chinn <brandon@leapyear.io>+maintainer: Brandon Chinn <brandon@leapyear.io>+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md+ test/golden/report_serialization.golden++source-repository head+ type: git+ location: https://github.com/LeapYear/hpc-lcov++library+ exposed-modules:+ Trace.Hpc.Lcov+ Trace.Hpc.Lcov.Report+ other-modules:+ Paths_hpc_lcov+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >=4.9 && <5+ , containers >=0.5.7.1 && <0.7+ , hpc >=0.6.0.3 && <0.7+ 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+ other-modules:+ Paths_hpc_lcov+ hs-source-dirs:+ exe+ ghc-options: -Wall+ build-depends:+ aeson >=1.1.2.0 && <1.5+ , 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+ , 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+ 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+ main-is: Main.hs+ other-modules:+ Lcov+ Report+ Paths_hpc_lcov+ hs-source-dirs:+ test+ ghc-options: -Wall+ build-depends:+ base >=4.9 && <5+ , containers >=0.5.7.1 && <0.7+ , hpc >=0.6.0.3 && <0.7+ , hpc-lcov+ , tasty+ , tasty-discover+ , tasty-golden+ , tasty-hunit+ 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
+ src/Trace/Hpc/Lcov.hs view
@@ -0,0 +1,103 @@+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.Util (HpcPos, fromHpcPos, toHash)++import Trace.Hpc.Lcov.Report++-- | Path to source file and entries from the corresponding .mix file.+type FileInfo = (FilePath, [MixEntry])++-- | Generate LCOV format from HPC coverage data.+generateLcovFromTix+ :: [(String, FileInfo)] -- ^ Mapping from module name to file info+ -> [TixModule]+ -> LcovReport+generateLcovFromTix moduleToMix = LcovReport . map mkFileReport . mergeTixModules+ where+ mkFileReport tixModule =+ let tickCounts = tixModuleTixs tixModule+ moduleName = tixModuleName tixModule+ (fileLoc, mixEntries) =+ fromMaybe+ (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+ }++-- | 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+ mergeTixs (TixModule moduleName hash len ticks1) (TixModule _ _ _ ticks2) =+ TixModule moduleName hash len $ zipWith (+) ticks1 ticks2++parseFunctionReport :: Integer -> MixEntry -> Maybe FunctionReport+parseFunctionReport tickCount (hpcPos, boxLabel) = mkFunctionReport <$> mFunctionName+ where+ mkFunctionReport names = FunctionReport+ { functionReportLine = hpcPosLine hpcPos+ , functionReportName = intercalate "$" names+ , functionReportHits = tickCount+ }++ mFunctionName = case boxLabel of+ TopLevelBox names -> Just names+ LocalBox names -> Just names+ _ -> Nothing++parseBranchReport :: Integer -> MixEntry -> Maybe (HpcPos, (Integer, Integer))+parseBranchReport tickCount (hpcPos, boxLabel) = case boxLabel of+ BinBox _ isTrue ->+ let branchHits = if isTrue then (tickCount, 0) else (0, tickCount)+ 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+ }++ 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+ }+ _ -> Nothing++mergeLineReports :: [LineReport] -> [LineReport]+mergeLineReports = Map.elems . Map.fromListWith (maxBy lineReportHits) . map (lineReportLine &&& id)++{- Utilities -}++hpcPosLine :: HpcPos -> Int+hpcPosLine = (\(startLine, _, _, _) -> startLine) . fromHpcPos++maxBy :: Ord b => (a -> b) -> a -> a -> a+maxBy f a b = maximumBy (comparing f) [a, b]
+ src/Trace/Hpc/Lcov/Report.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE RecordWildCards #-}++module Trace.Hpc.Lcov.Report+ ( LcovReport(..)+ , FileReport(..)+ , FunctionReport(..)+ , BranchReport(..)+ , LineReport(..)+ , writeReport+ , showReport+ ) where++import Data.List (intercalate)+import Data.Word (Word32)+import Trace.Hpc.Util (Hash)+import Unsafe.Coerce (unsafeCoerce)++-- http://ltp.sourceforge.net/coverage/lcov/geninfo.1.php+newtype LcovReport = LcovReport [FileReport]++data FileReport = FileReport+ { fileReportLocation :: FilePath+ , fileReportFunctions :: [FunctionReport] -- anything top level is considered a function+ , fileReportBranches :: [BranchReport]+ , fileReportLines :: [LineReport]+ } deriving (Show, Eq)++data FunctionReport = FunctionReport+ { functionReportLine :: Int+ , functionReportName :: String+ , functionReportHits :: Integer+ } deriving (Show, Eq)++data BranchReport = BranchReport+ { branchReportLine :: Int+ , branchReportHash :: Hash+ , branchReportTrueHits :: Integer+ , branchReportFalseHits :: Integer+ } deriving (Show, Eq)++data LineReport = LineReport+ { lineReportLine :: Int+ , lineReportHits :: Integer+ } deriving (Show, Eq)++writeReport :: FilePath -> LcovReport -> IO ()+writeReport fp = writeFile fp . showReport++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"]+ ]++ showFunctionDefinition FunctionReport{..} = line "FN" [show functionReportLine, functionReportName]++ showFunctionHits FunctionReport{..} = line "FNDA" [show functionReportHits, functionReportName]++ generateBranchReport BranchReport{..} =+ let branchHash = unsafeCoerce branchReportHash :: Word32+ mkBranchLine branchNum hits = line "BRDA"+ [ show branchReportLine+ , show branchHash+ , show (branchNum :: Int)+ , show hits+ ]+ in [mkBranchLine 0 branchReportTrueHits, mkBranchLine 1 branchReportFalseHits]++ showLineReport LineReport{..} = line "DA" [show lineReportLine, show lineReportHits]++ {- Helpers -}++ line :: String -> [String] -> String+ line label info = label ++ ":" ++ intercalate "," info++ countHits :: (a -> Integer) -> [a] -> String+ countHits f = show . length . filter ((> 0) . f)++ branchReportHits BranchReport{..} = branchReportTrueHits + branchReportFalseHits
+ test/Lcov.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Lcov where++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.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+ ]+ ]+ 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+ ]+ ]+ 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+ ]+ ]+ 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+ ]+ ]+ 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)+ ]+ ]+ [ 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 -}++mkTix :: String -> [Integer] -> TixModule+mkTix moduleName ticks = TixModule moduleName 0 (length ticks) ticks++mkModuleToMix :: String -> FilePath -> [(Int, BoxLabel)] -> (String, FileInfo)+mkModuleToMix moduleName filePath mixEntries = (moduleName, (filePath, mixs))+ where+ mixs = flip map mixEntries $ \(line, boxLabel) -> (getHpcPos line, boxLabel)++data TixMix = TixMix+ { tixMixModule :: String+ , tixMixFilePath :: FilePath+ , tixMixEntries :: [TixMixEntry]+ }++data TixMixEntry = TixMixEntry+ { tixMixEntryLine :: Int+ , tixMixBoxLabel :: BoxLabel+ , tixMixEntryTicks :: Integer+ }++generateLcovFromTixMix :: [TixMix] -> LcovReport+generateLcovFromTixMix = uncurry generateLcovFromTix . unzip . map fromTixMix+ where+ fromTixMix TixMix{..} =+ let toMixEntry (TixMixEntry line boxLabel _) = (line, boxLabel)+ moduleToMix = mkModuleToMix tixMixModule tixMixFilePath $ map toMixEntry tixMixEntries+ tix = mkTix tixMixModule $ map tixMixEntryTicks tixMixEntries+ in (moduleToMix, tix)++fromReport :: LcovReport -> [FileReport]+fromReport (LcovReport fileReports) = sortOn fileReportLocation fileReports++getHpcPos :: Int -> HpcPos+getHpcPos line = toHpcPos (line, 0, 0, 0)++getHash :: Int -> Hash+getHash = toHash . getHpcPos
+ test/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}
+ test/Report.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}++module Report where++import Data.String (fromString)+import Test.Tasty (TestTree)+import Test.Tasty.Golden (goldenVsString)++import Trace.Hpc.Lcov.Report++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+ }+ ]+ }+ ]
+ test/golden/report_serialization.golden view
@@ -0,0 +1,39 @@+TN:+SF:src/MyModule/Foo.hs+FN:1,foo1+FN:5,foo2+FNDA:0,foo1+FNDA:1,foo2+FNF:2+FNH:1+BRDA:1,100,0,10+BRDA:1,100,1,5+BRF:2+BRH:1+DA:1,10+LF:1+LH:1+end_of_record+TN:+SF:src/MyModule/Bar.hs+FNF:0+FNH:0+BRF:0+BRH:0+LF:0+LH:0+end_of_record+TN:+SF:src/MyModule/Bar/Baz.hs+FN:1,baz1+FNDA:10,baz1+FNF:1+FNH:1+BRDA:1,200,0,0+BRDA:1,200,1,0+BRF:2+BRH:0+DA:1,0+LF:1+LH:0+end_of_record