hpc-codecov (empty) → 0.1.0.0
raw patch · 14 files changed
+1005/−0 lines, 14 filesdep +arraydep +basedep +bytestringsetup-changedbinary-added
Dependencies added: array, base, bytestring, directory, filepath, hpc, hpc-codecov, tar, tasty, tasty-hunit
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- README.md +122/−0
- Setup.hs +2/−0
- exec/hpc-codecov.hs +1/−0
- hpc-codecov.cabal +72/−0
- src/Trace/Hpc/Codecov/Error.hs +78/−0
- src/Trace/Hpc/Codecov/Main.hs +31/−0
- src/Trace/Hpc/Codecov/Options.hs +186/−0
- src/Trace/Hpc/Codecov/Report.hs +314/−0
- test/Test/Main.hs +163/−0
- test/data/reciprocal.tar binary
- test/data/self.tar binary
- test/test-main.hs +1/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for hpc-codecov++## 0.1.0.0 -- 2020-02-08++Initial release.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2020, 8c6794b6++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of 8c6794b6 nor the names of other+ 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+OWNER 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,122 @@+hpc-codecov+===========++[](https://codecov.io/gh/8c6794b6/hpc-codecov)+[](https://travis-ci.org/8c6794b6/hpc-codecov)+[](https://circleci.com/gh/8c6794b6/hpc-codecov)+[](https://ci.appveyor.com/project/8c6794b6/hpc-codecov)++The ``hpc-codecov`` package contains an executable and library codes+for generating [Codecov](https://codecov.io) JSON coverage report from+``.tix`` and ``.mix`` files made with+[hpc](https://hackage.haskell.org/package/hpc).++The ``hpc-codecov`` executable does not try to find out the location+of ``.tix`` and ``mix`` files. Instead, let the user to explicitly+specify the file paths and directories. The rational behind the+decision is to support multiple versions of multiple build tools, such+as [cabal-install](http://hackage.haskell.org/package/cabal-install)+legacy v1-style build, v2-style build, and+[stack](https://docs.haskellstack.org/en/stable/README/).+++Examples+--------++Following shows two examples for generating test coverage report of+the ``hpc-codecov`` package itself, one with ``cabal-install``+Nix-style local build commands, and another with ``stack``.++### With cabal-install++First, run the tests with coverage option to generate ``.tix`` and+``mix`` files:++```console+$ cabal --version+cabal-install version 3.0.0.0+compiled using version 3.0.0.0 of the Cabal library+$ cabal v2-configure --enable-test --enable-coverage+$ cabal v2-test+```++Then generate a Codecov JSON coverage data from the ``.tix`` and+``.mix`` files:++```console+$ proj=hpc-codecov-0.1.0.0+$ tix=$(find ./dist-newstyle -name $proj.tix)+$ mix=$(find ./dist-newstyle -name vanilla -print -quit)/mix/$proj+$ hpc-codecov --mix=$mix --exclude=Paths_hpc_codecov --out=codecov.json $tix+```++The ``--out`` option specifies the output file to write the JSON+report. Observing the contents of ``codecov.json`` with+[``jq``](https://stedolan.github.io/jq/):++```console+$ jq . codecov.json | head -10+{+ "coverage": {+ "src/Trace/Hpc/Codecov/Error.hs": {+ "27": 1,+ "30": 1,+ "31": 1,+ "32": 1,+ "33": 1,+ "34": 1,+ "51": 0,+```++Send the resulting JSON report file to Codecov with the [bash+uploader](https://github.com/codecov/codecov-bash/). The file name+``codecov.json`` is listed in the uploader script as one of the file+name patterns to upload, no need to specify the report filename+explicitly:++```console+$ bash <(curl -s https://codecov.io/bash)+```++According to the Codecov+[FAQ](https://docs.codecov.io/docs/frequently-asked-questions), the+uploader should work from [Travis](https://travis-ci.org/),+[CircleCI](https://circleci.com/), and+[AppVeyor](https://www.appveyor.com/) for public projects without+Codecov token.+++### With stack++Build the package and run the tests with coverage option:++```console+$ stack --numeric-version+2.1.3+$ stack build --test --coverage+```++As done in ``cabal-install`` example, specify the path of ``.tix`` and+``.mix`` files. Using ``path`` sub-command to get the local hpc root+directory and dist directory:++```console+$ hpcroot=$(stack path --local-hpc-root)+$ tix=$(find $hpcroot -name 'test-main.tix')+$ mix=$(stack path --distdir)/hpc+$ hpc-codecov --mix=$mix --exclude=Paths_hpc_codecov -o codecov.json $tix+```++Then send the resulting report file:++```console+$ bash <(curl -s https://codecov.io/bash)+```+++References+----------++- [HPC publication](http://ittc.ku.edu/~andygill/papers/Hpc07.pdf)+- [Codecov API reference](https://docs.codecov.io/reference)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ exec/hpc-codecov.hs view
@@ -0,0 +1,1 @@+import Trace.Hpc.Codecov.Main
+ hpc-codecov.cabal view
@@ -0,0 +1,72 @@+cabal-version: 2.0+name: hpc-codecov+version: 0.1.0.0+synopsis: Generate codecov report from hpc data+license: BSD3+license-file: LICENSE+author: 8c6794b6+maintainer: 8c6794b6@gmail.com+homepage: https://github.com/8c6794b6/hpc-codecov#readme+copyright: (c) 2020 8c6794b6+category: Test, Data+build-type: Simple++description:+ The hpc-codecov package contains an executable and library codes for+ generating <https://codecov.io Codeocv> JSON coverage report from+ @.tix@ and @.mix@ files made with+ <https://hackage.haskell.org/package/hpc hpc>+ .+ See <https://github.com/8c6794b6/hpc-codecov#readme README> for+ more info.++extra-source-files:+ README.md+ CHANGELOG.md+ test/data/self.tar+ test/data/reciprocal.tar++library+ hs-source-dirs: src+ exposed-modules: Trace.Hpc.Codecov.Error+ Trace.Hpc.Codecov.Main+ Trace.Hpc.Codecov.Options+ Trace.Hpc.Codecov.Report+ Paths_hpc_codecov+ autogen-modules: Paths_hpc_codecov+ build-depends: base >= 4.10 && < 5+ , array >= 0.1 && < 0.6+ , bytestring >= 0.10 && < 0.11+ , directory >= 1.3.0 && < 1.4.0+ , filepath >= 1.4.1 && < 1.5+ , hpc >= 0.6 && < 0.7+ default-language: Haskell2010+ ghc-options: -Wall++executable hpc-codecov+ hs-source-dirs: exec+ main-is: hpc-codecov.hs+ build-depends: base+ , hpc-codecov+ default-language: Haskell2010+ ghc-options: -Wall -threaded -rtsopts++test-suite test-main+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: test-main.hs+ other-modules: Test.Main+ build-depends: base+ , directory+ , filepath+ , hpc-codecov+ --+ , tar >= 0.5 && < 0.6+ , tasty >= 1.0 && < 1.3+ , tasty-hunit >= 0.8 && < 1.0+ default-language: Haskell2010+ ghc-options: -Wall -threaded -rtsopts++source-repository head+ type: git+ location: https://github.com/8c6794b6/hpc-codecov.git
+ src/Trace/Hpc/Codecov/Error.hs view
@@ -0,0 +1,78 @@+-- |+-- Module: Trace.Hpc.Codecov.Error+-- Copyright: (c) 2020 8c6794b6+-- License: BSD3+-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>+--+-- Error and exception related codes.++module Trace.Hpc.Codecov.Error+ (+ -- * Exception data type and handler+ HpcCodecovError(..)+ , withBriefUsageOnError+ ) where++-- base+import Control.Exception (Exception (..), handle)+import System.Environment (getProgName)+import System.Exit (exitFailure)++-- | Run the given action with a handler for 'HpcCodecovError'.+--+-- The handler will show a brief usage and call 'exitFailure' when an+-- exception was caught.+withBriefUsageOnError :: IO a -- ^ Action to perform.+ -> IO a+withBriefUsageOnError = handle handler+ where+ handler :: HpcCodecovError -> IO a+ handler e =+ do putStr ("Error: " ++ displayException e)+ name <- getProgName+ putStrLn ("Run '" ++ name ++ " --help' for usage.")+ exitFailure++-- | Exceptions thrown during coverage report generation.+data HpcCodecovError+ = NoTixFile+ -- ^ Tix file path was not given.+ | TixNotFound FilePath+ -- ^ Tix file path was given, but not found.+ | MixNotFound FilePath [FilePath]+ -- ^ Mix file not found. The first field is the path specified by a+ -- tix file. The second is the searched paths.+ | SrcNotFound FilePath [FilePath]+ -- ^ Like 'MixNotFound', but for source code specified by a mix+ -- file.+ | InvalidArgs [String]+ -- ^ Some errors in command line argument, e.g., required value not+ -- specified.+ deriving (Show)++instance Exception HpcCodecovError where+ displayException = hpcCodecovErrorMessage++hpcCodecovErrorMessage :: HpcCodecovError -> String+hpcCodecovErrorMessage e =+ case e of+ NoTixFile -> "no .tix file given\n"+ TixNotFound tix -> "cannot find tix: " ++ show tix ++ "\n"+ MixNotFound mix locs -> searchedLocations "mix" mix locs+ SrcNotFound src locs -> searchedLocations "src" src locs+ InvalidArgs msgs ->+ case msgs of+ [x] -> x+ _ -> '\n' : concatMap (" - " ++) msgs++searchedLocations :: String -> FilePath -> [FilePath] -> String+searchedLocations what path locs =+ "cannot find " ++ what ++ ": " ++ show path ++ locs'+ where+ locs' =+ case locs of+ [_] -> searched ""+ _ -> searched "s"+ searched post =+ "\nsearched location" ++ post ++ ":\n" +++ unlines (map (" " ++) locs)
+ src/Trace/Hpc/Codecov/Main.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_HADDOCK hide #-}+-- |+-- Module: Trace.Hpc.Codecov.Main+-- Copyright: (c) 2020 8c6794b6+-- License: BSD3+-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>+--+-- Main function for @hpc-codecov@.+--+module Trace.Hpc.Codecov.Main (main) where++-- base+import Control.Exception (throwIO)+import System.Environment (getArgs)++-- Internal+import Trace.Hpc.Codecov.Error+import Trace.Hpc.Codecov.Options+import Trace.Hpc.Codecov.Report++-- | The main function for @hpc-codecov@ executable.+main :: IO ()+main = withBriefUsageOnError (getArgs >>= go)+ where+ go args =+ case parseOptions args of+ Right opts | optShowHelp opts -> printHelp+ | optShowVersion opts -> printVersion+ | optShowNumeric opts -> putStrLn versionString+ | otherwise -> genReport (opt2rpt opts)+ Left errs -> throwIO (InvalidArgs errs)
+ src/Trace/Hpc/Codecov/Options.hs view
@@ -0,0 +1,186 @@+{-# OPTIONS_HADDOCK hide #-}+-- |+-- Module: Trace.Hpc.Codecov.Options+-- Copyright: (c) 2020 8c6794b6+-- License: BSD3+-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>+--+-- Command line options for generating Codecov test coverage report.++module Trace.Hpc.Codecov.Options+ (+ -- * The Options type and predefined values+ Options(..)+ , defaultOptions+ , emptyOptions++ -- * Command line parser for 'Options'+ , parseOptions++ -- * Converter+ , opt2rpt++ -- * Help message and version number+ , printHelp+ , printVersion+ , versionString+ ) where++-- base+import Control.Exception (throw)+import Data.Version (showVersion)+import System.Console.GetOpt (ArgDescr (..), ArgOrder (..),+ OptDescr (..), getOpt, usageInfo)+import System.Environment (getProgName)++-- Internal+import Paths_hpc_codecov (version)+import Trace.Hpc.Codecov.Error+import Trace.Hpc.Codecov.Report++-- | Options for generating test coverage report.+data Options = Options+ { optTix :: FilePath+ -- ^ Input tix file.+ , optMixDirs :: [FilePath]+ -- ^ Directory containing mix files referred by the tix file.+ , optSrcDirs :: [FilePath]+ -- ^ Directory containing source codes referred by the mix files.+ , optExcludes :: [String]+ -- ^ Module name strings to exclude from coverage report.+ , optOutFile :: Maybe FilePath+ -- ^ Output file to write JSON report, if given.+ , optVerbose :: Bool+ -- ^ Flag for showing verbose message during coverage report+ -- generation.+ , optShowVersion :: Bool+ -- ^ Flag for showing version.+ , optShowNumeric :: Bool+ -- ^ Flag for showing numeric version.+ , optShowHelp :: Bool+ -- ^ Flag for showing help message.+ } deriving (Eq, Show)++-- | Empty 'Options'.+emptyOptions :: Options+emptyOptions = Options+ { optTix = throw NoTixFile+ , optMixDirs = []+ , optSrcDirs = []+ , optExcludes = []+ , optOutFile = Nothing+ , optVerbose = False+ , optShowVersion = False+ , optShowNumeric = False+ , optShowHelp = False+ }++-- | The default 'Options'.+defaultOptions :: Options+defaultOptions = emptyOptions+ { optMixDirs = [".hpc"]+ , optSrcDirs = [""]+ }++-- | Commandline option oracle.+options :: [OptDescr (Options -> Options)]+options =+ [ Option ['m'] ["mixdir"]+ (ReqArg (\d o -> o {optMixDirs = d : optMixDirs o})+ "DIR")+ ".mix file directory, can repeat\n\+ \default is .hpc"+ , Option ['s'] ["srcdir"]+ (ReqArg (\d o -> o {optSrcDirs = d : optSrcDirs o})+ "DIR")+ "source directory, can repeat\n\+ \default is current directory"+ , Option ['x'] ["exclude"]+ (ReqArg (\m o -> o {optExcludes = m : optExcludes o})+ "MODULE")+ "module name to exclude, can repeat"+ , Option ['o'] ["out"]+ (ReqArg (\p o -> o {optOutFile = Just p}) "FILE")+ "output file\n\+ \default is stdout"+ , Option ['v'] ["verbose"]+ (NoArg (\o -> o {optVerbose = True}))+ "show verbose output"+ , Option [] ["version"]+ (NoArg (\o -> o {optShowVersion = True}))+ "show versoin and exit"+ , Option [] ["numeric-version"]+ (NoArg (\o -> o {optShowNumeric = True}))+ "show numeric version and exit"+ , Option ['h'] ["help"]+ (NoArg (\o -> o {optShowHelp = True}))+ "show this help"+ ]++-- | Parse command line argument and return either error messages or+-- parsed 'Options'.+parseOptions :: [String] -- ^ Command line argument strings.+ -> Either [String] Options+parseOptions args =+ case getOpt Permute options args of+ (flags, rest, []) ->+ -- Not returning error messages with missing ".tix" file+ -- argument at this point, to show help and version messages+ -- without specifying ".tix" file.+ let opts0 = foldr (.) id flags $ emptyOptions+ opts1 = fillDefaultIfNotGiven opts0+ in case rest of+ [] -> Right opts1+ (tix:_) -> Right (opts1 {optTix = tix})+ (_, _, errs) -> Left errs++fillDefaultIfNotGiven :: Options -> Options+fillDefaultIfNotGiven opts = opts+ { optMixDirs = fillIf null optMixDirs+ , optSrcDirs = fillIf null optSrcDirs+ }+ where+ fillIf test fld =+ let orig = fld opts+ in if test orig+ then fld defaultOptions+ else orig++-- | Make a 'Report' value from 'Optoins'.+opt2rpt :: Options -> Report+opt2rpt opt = Report+ { reportTix = optTix opt+ , reportMixDirs = optMixDirs opt+ , reportSrcDirs = optSrcDirs opt+ , reportExcludes = optExcludes opt+ , reportOutFile = optOutFile opt+ , reportVerbose = optVerbose opt+ }++-- | Print help messages.+printHelp :: IO ()+printHelp = getProgName >>= putStrLn . helpMessage++-- | Print version number of this package.+printVersion :: IO ()+printVersion =+ do me <- getProgName+ putStrLn (me ++ " version " ++ versionString)++-- | Help message for command line output.+helpMessage :: String -- ^ Executable program name.+ -> String+helpMessage name = usageInfo header options+ where+ header = "\+\Generate Codecov JSON coverage report from .tix and .mix files\n\+\\n\+\Usage: \n\+\\n\+\ " ++ name ++ " [OPTIONS] TIX_FILE\n\+\\n\+\Options:\n"++-- | String representation of the version number of this package.+versionString :: String+versionString = showVersion version
+ src/Trace/Hpc/Codecov/Report.hs view
@@ -0,0 +1,314 @@+{-# LANGUAGE CPP #-}+-- |+-- Module: Trace.Hpc.Codecov.Report+-- Copyright: (c) 2020 8c6794b6+-- License: BSD3+-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>+--+-- Generate Codecov report data.++module Trace.Hpc.Codecov.Report+ ( -- * Types+ Report(..)+ , CoverageEntry(..)+ , LineHits+ , Hit(..)++ -- * Functions+ , genReport+ , genCoverageEntries+ , emitCoverageJSON+ ) where++-- base+import Control.Exception (ErrorCall, handle, throwIO)+import Control.Monad (when)+import Control.Monad.ST (ST)+import Data.List (foldl', intersperse)+import System.IO (IOMode (..), hPutStrLn, stderr, stdout,+ withFile)+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ((<>))+#endif++-- array+import Data.Array.Base (unsafeAt)+import Data.Array.IArray (bounds, listArray, range, (!))+import Data.Array.MArray (newArray, readArray, writeArray)+import Data.Array.ST (STUArray, runSTUArray)+import Data.Array.Unboxed (UArray)++-- bytestring+import Data.ByteString.Builder (Builder, char7, hPutBuilder, intDec,+ string7, stringUtf8)++-- directory+import System.Directory (doesFileExist)++-- filepath+import System.FilePath ((<.>), (</>))++-- hpc+import Trace.Hpc.Mix (BoxLabel (..), Mix (..), MixEntry, readMix)+import Trace.Hpc.Tix (Tix (..), TixModule (..), readTix)+import Trace.Hpc.Util (HpcPos, fromHpcPos)++-- Internal+import Trace.Hpc.Codecov.Error+-- import Trace.Hpc.Codecov.Options+++-- ------------------------------------------------------------------------+--+-- Exported+--+-- ------------------------------------------------------------------------++-- | Data type to hold information for generating test coverage+-- report.+data Report = Report+ { reportTix :: FilePath+ -- ^ Input tix file.+ , reportMixDirs :: [FilePath]+ -- ^ Directory containing mix files referred by the tix file.+ , reportSrcDirs :: [FilePath]+ -- ^ Directory containing source codes referred by the mix files.+ , reportExcludes :: [String]+ -- ^ Module name strings to exclude from coverage report.+ , reportOutFile :: Maybe FilePath+ -- ^ Output file to write JSON report, if given.+ , reportVerbose :: Bool+ -- ^ Flag for showing verbose message during report generation.+ } deriving (Eq, Show)++-- | Single file entry in coverage report.+--+-- See the+-- <https://docs.codecov.io/reference#section-codecov-json-report-format Codecov API>+-- for detail.+data CoverageEntry =+ CoverageEntry { ce_filename :: FilePath -- ^ Source code file name.+ , ce_hits :: LineHits -- ^ Line hits of the file.+ } deriving (Eq, Show)++-- | Pair of line number and hit tag.+type LineHits = [(Int, Hit)]++-- | Data type to represent coverage of source code line.+data Hit+ = Missed -- ^ The line is not covered at all.+ | Partial -- ^ The line is partially covered.+ | Full -- ^ The line is fully covered.+ deriving (Eq, Show)++-- | Generate report data from options.+genReport :: Report -> IO ()+genReport rpt =+ do entries <- genCoverageEntries rpt+ let mb_out = reportOutFile rpt+ oname = maybe "stdout" show mb_out+ say rpt ("Writing JSON report to " ++ oname)+ emitCoverageJSON mb_out entries+ say rpt "Done"++-- | Generate test coverage entries.+genCoverageEntries :: Report -> IO [CoverageEntry]+genCoverageEntries rpt =+ readTixFile rpt (reportTix rpt) >>= tixToCoverage rpt++-- | Emit simple coverage JSON data.+emitCoverageJSON ::+ Maybe FilePath -- ^ 'Just' output file name, or 'Nothing' for+ -- 'stdout'.+ -> [CoverageEntry] -- ^ Coverage entries to write.+ -> IO ()+emitCoverageJSON mb_outfile entries = wrap emit+ where+ wrap = maybe ($ stdout) (`withFile` WriteMode) mb_outfile+ emit = flip hPutBuilder (buildJSON entries)++-- | Build simple JSON report from coverage entries.+buildJSON :: [CoverageEntry] -> Builder+buildJSON entries = contents+ where+ contents =+ braced (key (string7 "coverage") <>+ braced (listify (map report entries))) <>+ char7 '\n'+ report ce =+ key (stringUtf8 (ce_filename ce)) <>+ braced (listify (map hit (ce_hits ce)))+ key x = dquote x <> char7 ':'+ dquote x = char7 '"' <> x <> char7 '"'+ braced x = char7 '{' <> x <> char7 '}'+ listify xs = mconcat (intersperse comma xs)+ comma = char7 ','+ hit (n, tag) =+ case tag of+ Missed -> k <> char7 '0'+ Partial -> k <> dquote (char7 '1' <> char7 '/' <> char7 '2')+ Full -> k <> char7 '1'+ where+ k = key (intDec n)++tixToCoverage :: Report -> Tix -> IO [CoverageEntry]+tixToCoverage rpt (Tix tms) = mapM (tixModuleToCoverage rpt)+ (excludeModules rpt tms)++tixModuleToCoverage :: Report -> TixModule -> IO CoverageEntry+tixModuleToCoverage rpt tm@(TixModule name _hash _count _ixs) =+ do say rpt ("Search mix: " ++ name)+ Mix path _ _ _ entries <- readMixFile (reportMixDirs rpt) tm+ say rpt ("Found mix: "++ path)+ let Info _ min_line max_line hits = makeInfo tm entries+ lineHits = makeLineHits min_line max_line hits+ path' <- ensureSrcPath rpt path+ return (CoverageEntry { ce_filename = path'+ , ce_hits = lineHits })+++-- ------------------------------------------------------------------------+--+-- Internal+--+-- ------------------------------------------------------------------------++-- | Exclude modules specified in given 'Report'.+excludeModules :: Report -> [TixModule] -> [TixModule]+excludeModules rpt = filter exclude+ where+ exclude (TixModule pkg_slash_name _ _ _) =+ let modname = case break (== '/') pkg_slash_name of+ (_, '/':name) -> name+ (name, _) -> name+ in notElem modname (reportExcludes rpt)++-- | Read tix file from file path, return a 'Tix' data or throw+-- a 'TixNotFound' exception.+readTixFile :: Report -> FilePath -> IO Tix+readTixFile rpt path =+ do mb_tix <- readTix path+ case mb_tix of+ Nothing -> throwIO (TixNotFound path)+ Just tix -> say rpt ("Found tix file: " ++ path) >> return tix++-- | Search mix file under given directories, return a 'Mix' data or+-- throw a 'MixNotFound' exception.+readMixFile :: [FilePath] -> TixModule -> IO Mix+readMixFile dirs tm@(TixModule name _h _c _i) =+ handle handler (readMix dirs (Right tm))+ where+ handler :: ErrorCall -> IO a+ handler _ = throwIO (MixNotFound name dirs')+ dirs' = map (</> (name <.> "mix")) dirs++-- | Ensure the given source file exist, return the ensured 'FilePath'+-- or throw a 'SrcNotFound' exception.+ensureSrcPath :: Report -> FilePath -> IO FilePath+ensureSrcPath rpt path = go [] (reportSrcDirs rpt)+ where+ go acc [] = throwIO (SrcNotFound path acc)+ go acc (dir:dirs) =+ do let path' = dir </> path+ exist <- doesFileExist path'+ if exist+ then do say rpt ("Found source: " ++ path')+ return path'+ else go (path':acc) dirs++-- | Print given message to 'stderr' when the verbose flag is 'True'.+say :: Report -> String -> IO ()+say rpt msg = when (reportVerbose rpt) (hPutStrLn stderr msg)++-- | Internal type synonym to represent code line hit.+type Tick = Int++-- | Internal type used for accumulating mix entries.+data Info =+ Info {-# UNPACK #-} !Int -- ^ Index count+ {-# UNPACK #-} !Int -- ^ Min line number+ {-# UNPACK #-} !Int -- ^ Max line number+ ![(HpcPos, Tick)] -- ^ Pair of position and hit++-- | Make line hits from intermediate info.+makeLineHits :: Int -> Int -> [(HpcPos, Tick)] -> LineHits+makeLineHits min_line max_line hits = ticksToHits (runSTUArray work)+ where+ work =+ do arr <- newArray (min_line, max_line) ignored+ mapM_ (updateHit arr) hits+ return arr+ updateHit arr (pos, hit) =+ let (ls, _, _, _) = fromHpcPos pos+ in updateOne arr hit ls+ updateOne :: STUArray s Int Int -> Tick -> Int -> ST s ()+ updateOne arr hit i =+ do prev <- readArray arr i+ writeArray arr i (mergeEntry prev hit)+ mergeEntry prev hit+ | isIgnored prev = hit+ | isMissed prev, isMissed hit = missed+ | isFull prev, isFull hit = full+ | otherwise = partial++-- | Convert array of ticks to list of hits.+ticksToHits :: UArray Int Tick -> LineHits+ticksToHits arr = foldr f [] (range (bounds arr))+ where+ f i acc =+ case arr ! i of+ tck | isIgnored tck -> acc+ | isMissed tck -> (i, Missed) : acc+ | isFull tck -> (i, Full) : acc+ | otherwise -> (i, Partial) : acc++ignored, missed, partial, full :: Tick+ignored = -1+missed = 0+partial = 1+full = 2++isIgnored :: Int -> Bool+isIgnored = (== ignored)++isMissed :: Int -> Bool+isMissed = (== missed)++isFull :: Int -> Bool+isFull = (== full)++notTicked, tickedOnlyTrue, tickedOnlyFalse, ticked :: Tick+notTicked = missed+tickedOnlyTrue = partial+tickedOnlyFalse = partial+ticked = full++-- See also: "utils/hpc/HpcMarkup.hs" in "ghc" git repository.+makeInfo :: TixModule -> [MixEntry] -> Info+makeInfo tm = foldl' f z+ where+ z = Info 0 maxBound 0 []+ f (Info i min_line max_line acc) (pos, boxLabel) =+ let binBox = case (isTicked i, isTicked (i+1)) of+ (False, False) -> acc+ (True, False) -> (pos, tickedOnlyTrue) : acc+ (False, True) -> (pos, tickedOnlyFalse) : acc+ (True, True) -> acc+ tickBox = if isTicked i+ then (pos, ticked) : acc+ else (pos, notTicked) : acc+ acc' = case boxLabel of+ ExpBox {} -> tickBox+ TopLevelBox {} -> tickBox+ LocalBox {} -> tickBox+ BinBox _ True -> binBox+ _ -> acc+ (ls, _, le, _) = fromHpcPos pos+ in Info (i+1) (min ls min_line) (max le max_line) acc'++ -- Hope that mix file does not contain out of bound index.+ isTicked n = unsafeAt arr_tix n /= 0++ arr_tix :: UArray Int Int+ arr_tix = listArray (0, size - 1) (map fromIntegral tixs)+ TixModule _name _hash size tixs = tm
+ test/Test/Main.hs view
@@ -0,0 +1,163 @@+-- | Test codes for running @hpc-codecov@ executable.+module Test.Main (main) where++-- base+import Control.Exception (SomeException (..), try)+import System.Environment (withArgs)+import System.IO (hClose, openTempFile)++-- filepath+import System.FilePath (dropExtension, (<.>), (</>))++-- directory+import System.Directory (removeDirectoryRecursive,+ removeFile)++-- tar+import Codec.Archive.Tar (extract)++-- tasty+import Test.Tasty (TestTree, defaultMain,+ testGroup, withResource)+import Test.Tasty.HUnit++-- Internal+import qualified Trace.Hpc.Codecov.Main as HpcCodecov+import Trace.Hpc.Codecov.Options+++-- ------------------------------------------------------------------------+--+-- Tests+--+-- ------------------------------------------------------------------------++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests =+ testGroup "main"+ [ cmdline+ , withTestTarData "self.tar" selfReport+ , withTestTarData "reciprocal.tar" recipReport+ ]++cmdline :: TestTree+cmdline = testGroup "cmdline"+ [ testCase "non-existing-option"+ (shouldFail (main' ["--foo"]))+ , testCase "non-existing-options"+ (shouldFail (main' ["--foo", "--bar", "--buzz"]))+ , testCase "mixdir-without-argument"+ (shouldFail (main' ["--mixdir"]))+ , testCase "no-tix-file"+ (shouldFail (main' []))+ , testCase "non-existing-tix"+ (shouldFail (main' ["no_such_file.tix"]))+ , testCase "help" (main' ["--help"])+ , testCase "version" (main' ["--version"])+ , testCase "numeric-version" (main' ["--numeric-version"])+ ]++selfReport :: TestTree+selfReport = testGroup "self"+ [ testCase "self-data-to-stdout"+ (main' selfHpcDataArgs)+ , testCase "self-data-to-stdout-verbose"+ (main' ("--verbose":selfHpcDataArgs))+ , withTempFile+ (\getPath ->+ testCase "self-data-to-file-verbose"+ (do path <- getPath+ main' (["--out=" ++ path, "--verbose"] +++ selfHpcDataArgs)))+ , testCase "self-data-no-mix-none"+ (shouldFail (main' [selfTix]))+ , testCase "self-data-no-mix-one"+ (shouldFail (main' ["--mix=foo", selfTix]))+ , testCase "self-data-no-all-two"+ (shouldFail (main' ["--mix=foo", "--mix=bar", selfTix]))+ ]++recipReport :: TestTree+recipReport = testGroup "recip"+ [ testCase "recip-data-to-stdout"+ (main' ["--mix=test/data/reciprocal/.hpc"+ ,"--src=test/data/reciprocal"+ ,"--exclude=NoSuchModule"+ ,"--verbose"+ ,"test/data/reciprocal/reciprocal.tix"])+ , testCase "recip-data-no-src"+ (shouldFail+ (main' ["--mix=test/data/reciprocal/.hpc"+ ,"--src=test/"+ ,"--src=test/data"+ ,"--verbose"+ ,"test/data/reciprocal/reciprocal.tix"]))+ ]++-- ------------------------------------------------------------------------+--+-- Auxiliary functions+--+-- ------------------------------------------------------------------------++-- | Wrapper to run 'Trace.Hpc.Codecov.Main.main' with given argument+-- strings.+main' :: [String] -> IO ()+main' args = withArgs args HpcCodecov.main++-- | Run given test with mix and tix files of tar file.+--+-- The mix and tix packages are archived as 'test/data/XXX.tar' and+-- added as extra source file in cabal configuration. Unpacked tar+-- contents are removed after running given tests.+withTestTarData :: String -- ^ Tar file name under 'testDataDir'+ -> TestTree -- ^ Test using the tar contents+ -> TestTree+withTestTarData dot_tar tt = withResource acquire release (const tt)+ where+ acquire = do extract testDataDir (testDataDir </> dot_tar)+ return (testDataDir </> dropExtension dot_tar)+ release = removeDirectoryRecursive++-- | Run test with path to temporary file.+withTempFile :: (IO FilePath -> TestTree) -> TestTree+withTempFile = withResource acquire release+ where+ acquire = do (path,hdl) <- openTempFile "." "test.tmp"+ hClose hdl+ return path+ release path = removeFile path++-- | My package name+me :: String+me = "hpc-codecov-" ++ versionString++-- | Directory path of extracted @self.tar@.+selfDir :: FilePath+selfDir = testDataDir </> "self"++-- | Relative path of tix file in @self.tar@ from project root.+selfTix :: FilePath+selfTix = selfDir </> "tix" </> me </> me <.> "tix"++-- | Arguments for running test with @self.tar@ contents.+selfHpcDataArgs :: [String]+selfHpcDataArgs =+ let mix = selfDir </> "mix" </> me+ in ["--mix=" ++ mix, "--exclude=Paths_hpc_codecov", selfTix]++-- | Directory containing test data.+testDataDir :: FilePath+testDataDir = "test" </> "data"++-- | Pass the HUnit test when an exception was thrown, otherwise a+-- test failure.+shouldFail :: IO a -> IO ()+shouldFail act =+ do et_err <- try act+ case et_err of+ Left (SomeException {}) -> return ()+ _ -> assertFailure "should fail"
+ test/data/reciprocal.tar view
binary file changed (absent → 10240 bytes)
+ test/data/self.tar view
binary file changed (absent → 51200 bytes)
+ test/test-main.hs view
@@ -0,0 +1,1 @@+import Test.Main