hpc-codecov 0.4.2.0 → 0.5.0.0
raw patch · 18 files changed
+1134/−558 lines, 18 filesdep +tasty-goldendep ~arraydep ~basedep ~hpcPVP ok
version bump matches the API change (PVP)
Dependencies added: tasty-golden
Dependency ranges changed: array, base, hpc, time
API changes (from Hackage documentation)
- Trace.Hpc.Codecov.Exception: withBriefUsageOnError :: IO a -> IO a
- Trace.Hpc.Codecov.Report: instance GHC.Base.Monoid Trace.Hpc.Codecov.Report.Report
- Trace.Hpc.Codecov.Report: instance GHC.Base.Semigroup Trace.Hpc.Codecov.Report.Report
- Trace.Hpc.Codecov.Report: instance GHC.Classes.Eq Trace.Hpc.Codecov.Report.CoverageEntry
- Trace.Hpc.Codecov.Report: instance GHC.Classes.Eq Trace.Hpc.Codecov.Report.Format
- Trace.Hpc.Codecov.Report: instance GHC.Classes.Eq Trace.Hpc.Codecov.Report.Hit
- Trace.Hpc.Codecov.Report: instance GHC.Classes.Eq Trace.Hpc.Codecov.Report.Report
- Trace.Hpc.Codecov.Report: instance GHC.Show.Show Trace.Hpc.Codecov.Report.CoverageEntry
- Trace.Hpc.Codecov.Report: instance GHC.Show.Show Trace.Hpc.Codecov.Report.Format
- Trace.Hpc.Codecov.Report: instance GHC.Show.Show Trace.Hpc.Codecov.Report.Hit
- Trace.Hpc.Codecov.Report: instance GHC.Show.Show Trace.Hpc.Codecov.Report.Report
+ Trace.Hpc.Codecov.Report: Cobertura :: Format
Files
- CHANGELOG.md +21/−2
- README.md +36/−15
- hpc-codecov.cabal +21/−17
- src/Trace/Hpc/Codecov/Exception.hs +2/−20
- src/Trace/Hpc/Codecov/Main.hs +12/−4
- src/Trace/Hpc/Codecov/Options.hs +43/−20
- src/Trace/Hpc/Codecov/Parser.hs +31/−23
- src/Trace/Hpc/Codecov/Report.hs +13/−430
- src/Trace/Hpc/Codecov/Report/Emit.hs +424/−0
- src/Trace/Hpc/Codecov/Report/Entry.hs +370/−0
- test/Test/Main.hs +120/−23
- test/data/project1/project1.cabal +4/−3
- test/data/project1/src/Lib.hs +6/−0
- test/data/project1/src/Lib/Bar.hs +13/−0
- test/data/project1/src/Lib/Bar/Buzz.hs +7/−0
- test/data/project1/src/Lib/Foo.hs +7/−0
- test/data/project1/stack.yaml +1/−1
- test/data/project1/test/Spec.hs +3/−0
CHANGELOG.md view
@@ -1,7 +1,26 @@ # Revision history for hpc-codecov -## 0.4.1.0 -- 2023-09+## 0.5.0.0 -- 2023-11-01 +- Add Cobertura XML format for the generated report with+ "--format=cobertura" option.++- Modify "readMix'" to fill in the field of Mix values with the+ timestamp in a .mix file instead of a dummy value.++- Drop support for GHC < 8.10.++- Slightly tidy up the help message.++## 0.4.2.0 -- 2023-10-18++- Support GHC 9.8.1.++- Update package dependency version bound for the ``bytestring``+ package.++## 0.4.1.0 -- 2023-09-17+ - Update package dependency version bound for the ``hpc`` and ``tasty`` packages. @@ -31,7 +50,7 @@ ## 0.2.0.2 -- 2021-03-25 -Minor modification to support ghc 9.0.1.+Minor modification to support GHC 9.0.1. CI configuration update to manage git repository.
README.md view
@@ -6,9 +6,10 @@ [](https://github.com/8c6794b6/hpc-codecov/actions/workflows/ci.yml) The ``hpc-codecov`` package contains an executable and library codes-for generating [Codecov](https://codecov.io) JSON coverage report or-[LCOV](https://github.com/linux-test-project/lcov) tracefile report-from ``.tix`` and ``.mix`` files made with+for generating [Codecov](https://codecov.io) JSON coverage report,+[LCOV](https://github.com/linux-test-project/lcov) tracefile report,+or [Cobertura](https://cobertura.github.io/cobertura/) XML report from+``.tix`` and ``.mix`` files made with [hpc](https://hackage.haskell.org/package/hpc). The generated report is ready to be uploaded to Codecov with other tools such as [Codecov uploader](https://docs.codecov.com/docs/codecov-uploader).@@ -53,7 +54,7 @@ QuickStart ---------- -To illustrate an example, initializing sample project named+To illustrate an example, initializing a sample project named ``my-project`` with ``cabal-install``: ```console@@ -63,7 +64,7 @@ $ cabal init --simple --tests --test-dir=test -p my-project ``` -Directory contents look like below:+The directory contents look like below: ```console .@@ -73,7 +74,7 @@ ├── my-project.cabal ├── src │ └── MyLib.hs-└── tests+└── test └── MyLibTest.hs ``` @@ -118,8 +119,8 @@ ### Project using cabal-install -Search under directory made by ``cabal-install`` , generating a report-for test suite named ``my-project-test``. Skip searching under the+Search under the directory made by ``cabal-install``, generating a report+for a test suite named ``my-project-test``. Skip searching under the directories with base name ``my-project``, and exclude modules named ``Main`` and ``Paths_my_project`` from the report. Note the use of comma to separate multiple values for the ``-x`` option:@@ -130,7 +131,7 @@ ### Project using stack -Search under directory made by ``stack`` for test suite named+Search under the directory made by ``stack`` for a test suite named ``my-project-test``, show verbose information, and write output to ``codecov.json``: @@ -140,7 +141,7 @@ ### Project using stack, with multiple packages -Search under directory made by ``stack`` for combined report of+Search under the directory made by ``stack`` for a combined report of multiple cabal packages, and write output to ``codecov.json``: ```consle@@ -149,15 +150,33 @@ ### Project using stack, with multiple packages, generate LCOV tracefile -Search under directory made by ``stack`` for combined report of-multiple cabal packages, and write output report in LCOV tracefile+Search under the directory made by ``stack`` for a combined report of+multiple cabal packages, and write the output report in LCOV tracefile format to ``lcov.info``: ```consle $ hpc-codecov stack:all -f lcov -o lcov.info ``` +### Project using stack, with multiple packages, generate Cobertura XML file +Search under the directory made by ``stack`` for a combined report of+multiple cabal packages, and write output report in Cobertura XML+format to ``coverage.xml``:++```consle+$ hpc-codecov stack:all -f cobertura -o coverage.xml+```++### Project using stack, running via Docker++Search under the directory made by ``stack`` for a combined report of+multiple cabal packages, running via Docker:++```+$ docker run --rm -v $PWD:$PWD ghcr.io/8c6794b6/hpc-codecov /hpc-codecov -r $PWD stack:all+```+ Low-level examples ------------------ @@ -168,7 +187,7 @@ ### With cabal-install -First, run the tests with coverage option to generate ``.tix`` and+First, run the tests with the coverage option to generate ``.tix`` and ``mix`` files: ```console@@ -229,7 +248,7 @@ ### With stack -Build the package and run the tests with coverage option:+Build the package and run the tests with the coverage option: ```console $ stack --numeric-version@@ -238,7 +257,7 @@ ``` As done in ``cabal-install`` example, specify the path of ``.tix`` and-``.mix`` files. Using ``path`` sub-command to get the local hpc root+``.mix`` files. Using the ``path`` sub-command to get the local hpc root directory and dist directory: ```console@@ -254,3 +273,5 @@ - [HPC publication](http://ittc.ku.edu/~andygill/papers/Hpc07.pdf) - [Codecov API reference](https://docs.codecov.io/reference)+- [LCOV](https://github.com/linux-test-project/lcov)+- [Cobertura](https://cobertura.github.io/cobertura/)
hpc-codecov.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.0 name: hpc-codecov-version: 0.4.2.0-synopsis: Generate codecov report from hpc data+version: 0.5.0.0+synopsis: Generate reports from hpc data license: BSD3 license-file: LICENSE author: 8c6794b6@@ -13,12 +13,13 @@ description: The hpc-codecov package contains an executable and library codes for- generating <https://codecov.io Codeocv> JSON coverage report or- <https://github.com/linux-test-project/lcov LCOV> tracefile report+ generating <https://codecov.io Codeocv> JSON coverage report,+ <https://github.com/linux-test-project/lcov LCOV> tracefile report,+ or <https://cobertura.github.io/cobertura/ Cobertura> XML report from @.tix@ and @.mix@ files made with <https://hackage.haskell.org/package/hpc hpc>. See the- <https://github.com/8c6794b6/hpc-codecov#readme README> for- more info.+ <https://github.com/8c6794b6/hpc-codecov#readme README> for more+ info. extra-doc-files: README.md@@ -36,15 +37,14 @@ test/data/project1/app/Main.hs test/data/project1/package.yaml test/data/project1/src/Lib.hs+ test/data/project1/src/Lib/Foo.hs+ test/data/project1/src/Lib/Bar.hs+ test/data/project1/src/Lib/Bar/Buzz.hs test/data/project1/test/Spec.hs test/data/project1/project1.cabal test/data/project1/stack.yaml -tested-with: GHC == 8.2.2- , GHC == 8.4.4- , GHC == 8.6.5- , GHC == 8.8.4- , GHC == 8.10.7+tested-with: GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.8 , GHC == 9.4.7@@ -59,16 +59,18 @@ Trace.Hpc.Codecov.Parser Trace.Hpc.Codecov.Report other-modules: Trace.Hpc.Codecov.Options+ Trace.Hpc.Codecov.Report.Emit+ Trace.Hpc.Codecov.Report.Entry Paths_hpc_codecov autogen-modules: Paths_hpc_codecov- build-depends: base >= 4.10 && < 5- , array >= 0.1 && < 0.6+ build-depends: base >= 4.14 && < 5+ , array >= 0.5 && < 0.6 , bytestring >= 0.10 && < 0.13 , containers >= 0.6 && < 0.8 , directory >= 1.3.0 && < 1.4.0 , filepath >= 1.4.1 && < 1.5 , hpc >= 0.6 && < 0.8- , time >= 1.8 && < 1.13+ , time >= 1.9 && < 1.13 default-language: Haskell2010 ghc-options: -Wall @@ -88,11 +90,13 @@ build-depends: base , directory , filepath+ , hpc , hpc-codecov --- , process >= 1.6 && < 1.7- , tasty >= 1.4 && < 1.6- , tasty-hunit >= 0.8 && < 1.0+ , process >= 1.6 && < 1.7+ , tasty >= 1.4 && < 1.6+ , tasty-golden >= 2.3 && < 2.5+ , tasty-hunit >= 0.8 && < 1.0 default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts
src/Trace/Hpc/Codecov/Exception.hs view
@@ -8,30 +8,12 @@ module Trace.Hpc.Codecov.Exception (- -- * Exception data type and handler+ -- * Exception data type 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+import Control.Exception (Exception (..)) -- | Exceptions thrown during coverage report generation. data HpcCodecovError
src/Trace/Hpc/Codecov/Main.hs view
@@ -9,8 +9,9 @@ module Trace.Hpc.Codecov.Main (defaultMain) where -- base-import Control.Exception (throwIO)-import System.Environment (getArgs)+import Control.Exception (Exception (..), handle, throwIO)+import System.Environment (getArgs, getProgName)+import System.Exit (exitFailure) -- Internal import Trace.Hpc.Codecov.Exception@@ -19,12 +20,19 @@ -- | The main function for @hpc-codecov@ executable. defaultMain :: IO ()-defaultMain = withBriefUsageOnError (getArgs >>= go)+defaultMain = handle handler (getArgs >>= go) where go args = case parseOptions args of Right opts | optShowHelp opts -> printHelp | optShowVersion opts -> printVersion- | optShowNumeric opts -> putStrLn versionString+ | optShowNumeric opts -> printNumericVersion | otherwise -> opt2rpt opts >>= genReport Left errs -> throwIO (InvalidArgs errs)++ handler :: HpcCodecovError -> IO a+ handler e =+ do putStr ("Error: " ++ displayException e)+ name <- getProgName+ putStrLn ("Run '" ++ name ++ " --help' for usage.")+ exitFailure
src/Trace/Hpc/Codecov/Options.hs view
@@ -23,7 +23,7 @@ -- * Help message and version number , printHelp , printVersion- , versionString+ , printNumericVersion ) where -- base@@ -32,6 +32,7 @@ import System.Console.GetOpt (ArgDescr (..), ArgOrder (..), OptDescr (..), getOpt, usageInfo) import System.Environment (getProgName)+import System.IO (hIsTerminalDevice, stdout) -- directory import System.Directory (doesFileExist)@@ -149,7 +150,7 @@ (ReqArg (\s o -> o {optFormat = s}) "FMT") "Format of generated report\n\- \'codecov' or 'lcov'\n\+ \'codecov', 'lcov', or 'cobertura'\n\ \(default: codecov)" , Option ['v'] ["verbose"]@@ -215,9 +216,10 @@ parseFormat :: String -> IO Format parseFormat fmt = case fmt of- "codecov" -> pure Codecov- "lcov" -> pure Lcov- _ -> throwIO $ InvalidFormat fmt+ "codecov" -> pure Codecov+ "lcov" -> pure Lcov+ "cobertura" -> pure Cobertura+ _ -> throwIO $ InvalidFormat fmt uncommas :: String -> [String] uncommas = go@@ -256,36 +258,57 @@ -- | Print help messages. printHelp :: IO ()-printHelp = getProgName >>= putStrLn . helpMessage+printHelp = do+ me <- getProgName+ is_terminal <- hIsTerminalDevice stdout+ putStrLn $ helpMessage is_terminal me -- | Print version number of this package. printVersion :: IO ()-printVersion =- do me <- getProgName- putStrLn (me ++ " version " ++ versionString)+printVersion = do+ me <- getProgName+ putStrLn (me ++ " version " ++ versionString) +-- | Print numeriv version number of this package.+printNumericVersion :: IO ()+printNumericVersion = putStrLn versionString++boldUnderline :: Bool -> String -> String+boldUnderline is_terminal str+ | is_terminal = "\ESC[1m\ESC[4m" ++ str ++ "\ESC[0m"+ | otherwise = str++bold :: Bool -> String -> String+bold is_terminal str+ | is_terminal = "\ESC[1m" ++ str ++ "\ESC[0m"+ | otherwise = str+ -- | Help message for command line output.-helpMessage :: String -- ^ Executable program name.+helpMessage :: Bool -- ^ 'True' when showing in a terminal.+ -> String -- ^ Executable program name. -> String-helpMessage name = usageInfo header options ++ footer+helpMessage is_terminal name = usageInfo header options ++ footer where- header = "USAGE: " ++ name ++ " [OPTIONS] TARGET\n\+ b = bold is_terminal+ bu = boldUnderline is_terminal+ header = "A tool to generate reports from .tix and .mix files\n\ \\n\-\Generate Codecov JSON coverage report for Haskell source codes\n\-\from .tix and .mix files made with hpc.\n\+\" ++ bu "USAGE:" ++ " " ++ b name ++ " [OPTIONS] TARGET\n\ \\n\-\TARGET is either a path to .tix file or 'TOOL:TEST_SUITE'.\n\-\Supported TOOL values are 'stack' and 'cabal'. When the TOOL is\n\-\'stack' and building project with multiple packages, use 'all' as\n\-\TEST_SUITE value to refer the combined report.\n\+\" ++ bu "ARGUMENTS:" ++ "\n\+\ <TARGET> Either a path to a .tix file or a 'TOOL:TEST_SUITE'.\n\+\ Supported TOOL values are 'stack' and 'cabal'.\n\+\ When the TOOL is 'stack' and building a project with\n\+\ multiple packages, use 'all' as the TEST_SUITE value\n\+\ to specify the combined report.\n\ \\n\-\OPTIONS:\n"+\" ++ bu "OPTIONS:" footer = "\ \\n\ \For more info, see:\n\ \\n\ \ https://github.com/8c6794b6/hpc-codecov#readme\n\-\\n"+\" -- | String representation of the version number of this package. versionString :: String
src/Trace/Hpc/Codecov/Parser.hs view
@@ -16,29 +16,28 @@ ) where -- base-import Control.Applicative (Alternative (..))-import Data.Functor (($>))-import Prelude hiding (takeWhile)+import Control.Applicative (Alternative (..))+import Data.Functor (($>))+import Prelude hiding (takeWhile) -- bytestring-import Data.ByteString.Char8 (ByteString)-import qualified Data.ByteString.Char8 as BS+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as BS -- filepath-import System.FilePath ((<.>), (</>))+import System.FilePath ((<.>), (</>)) -- hpc-import Trace.Hpc.Mix (BoxLabel (..),- CondBox (..), Mix (..),- MixEntry)-import Trace.Hpc.Tix (Tix (..), TixModule (..),- tixModuleName)-import Trace.Hpc.Util (HpcHash (..), HpcPos,- catchIO, toHpcPos)+import Trace.Hpc.Mix (BoxLabel (..), CondBox (..),+ Mix (..), MixEntry)+import Trace.Hpc.Tix (Tix (..), TixModule (..),+ tixModuleName)+import Trace.Hpc.Util (HpcHash (..), HpcPos, catchIO,+ toHpcPos) -- time-import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)-import Data.Time.Clock (UTCTime (..))+import Data.Time.Clock (UTCTime (..))+import Data.Time.Format (defaultTimeLocale, parseTimeM) -- ------------------------------------------------------------------------@@ -57,9 +56,6 @@ -- -- This function is similar to 'Trace.Hpc.Mix.readMix', but internally -- uses 'ByteString' to improve performance.------ __NOTE__: At the moment, the 'UTCTime' field in the parsed 'Mix' is--- constantly filled with dummy value, to avoid parsing date time. readMix' :: [String] -- ^ Dir names -> Either String TixModule -- ^ module wanted@@ -115,6 +111,10 @@ runMaybeP :: P a -> ByteString -> Maybe a runMaybeP p = runP p (const Nothing) (\a _ -> Just a) +failP :: String -> P a+failP msg = P (\err _ _ -> err msg)+{-# INLINABLE failP #-}+ char :: Char -> P () char c = P (\err ok bs ->@@ -218,13 +218,21 @@ parseMix = do bytes "Mix" *> spaces path <- string <* spaces- _year <- takeWhile (/= ' ') <* spaces- _time <- takeWhile (/= ' ') <* spaces- _zone <- takeWhile (/= ' ') <* spaces+ ts <- timestamp hash <- fmap toHash int <* spaces tabstop <- int <* spaces- let dummy_date = UTCTime (fromOrdinalDate 1900 1) 0- Mix path dummy_date hash tabstop <$> mixEntries+ Mix path ts hash tabstop <$> mixEntries++timestamp :: P UTCTime+timestamp = do+ yyyy_mm_dd <- takeWhile (/= ' ') <* spaces+ hh_mm_ss_ps <- takeWhile (/= ' ') <* spaces+ _tz <- bytes "UTC" <* spaces+ let utc_str = BS.unpack (mconcat [yyyy_mm_dd, BS.pack " ", hh_mm_ss_ps])+ case parseTimeM True defaultTimeLocale "%F %T%Q" utc_str of+ Just utc_time -> pure utc_time+ Nothing -> failP "timestamp: failed to parse UTC time"+{-# INLINABLE timestamp #-} mixEntries :: P [MixEntry] mixEntries = bracketed (sepBy mixEntry comma)
src/Trace/Hpc/Codecov/Report.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} -- | -- Module: Trace.Hpc.Codecov.Report -- Copyright: (c) 2022 8c6794b6@@ -24,45 +23,16 @@ ) where -- base-import Control.Exception (ErrorCall, handle, throw, throwIO)-import Control.Monad (mplus, when)-import Control.Monad.ST (ST)-import Data.Function (on)-import Data.List (foldl', intercalate, 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 (assocs, listArray)-import Data.Array.MArray (newArray, readArray, writeArray)-import Data.Array.ST (STArray, runSTArray)-import Data.Array.Unboxed (UArray)+import Control.Monad (when)+import System.IO (IOMode (..), hPutStrLn, stderr,+ stdout, withFile) -- bytestring-import Data.ByteString.Builder (Builder, char7, hPutBuilder, intDec,- string7, stringUtf8)---- containers-import Data.IntMap (insertLookupWithKey)---- directory-import System.Directory (doesFileExist)---- filepath-import System.FilePath ((<.>), (</>))---- hpc-import Trace.Hpc.Mix (BoxLabel (..), Mix (..), MixEntry)-import Trace.Hpc.Tix (Tix (..), TixModule (..))-import Trace.Hpc.Util (fromHpcPos)+import Data.ByteString.Builder (hPutBuilder) -- Internal-import Trace.Hpc.Codecov.Exception-import Trace.Hpc.Codecov.Parser+import Trace.Hpc.Codecov.Report.Emit+import Trace.Hpc.Codecov.Report.Entry -- ------------------------------------------------------------------------@@ -71,127 +41,16 @@ -- -- ------------------------------------------------------------------------ --- | Data type to hold information for generating test coverage--- report.-data Report = Report- { reportTix :: FilePath- -- ^ Input tix file.- , reportMixDirs :: [FilePath]- -- ^ Directories containing mix files referred by the tix file.- , reportSrcDirs :: [FilePath]- -- ^ Directories 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 report data, if given.- , reportVerbose :: Bool- -- ^ Flag for showing verbose message during report generation.- , reportFormat :: Format- -- ^ Format of the report output.- --- -- @since 0.4.0.0- } deriving (Eq, Show)--#if MIN_VERSION_base(4,11,0)-instance Semigroup Report where- (<>) = mappendReport-#endif--instance Monoid Report where- mempty = emptyReport-#if !MIN_VERSION_base(4,16,0)- mappend = mappendReport-#endif--emptyReport :: Report-emptyReport = Report- { reportTix = throw NoTarget- , reportMixDirs = []- , reportSrcDirs = []- , reportExcludes = []- , reportOutFile = Nothing- , reportVerbose = False- , reportFormat = Codecov- }--mappendReport :: Report -> Report -> Report-mappendReport r1 r2 =- let extend f g = (f `on` g) r1 r2- in Report { reportTix = reportTix r2- , reportMixDirs = extend (<>) reportMixDirs- , reportSrcDirs = extend (<>) reportSrcDirs- , reportExcludes = extend (<>) reportExcludes- , reportOutFile = extend mplus reportOutFile- , reportVerbose = extend (||) reportVerbose- , reportFormat = reportFormat r2- }---- | Single file entry in coverage report.----data CoverageEntry =- CoverageEntry { ce_filename :: FilePath -- ^ Source code file name.- , ce_hits :: LineHits -- ^ Line hits of the file.- , ce_fns :: FunctionHits- -- ^ Function hits of the file.- --- -- @since 0.4.0.0- , ce_branches :: BranchHits- -- ^ Branch hits of the file.- --- -- @since 0.4.0.0- } deriving (Eq, Show)---- | Pair of line number and hit tag.-type LineHits = [(Int, Hit)]---- | Data type to represent coverage of source code line.------ The 'Int' value in 'Partial' and 'Full' are the hit count.-data Hit- = Missed -- ^ The line is not covered at all.- | Partial Int -- ^ The line is partially covered.- | Full Int -- ^ The line is fully covered.- deriving (Eq, Show)---- | Type synonym for tracking function enter count. Elements are--- start line number, end line number, execution count, and function--- name.------ @since 0.4.0.0-type FunctionHits = [(Int, Int, Int, String)]---- | Type synonym for tracking branch information. Elements are start--- line number, branch block number, 'Bool' for the taken branch, and--- execution count.------ @since 0.4.0.0-type BranchHits = [(Int, Int, Bool, Int)]---- | Data type for generated report format.-data Format- = Codecov- -- ^ Custom Codecov JSON format. See the- -- <https://docs.codecov.io/docs/codecov-custom-coverage-format Codecov documentation>- -- for detail.- --- -- @since 0.1.0.0- | Lcov- -- ^ LCOV tracefile format. See the- -- <https://ltp.sourceforge.net/coverage/lcov/geninfo.1.php geninfo manpage>- -- for detail.- --- -- @since 0.4.0.0- 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 report to " ++ oname)+ say = when (reportVerbose rpt) . hPutStrLn stderr+ entries <- genCoverageEntries rpt+ say ("Writing report to " ++ oname) emitCoverage (reportFormat rpt) mb_out entries- say rpt "Done"+ say "Done" -- | Generate test coverage entries. genCoverageEntries :: Report -> IO [CoverageEntry]@@ -213,282 +72,6 @@ wrap = maybe ($ stdout) (`withFile` WriteMode) mb_outfile emit = flip hPutBuilder (builder entries) builder = case fmt of- Codecov -> buildJSON- Lcov -> buildLcov----- ------------------------------------------------------------------------------ Internal------ ---------------------------------------------------------------------------- | 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)- hit (n, tag) =- case tag of- Missed -> k <> char7 '0'- Partial {} -> k <> dquote (string7 "1/2")- Full i -> k <> intDec i- where- k = key (intDec n)---- | Build simple lcov tracefile from coverage entries.-buildLcov :: [CoverageEntry] -> Builder-buildLcov = mconcat . map buildLcovEntry--buildLcovEntry :: CoverageEntry -> Builder-buildLcovEntry e =- string7 "TN:" <> nl <>- string7 "SF:" <> stringUtf8 (ce_filename e) <> nl <>- fns_and_nl <>- string7 "FNF:" <> intDec fnf <> nl <>- string7 "FNH:" <> intDec fnh <> nl <>- brdas_and_nl <>- string7 "BRF:" <> intDec brf <> nl <>- string7 "BRH:" <> intDec brh <> nl <>- das_and_nl <>- string7 "LF:" <> intDec lf <> nl <>- string7 "LH:" <> intDec lh <> nl <>- string7 "end_of_record" <> nl- where- fold_hits f xs =- let (as, bs, nentry, nhit) = foldr f ([],[],0,0) xs- res = as <> bs- res_and_nl | null res = mempty- | otherwise = mconcat (intersperse nl res) <> nl- in (res_and_nl, nentry, nhit)-- (fns_and_nl, fnf, fnh) = fold_hits ffn (ce_fns e)- ffn (sl, el, n, name) (fn_acc, fnda_acc, num_fns, num_hit_fns) =- ( string7 "FN:" <> intDec sl <> comma <> intDec el <>- comma <> name' : fn_acc- , string7 "FNDA:" <> intDec n <> comma <> name' : fnda_acc- , num_fns + 1- , if n == 0 then num_hit_fns else num_hit_fns + 1 )- where- name' = stringUtf8 name-- (brdas_and_nl, brf, brh) = fold_hits fbr (ce_branches e)- fbr (sl, blk, bool, n) (_, br, num_brs, num_hit_brs) =- ( []- , string7 "BRDA:" <> intDec sl <> comma <>- intDec blk <> comma <>- char7 (if bool then '0' else '1') <> comma <>- intDec n : br- , num_brs + 1- , if n == 0 then num_hit_brs else num_hit_brs + 1 )-- (das_and_nl, lf, lh) = fold_hits fda (ce_hits e)- fda (n, hit) (_, da, num_lines, num_hits) =- case hit of- Missed -> ([], da0 n:da, num_lines + 1, num_hits)- Partial i -> ([], dai n i:da, num_lines + 1, num_hits + 1)- Full i -> ([], dai n i:da, num_lines + 1, num_hits + 1)- da0 n = string7 "DA:" <> intDec n <> comma <> char7 '0'- dai n i = string7 "DA:" <> intDec n <> comma <> intDec i-- nl = char7 '\n'--comma :: Builder-comma = char7 ','--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 ("Searching mix: " ++ name)- Mix path _ _ _ entries <- readMixFile (reportMixDirs rpt) tm- say rpt ("Found mix: " ++ path)- let Info _ min_line max_line hits fns pre_brs = makeInfo count ixs entries- lineHits = makeLineHits min_line max_line hits- path' <- ensureSrcPath rpt path- return (CoverageEntry { ce_filename = path'- , ce_hits = lineHits- , ce_fns = fns- , ce_branches = reBranch pre_brs })---- | 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 <- {-# SCC "readTixFile.readTix'" #-} 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 go- where- handler :: ErrorCall -> IO a- handler _ = throwIO (MixNotFound name dirs')- dirs' = map (</> (name <.> "mix")) dirs- go = {-# SCC "readMixFile.readMix'" #-} readMix' dirs (Right tm)---- | 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 say rpt ("Found source: " ++ path') >> return path'- else go (path':acc) dirs---- | Arrange branch hit information.------ LCOV tracefile seems like want to have a true branch before the--- corresponding false branch, so arranging the order.------ Also assigning sequential block numbers to the branch entries--- starting with identical line number.-reBranch :: PreBranchHits -> BranchHits-reBranch = go mempty- where- go im0 ((lf,brf,nf) : (lt,brt,nt) : rest) =- let (mb_i, im1) = insertLookupWithKey f lf 0 im0- f _key _new old = old + 1 :: Int- i = maybe 0 succ mb_i- in (lt,i,brt,nt) : (lf,i,brf,nf) : go im1 rest- go _ _ = []---- | 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. Using 'Int' so--- that unboxed arrays can use in its elements.-type Tick = Int---- | Internal type synonym to represent line hit count.-type Count = Int---- | Like 'BranchHits', but without branch block number.-type PreBranchHits = [(Int, Bool, Count)]---- | Internal type used for accumulating mix entries.-data Info =- Info {-# UNPACK #-} !Int -- ^ Index count- {-# UNPACK #-} !Int -- ^ Min line number- {-# UNPACK #-} !Int -- ^ Max line number- [(Int, Tick, Count)] -- ^ Start line number, tick, and count.- FunctionHits -- ^ For tracking function.- PreBranchHits -- ^ For tracking branch.---- | Make line hits from intermediate info.-makeLineHits :: Int -> Int -> [(Int, Tick, Count)] -> LineHits-makeLineHits min_line max_line hits = ticksToHits (assocs merged)- where- merged = runSTArray $ do- arr <- newArray (min_line, max_line) (ignored, 0)- mapM_ (updateOne arr) hits- return arr-- updateOne :: STArray s Int (Tick, Count) -> (Int, Tick, Count) -> ST s ()- updateOne arr (i, hit, count) = do- (old_hit, old_count) <- readArray arr i- writeArray arr i (mergeEntry old_hit hit, max old_count count)-- mergeEntry prev curr- | isMissed prev, isFull curr = partial- | isFull prev, isMissed curr = partial- | isPartial prev = prev- | otherwise = curr---- | Convert array of ticks to list of hits.-ticksToHits :: [(Int, (Tick, Count))] -> LineHits-ticksToHits = foldr f []- where- f (i,(tck,n)) acc- | isIgnored tck = acc- | isMissed tck = (i, Missed) : acc- | isFull tck = (i, Full n) : acc- | otherwise = (i, Partial n) : acc--ignored, missed, partial, full :: Tick-ignored = -1-missed = 0-partial = 1-full = 2--isIgnored :: Tick -> Bool-isIgnored = (== ignored)--isMissed :: Tick -> Bool-isMissed = (== missed)--isPartial :: Tick -> Bool-isPartial = (== partial)--isFull :: Tick -> Bool-isFull = (== full)--notTicked, ticked :: Tick-notTicked = missed-ticked = full---- See also: "utils/hpc/HpcMarkup.hs" in "ghc" git repository.-makeInfo :: Int -> [Integer] -> [MixEntry] -> Info-makeInfo size tixs = foldl' f z- where- z = Info 0 maxBound 0 [] [] []- f (Info i0 min_line max_line txs fns brs) (pos, boxLabel) =- let binBox =- case (isTicked i0, isTicked i1) of- (False, False) -> txs- (True, False) -> (sl, partial, numTicked i0) : txs- (False, True) -> (sl, partial, numTicked i1) : txs- (True, True) -> txs- tickBox =- let t | isTicked i0 = ticked- | otherwise = notTicked- in (sl, t, numTicked i0) : txs- tlBox ns = (sl, el, numTicked i0, intercalate "." ns) : fns- br bool = (sl, bool, numTicked i0)- (txs', fns', brs') =- case boxLabel of- ExpBox {} -> (tickBox, fns, brs)- TopLevelBox ns -> (tickBox, tlBox ns, brs)- LocalBox {} -> (tickBox, fns, brs)- BinBox _ True -> (binBox, fns, br True : brs)- BinBox _ False -> (txs, fns, br False : brs)- (sl, _, el, _) = fromHpcPos pos- i1 = i0 + 1- in Info i1 (min sl min_line) (max el max_line) txs' fns' brs'-- -- Hope that the mix file does not contain out of bound index.- numTicked = unsafeAt arr_tix- isTicked n = numTicked n /= 0-- arr_tix :: UArray Int Tick- arr_tix = listArray (0, size - 1) (map fromIntegral tixs)+ Codecov -> buildCodecov+ Lcov -> buildLcov+ Cobertura -> buildCobertura
+ src/Trace/Hpc/Codecov/Report/Emit.hs view
@@ -0,0 +1,424 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-- |+-- Module: Trace.Hpc.Codecov.Report.Emit+-- Copyright: (c) 2023 8c6794b6+-- License: BSD3+-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>+--+-- Emit 'CoverageEntry' to other report format.++module Trace.Hpc.Codecov.Report.Emit+ ( buildCodecov+ , buildLcov+ , buildCobertura+ ) where++-- base+import Data.Char (isUpper)+import Data.List (foldl', intercalate,+ intersperse)+import System.IO.Unsafe (unsafePerformIO)++#if !MIN_VERSION_bytestring(0,11,0)+import Text.Printf (printf)+#endif++-- bytestring+import Data.ByteString.Builder (Builder, char7, intDec,+ string7, stringUtf8)+#if MIN_VERSION_bytestring(0,11,0)+import Data.ByteString.Builder.RealFloat (formatDouble,+ standardDefaultPrecision)+#endif++-- containers+import qualified Data.IntMap as IntMap+import qualified Data.Map as Map++-- filepath+import System.FilePath (dropExtension,+ splitDirectories,+ takeDirectory)++-- time+import Data.Time.Clock.POSIX (getPOSIXTime)++-- Internal+import Trace.Hpc.Codecov.Report.Entry+++-- ------------------------------------------------------------------------+-- Codecov+-- ------------------------------------------------------------------------++-- | Build simple Codecov JSON report from coverage entries.+buildCodecov :: [CoverageEntry] -> Builder+buildCodecov 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 ':'+ braced x = char7 '{' <> x <> char7 '}'+ listify xs = mconcat (intersperse comma xs)+ hit (n, tag) =+ case tag of+ Missed -> k <> char7 '0'+ Partial {} -> k <> dquote (string7 "1/2")+ Full i -> k <> intDec i+ where+ k = key (intDec n)+++-- ------------------------------------------------------------------------+-- Lcov+-- ------------------------------------------------------------------------++-- | Build simple lcov tracefile from coverage entries.+buildLcov :: [CoverageEntry] -> Builder+buildLcov = mconcat . map buildLcovEntry++buildLcovEntry :: CoverageEntry -> Builder+buildLcovEntry e =+ string7 "TN:" <> nl <>+ string7 "SF:" <> stringUtf8 (ce_filename e) <> nl <>+ fns_and_nl <>+ string7 "FNF:" <> intDec fnf <> nl <>+ string7 "FNH:" <> intDec fnh <> nl <>+ brdas_and_nl <>+ string7 "BRF:" <> intDec brf <> nl <>+ string7 "BRH:" <> intDec brh <> nl <>+ das_and_nl <>+ string7 "LF:" <> intDec lf <> nl <>+ string7 "LH:" <> intDec lh <> nl <>+ string7 "end_of_record" <> nl+ where+ fold_hits f xs =+ let (as, bs, nentry, nhit) = foldr f ([],[],0,0) xs+ res = as <> bs+ res_and_nl | null res = mempty+ | otherwise = mconcat (intersperse nl res) <> nl+ in (res_and_nl, nentry, nhit)++ (fns_and_nl, fnf, fnh) = fold_hits ffn (ce_fns e)+ ffn (sl, el, n, name) (fn_acc, fnda_acc, num_fns, num_hit_fns) =+ ( string7 "FN:" <> intDec sl <> comma <> intDec el <>+ comma <> name' : fn_acc+ , string7 "FNDA:" <> intDec n <> comma <> name' : fnda_acc+ , num_fns + 1+ , if n == 0 then num_hit_fns else num_hit_fns + 1 )+ where+ name' = stringUtf8 name++ (brdas_and_nl, brf, brh) = fold_hits fbr (ce_branches e)+ fbr (sl, blk, bool, n) (_, br, num_brs, num_hit_brs) =+ ( []+ , string7 "BRDA:" <> intDec sl <> comma <>+ intDec blk <> comma <>+ char7 (if bool then '0' else '1') <> comma <>+ intDec n : br+ , num_brs + 1+ , if n == 0 then num_hit_brs else num_hit_brs + 1 )++ (das_and_nl, lf, lh) = fold_hits fda (ce_hits e)+ fda (n, hit) (_, da, num_lines, num_hits) =+ case hit of+ Missed -> ([], da0 n:da, num_lines + 1, num_hits)+ Partial i -> ([], dai n i:da, num_lines + 1, num_hits + 1)+ Full i -> ([], dai n i:da, num_lines + 1, num_hits + 1)+ da0 n = string7 "DA:" <> intDec n <> comma <> char7 '0'+ dai n i = string7 "DA:" <> intDec n <> comma <> intDec i++ nl = char7 '\n'+++-- ------------------------------------------------------------------------+-- Cobertura+-- ------------------------------------------------------------------------++class HasRate c e where+ numValid :: c e -> Int+ numCovered :: c e -> Int++newtype Lines a = Lines {unLines :: a}++newtype Branches a = Branches {unBranches :: a}++buildRateOf :: HasRate c e => c e -> Builder+buildRateOf x = buildRate (numCovered x) (numValid x)+{-# INLINABLE buildRateOf #-}++buildRate :: Int -> Int -> Builder+buildRate n d =+ if d == 0 then+ string7 "0.0"+ else+ formatStandardDouble (fromIntegral n / fromIntegral d)+{-# INLINABLE buildRate #-}++data Acc = Acc+ { acc_valid_lines :: !Int+ , acc_covered_lines :: !Int+ , acc_valid_branches :: !Int+ , acc_covered_branches :: !Int+ }++accLinesAndBranches :: (HasRate Lines e, HasRate Branches e) => [e] -> Acc+accLinesAndBranches = foldl' f (Acc 0 0 0 0)+ where+ f acc e = acc+ { acc_valid_lines = acc_valid_lines acc + numValid (Lines e)+ , acc_covered_lines = acc_covered_lines acc + numCovered (Lines e)+ , acc_valid_branches = acc_valid_branches acc + numValid (Branches e)+ , acc_covered_branches = acc_covered_branches acc + numCovered (Branches e)+ }++data CoberturaPackage = CoberturaPackage+ { cp_name :: String+ , cp_lines_valid :: !Int+ , cp_lines_covered :: !Int+ , cp_branch_valid :: !Int+ , cp_branch_covered :: !Int+ , cp_classes :: [CoberturaClass]+ }++instance HasRate Lines CoberturaPackage where+ numValid = cp_lines_valid . unLines+ {-# INLINE numValid #-}+ numCovered = cp_lines_covered . unLines+ {-# INLINE numCovered #-}++instance HasRate Branches CoberturaPackage where+ numValid = cp_branch_valid . unBranches+ {-# INLINE numValid #-}+ numCovered = cp_branch_covered . unBranches+ {-# INLINE numCovered #-}++data CoberturaClass = CoberturaClass+ { cc_filename :: String+ , cc_lines_valid :: !Int+ , cc_lines_covered :: !Int+ , cc_branch_valid :: !Int+ , cc_branch_covered :: !Int+ , cc_methods :: [CoberturaMethod]+ , cc_lines :: [CoberturaLine]+ }++instance HasRate Lines CoberturaClass where+ numValid = cc_lines_valid . unLines+ {-# INLINE numValid #-}+ numCovered = cc_lines_covered . unLines+ {-# INLINE numCovered #-}++instance HasRate Branches CoberturaClass where+ numValid = cc_branch_valid . unBranches+ {-# INLINE numValid #-}+ numCovered = cc_branch_covered . unBranches+ {-# INLINE numCovered #-}++data CoberturaMethod = CoberturaMethod+ { cm_line_num :: !Int+ , cm_name :: String+ }++data CoberturaLine = CoberturaLine+ { cl_line_num :: !Int+ , cl_num_hits :: !Int+ , cl_branch_hits :: Map.Map (Int, Bool) Int+ }++-- | Build simple Cobertura XML report from coverage entries.+buildCobertura :: [CoverageEntry] -> Builder+buildCobertura es =+ string7 "<?xml version=\"1.0\" ?>" <>+ string7 "<!DOCTYPE coverage SYSTEM 'http://cobertura.sourceforge.nex/xml/coverage-0.4.dtd'>" <>+ xmlTagWith "coverage" coverage_attrs+ (xmlTag "sources" (xmlTag "source" (char7 '.')) <>+ xmlTag "packages" (mconcat (map buildCoberturaPackage pkgs))) <>+ char7 '\n'+ where+ coverage_attrs =+ [("branch-rate", buildRate bc bv)+ ,("branches-covered", intDec bc)+ ,("branches-valid", intDec bv)+ ,("complexity", char7 '0')+ ,("line-rate", buildRate lc lv)+ ,("lines-covered", intDec lc)+ ,("lines-valid", intDec lv)+ ,("timestamp", intDec $ fromInteger unsafeGetTimestamp)+ ,("version", string7 "2.0.3")]+ pkgs = toCoberturaPackages es+ Acc lv lc bv bc = accLinesAndBranches pkgs++-- XXX: Not sure whether this is the preferred timestamp format.+unsafeGetTimestamp :: Integer+unsafeGetTimestamp = round (unsafePerformIO getPOSIXTime)+{-# NOINLINE unsafeGetTimestamp #-}++buildCoberturaPackage :: CoberturaPackage -> Builder+buildCoberturaPackage cp =+ xmlTagWith "package" package_attrs+ (xmlTag "classes"+ (mconcat (map buildCoberturaClass (cp_classes cp))))+ where+ package_attrs =+ [("name", stringUtf8 $ cp_name cp)+ ,("line-rate", buildRateOf (Lines cp))+ ,("branch-rate", buildRateOf (Branches cp))+ ,("complexity", char7 '0')]++buildCoberturaClass :: CoberturaClass -> Builder+buildCoberturaClass cc =+ xmlTagWith "class" class_attrs+ (xmlTag "methods" (mconcat (map method (cc_methods cc))) <>+ xmlTag "lines" (mconcat (map line (cc_lines cc))))+ where+ class_attrs =+ [("branch-rate", buildRateOf (Branches cc))+ ,("complexity", char7 '0')+ ,("filename", stringUtf8 $ cc_filename cc)+ ,("line-rate", buildRateOf (Lines cc))+ ,("name", stringUtf8 $ toModuleName (cc_filename cc))]+ method cm =+ xmlTagWith "method" method_attrs+ (xmlTag "lines" (line_tag line_attrs))+ where+ method_attrs =+ [("name", stringUtf8 $ xmlEscape (cm_name cm))+ ,("signature", mempty)+ ,("line-rate", string7 "0.0")+ ,("branch-rate", string7 "0.0")]+ line_attrs =+ [("hits", char7 '0')+ ,("number", intDec (cm_line_num cm))+ ,("branch", string7 "false")]+ line cl = line_tag line_attrs+ where+ is_branch = not (null (cl_branch_hits cl))+ line_attrs =+ [("branch", string7 $ if is_branch then "true" else "false")+ ,("hits", intDec (cl_num_hits cl))+ ,("number", intDec (cl_line_num cl)) ] <>+ [("condition-coverage", buildConditionCoverage (cl_branch_hits cl))+ | is_branch ]+ line_tag attrs =+ string7 "<line" <> mconcat (map xmlAttr attrs) <> string7 "/>"++buildConditionCoverage :: Map.Map a Int -> Builder+buildConditionCoverage m = fmt+ where+ fmt = percentage <> char7 ' ' <> char7 '(' <> fraction <> char7 ')'+ percentage = intDec (round (100 * rate)) <> char7 '%'+ fraction = intDec covered <> char7 '/' <> intDec valid+ rate = fromIntegral covered / fromIntegral valid :: Double+ (covered, valid) = foldl' f (0, 0) m+ f (c, v) num_hits = (if 0 < num_hits then c + 1 else c, v + 1)++toCoberturaPackages :: [CoverageEntry] -> [CoberturaPackage]+toCoberturaPackages =+ Map.foldrWithKey' go [] . Map.fromListWith (<>) . map pair_with_pkgname+ where+ pair_with_pkgname ce =+ (toCoberturaPackageName (ce_filename ce), [toCoberturaClass ce])+ go pkg_name ces acc =+ let Acc lv lc bv bc = accLinesAndBranches ces+ in CoberturaPackage { cp_name = pkg_name+ , cp_lines_valid = lv+ , cp_lines_covered = lc+ , cp_branch_valid = bv+ , cp_branch_covered = bc+ , cp_classes = ces+ } : acc++toCoberturaClass :: CoverageEntry -> CoberturaClass+toCoberturaClass ce = CoberturaClass+ { cc_filename = ce_filename ce+ , cc_lines_valid = lv+ , cc_lines_covered = lc+ , cc_branch_valid = bv+ , cc_branch_covered = bc+ , cc_methods = methods+ , cc_lines = IntMap.elems im1+ }+ where+ (lv, lc, im0) = foldl' acc_line (0, 0, mempty) (ce_hits ce)+ (bv, bc, im1) = foldl' acc_branch (0, 0, im0) (ce_branches ce)+ acc_line (lv0, lc0, im) (n, hit) =+ case hit of+ Missed -> (lv0 + 1, lc0, IntMap.insert n (make_line n 0) im)+ Partial i -> (lv0 + 1, lc0 + 1, IntMap.insert n (make_line n i) im)+ Full i -> (lv0 + 1, lc0 + 1, IntMap.insert n (make_line n i) im)+ make_line n i = CoberturaLine n i mempty+ make_branch n i bn bool = CoberturaLine n i (Map.singleton (bn,bool) i)+ merge_brs new_cl old_cl = CoberturaLine+ { cl_line_num = cl_line_num old_cl+ , cl_num_hits = max (cl_num_hits old_cl) (cl_num_hits new_cl)+ , cl_branch_hits =+ Map.unionWith (+) (cl_branch_hits old_cl) (cl_branch_hits new_cl)+ }+ acc_branch (bv0, bc0, im) (n, bn, bool, count) =+ let im' = IntMap.insertWith merge_brs n (make_branch n count bn bool) im+ in (bv0 + 1, if count == 0 then bc0 else bc0 + 1, im')+ methods = map to_method (ce_fns ce)+ to_method (sl,_,_,name) = CoberturaMethod sl name++toCoberturaPackageName :: FilePath -> String+toCoberturaPackageName = intercalate "." . splitDirectories . takeDirectory++toModuleName :: FilePath -> String+toModuleName path = intercalate "." paths'+ where+ paths' = [p | p@(c:_) <- splitDirectories (dropExtension path), isUpper c ]++xmlTag :: String -> Builder -> Builder+xmlTag name = xmlTagWith name []++xmlTagWith :: String -> [(String, Builder)] -> Builder -> Builder+xmlTagWith name attrs body =+ char7 '<' <> string7 name <> attrs' <> char7 '>' <>+ body <>+ string7 "</" <> string7 name <> char7 '>'+ where+ attrs' =+ if null attrs then mempty else mconcat (map xmlAttr attrs)++xmlAttr :: (String, Builder) -> Builder+xmlAttr (name, val) = char7 ' ' <> string7 name <> char7 '=' <> dquote val++xmlEscape :: String -> String+xmlEscape = go+ where+ go [] = []+ go (c:rest) = case c of+ '>' -> ">" <> go rest+ '<' -> "<" <> go rest+ '"' -> """ <> go rest+ '&' -> "&" <> go rest+ _ -> c:go rest+++-- ------------------------------------------------------------------------+-- Auxiliary+-- ------------------------------------------------------------------------++dquote :: Builder -> Builder+dquote x = char7 '"' <> x <> char7 '"'+{-# INLINABLE dquote #-}++comma :: Builder+comma = char7 ','+{-# INLINABLE comma #-}++formatStandardDouble :: Double -> Builder+#if MIN_VERSION_bytestring(0,11,0)+formatStandardDouble = formatDouble standardDefaultPrecision+#else+formatStandardDouble = string7 . printf "%f"+#endif+{-# INLINABLE formatStandardDouble #-}
+ src/Trace/Hpc/Codecov/Report/Entry.hs view
@@ -0,0 +1,370 @@+-- |+-- Module: Trace.Hpc.Codecov.Report.Entry+-- Copyright: (c) 2023 8c6794b6+-- License: BSD3+-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>+--+-- Codes for converting tix and mix files to 'CoverageEntry'.++module Trace.Hpc.Codecov.Report.Entry+ ( Report(..)+ , CoverageEntry(..)+ , Format(..)+ , LineHits+ , Hit(..)+ , FunctionHits+ , BranchHits+ , tixToCoverage+ , readTixFile+ ) where++-- base+import Control.Applicative ((<|>))+import Control.Exception (ErrorCall, handle, throw,+ throwIO)+import Control.Monad (when)+import Control.Monad.ST (ST)+import Data.Function (on)+import Data.List (foldl', intercalate)+import System.IO (hPutStrLn, stderr)++-- array+import Data.Array.Base (unsafeAt)+import Data.Array.IArray (assocs, listArray)+import Data.Array.MArray (newArray, readArray,+ writeArray)+import Data.Array.ST (STArray, runSTArray)+import Data.Array.Unboxed (UArray)++-- containers+import qualified Data.IntMap as IntMap++-- directory+import System.Directory (doesFileExist)++-- filepath+import System.FilePath ((<.>), (</>))++-- hpc+import Trace.Hpc.Mix (BoxLabel (..), Mix (..),+ MixEntry)+import Trace.Hpc.Tix (Tix (..), TixModule (..))+import Trace.Hpc.Util (fromHpcPos)+++-- Internal+import Trace.Hpc.Codecov.Exception+import Trace.Hpc.Codecov.Parser+++-- ------------------------------------------------------------------------+--+-- Types+--+-- ------------------------------------------------------------------------++-- | Data type to hold information for generating test coverage+-- report.+data Report = Report+ { reportTix :: FilePath+ -- ^ Input tix file.+ , reportMixDirs :: [FilePath]+ -- ^ Directories containing mix files referred by the tix file.+ , reportSrcDirs :: [FilePath]+ -- ^ Directories 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 report data, if given.+ , reportVerbose :: Bool+ -- ^ Flag for showing verbose message during report generation.+ , reportFormat :: Format+ -- ^ Format of the report output.+ --+ -- @since 0.4.0.0+ } deriving (Eq, Show)++instance Semigroup Report where+ (<>) = mappendReport++instance Monoid Report where+ mempty = emptyReport++emptyReport :: Report+emptyReport = Report+ { reportTix = throw NoTarget+ , reportMixDirs = []+ , reportSrcDirs = []+ , reportExcludes = []+ , reportOutFile = Nothing+ , reportVerbose = False+ , reportFormat = Codecov+ }++mappendReport :: Report -> Report -> Report+mappendReport r1 r2 =+ let extend f g = (f `on` g) r1 r2+ in Report { reportTix = reportTix r2+ , reportMixDirs = extend (<>) reportMixDirs+ , reportSrcDirs = extend (<>) reportSrcDirs+ , reportExcludes = extend (<>) reportExcludes+ , reportOutFile = extend (<|>) reportOutFile+ , reportVerbose = extend (||) reportVerbose+ , reportFormat = reportFormat r2+ }++-- | Single file entry in coverage report.+--+data CoverageEntry =+ CoverageEntry { ce_filename :: FilePath -- ^ Source code file name.+ , ce_hits :: LineHits -- ^ Line hits of the file.+ , ce_fns :: FunctionHits+ -- ^ Function hits of the file.+ --+ -- @since 0.4.0.0+ , ce_branches :: BranchHits+ -- ^ Branch hits of the file.+ --+ -- @since 0.4.0.0+ } deriving (Eq, Show)++-- | Pair of line number and hit tag.+type LineHits = [(Int, Hit)]++-- | Data type to represent coverage of source code line.+--+-- The 'Int' value in 'Partial' and 'Full' are the hit count.+data Hit+ = Missed -- ^ The line is not covered at all.+ | Partial Int -- ^ The line is partially covered.+ | Full Int -- ^ The line is fully covered.+ deriving (Eq, Show)++-- | Type synonym for tracking function enter count. Elements are+-- start line number, end line number, execution count, and function+-- name.+--+-- @since 0.4.0.0+type FunctionHits = [(Int, Int, Int, String)]++-- | Type synonym for tracking branch information. Elements are start+-- line number, branch block number, 'Bool' for the taken branch, and+-- execution count.+--+-- @since 0.4.0.0+type BranchHits = [(Int, Int, Bool, Int)]++-- | Data type for generated report format.+data Format+ = Codecov+ -- ^ Custom Codecov JSON format. See the+ -- <https://docs.codecov.io/docs/codecov-custom-coverage-format Codecov documentation>+ -- for detail.+ --+ -- @since 0.1.0.0+ | Lcov+ -- ^ LCOV tracefile format. See the+ -- <https://ltp.sourceforge.net/coverage/lcov/geninfo.1.php geninfo manpage>+ -- for detail.+ --+ -- @since 0.4.0.0+ | Cobertura+ -- ^ Cobertura XML file format. See the+ -- <https://cobertura.github.io/cobertura/ Cobertura> website for detail.+ --+ -- @since 0.5.0.0+ deriving (Eq, Show)+++-- ------------------------------------------------------------------------+--+-- Tix to CoverageEntry+--+-- ------------------------------------------------------------------------++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 ("Searching mix: " ++ name)+ Mix path _ _ _ entries <- readMixFile (reportMixDirs rpt) tm+ say rpt ("Found mix: " ++ path)+ let Info _ min_line max_line hits fns pre_brs = makeInfo count ixs entries+ lineHits = makeLineHits min_line max_line hits+ path' <- ensureSrcPath rpt path+ return (CoverageEntry { ce_filename = path'+ , ce_hits = lineHits+ , ce_fns = fns+ , ce_branches = reBranch pre_brs })++-- | 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 <- {-# SCC "readTixFile.readTix'" #-} 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 go+ where+ handler :: ErrorCall -> IO a+ handler _ = throwIO (MixNotFound name dirs')+ dirs' = map (</> (name <.> "mix")) dirs+ go = {-# SCC "readMixFile.readMix'" #-} readMix' dirs (Right tm)++-- | 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 say rpt ("Found source: " ++ path') >> return path'+ else go (path':acc) dirs++-- | Arrange branch hit information.+--+-- LCOV tracefile seems like want to have a true branch before the+-- corresponding false branch, so arranging the order.+--+-- Also assigning sequential block numbers to the branch entries+-- starting with identical line number.+reBranch :: PreBranchHits -> BranchHits+reBranch = go mempty+ where+ go im0 ((lf,brf,nf) : (lt,brt,nt) : rest) =+ let (mb_i, im1) = IntMap.insertLookupWithKey f lf 0 im0+ f _key _new old = old + 1 :: Int+ i = maybe 0 succ mb_i+ in (lt,i,brt,nt) : (lf,i,brf,nf) : go im1 rest+ go _ _ = []++-- | Print given message to 'stderr' when the verbose flag is 'True'.+say :: Report -> String -> IO ()+say rpt = when (reportVerbose rpt) . hPutStrLn stderr++-- | Internal type synonym to represent code line hit. Using 'Int' so+-- that unboxed arrays can use in its elements.+type Tick = Int++-- | Internal type synonym to represent line hit count.+type Count = Int++-- | Like 'BranchHits', but without branch block number.+type PreBranchHits = [(Int, Bool, Count)]++-- | Internal type used for accumulating mix entries.+data Info =+ Info {-# UNPACK #-} !Int -- ^ Index count+ {-# UNPACK #-} !Int -- ^ Min line number+ {-# UNPACK #-} !Int -- ^ Max line number+ [(Int, Tick, Count)] -- ^ Start line number, tick, and count.+ FunctionHits -- ^ For tracking function.+ PreBranchHits -- ^ For tracking branch.++-- | Make line hits from intermediate info.+makeLineHits :: Int -> Int -> [(Int, Tick, Count)] -> LineHits+makeLineHits min_line max_line hits = ticksToHits (assocs merged)+ where+ merged = runSTArray $ do+ arr <- newArray (min_line, max_line) (ignored, 0)+ mapM_ (updateOne arr) hits+ return arr++ updateOne :: STArray s Int (Tick, Count) -> (Int, Tick, Count) -> ST s ()+ updateOne arr (i, hit, count) = do+ (old_hit, old_count) <- readArray arr i+ writeArray arr i (mergeEntry old_hit hit, max old_count count)++ mergeEntry prev curr+ | isMissed prev, isFull curr = partial+ | isFull prev, isMissed curr = partial+ | isPartial prev = prev+ | otherwise = curr++-- | Convert array of ticks to list of hits.+ticksToHits :: [(Int, (Tick, Count))] -> LineHits+ticksToHits = foldr f []+ where+ f (i,(tck,n)) acc+ | isIgnored tck = acc+ | isMissed tck = (i, Missed) : acc+ | isFull tck = (i, Full n) : acc+ | otherwise = (i, Partial n) : acc++ignored, missed, partial, full :: Tick+ignored = -1+missed = 0+partial = 1+full = 2++isIgnored :: Tick -> Bool+isIgnored = (== ignored)++isMissed :: Tick -> Bool+isMissed = (== missed)++isPartial :: Tick -> Bool+isPartial = (== partial)++isFull :: Tick -> Bool+isFull = (== full)++notTicked, ticked :: Tick+notTicked = missed+ticked = full++-- See also: "utils/hpc/HpcMarkup.hs" in "ghc" git repository.+makeInfo :: Int -> [Integer] -> [MixEntry] -> Info+makeInfo size tixs = foldl' f z+ where+ z = Info 0 maxBound 0 [] [] []+ f (Info i0 min_line max_line txs fns brs) (pos, boxLabel) =+ let binBox =+ case (isTicked i0, isTicked i1) of+ (False, False) -> txs+ (True, False) -> (sl, partial, numTicked i0) : txs+ (False, True) -> (sl, partial, numTicked i1) : txs+ (True, True) -> txs+ tickBox =+ let t | isTicked i0 = ticked+ | otherwise = notTicked+ in (sl, t, numTicked i0) : txs+ tlBox ns = (sl, el, numTicked i0, intercalate "." ns) : fns+ br bool = (sl, bool, numTicked i0)+ (txs', fns', brs') =+ case boxLabel of+ ExpBox {} -> (tickBox, fns, brs)+ TopLevelBox ns -> (tickBox, tlBox ns, brs)+ LocalBox {} -> (tickBox, fns, brs)+ BinBox _ True -> (binBox, fns, br True : brs)+ BinBox _ False -> (txs, fns, br False : brs)+ (sl, _, el, _) = fromHpcPos pos+ i1 = i0 + 1+ in Info i1 (min sl min_line) (max el max_line) txs' fns' brs'++ -- Hope that the mix file does not contain out of bound index.+ numTicked = unsafeAt arr_tix+ isTicked n = numTicked n /= 0++ arr_tix :: UArray Int Tick+ arr_tix = listArray (0, size - 1) (map fromIntegral tixs)
test/Test/Main.hs view
@@ -5,12 +5,16 @@ -- base import Control.Exception (SomeException (..), try) import Control.Monad (when)-import Data.List (isSubsequenceOf)+import Data.Char (toLower)+import Data.List (isPrefixOf, isSubsequenceOf) import Data.Maybe (fromMaybe, isJust) import System.Environment (getExecutablePath, lookupEnv, setEnv, unsetEnv, withArgs) import System.Exit (ExitCode)-import System.IO (hClose, openTempFile)+import System.IO (IOMode (..), hClose,+ hGetContents, openBinaryFile,+ openTempFile)+import System.Info (os) #if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))@@ -18,7 +22,8 @@ -- filepath-import System.FilePath (takeFileName, (</>))+import System.FilePath (joinPath, takeFileName,+ (</>)) -- directory import System.Directory (canonicalizePath,@@ -28,6 +33,10 @@ removeFile, withCurrentDirectory) +-- hpc+import Trace.Hpc.Mix (readMix)+import Trace.Hpc.Tix (readTix)+ -- process import System.Process (CreateProcess (..), callProcess, shell,@@ -35,15 +44,21 @@ withCreateProcess) -- tasty-import Test.Tasty (TestTree, defaultMain,+import Test.Tasty (DependencyType (..),+ TestTree, after, defaultMain, testGroup, withResource) import Test.Tasty.HUnit (assertEqual, assertFailure, testCase) +-- tasty-golden+import Test.Tasty.Golden (goldenVsFile,+ writeBinaryFile)+ -- Internal import Trace.Hpc.Codecov.Discover import Trace.Hpc.Codecov.Exception import qualified Trace.Hpc.Codecov.Main as HpcCodecov+import Trace.Hpc.Codecov.Parser import Trace.Hpc.Codecov.Report @@ -66,11 +81,35 @@ , "" ] defaultMain $ testGroup "main" $- [reportTest, cmdline, recipReport, exceptionTest] +++ [reportTest, cmdline, recipReport, exceptionTest, parserTest] ++ [selfReportTest | not test_in_test, isJust mb_tool] ++ [discoverStackTest | not test_in_test, mb_tool == Just Stack] ++ [discoverCabalTest | not test_in_test, mb_tool == Just Cabal] +parserTest :: TestTree+parserTest = testGroup "parser"+ [ testGroup "readTix'"+ [ testCase "compare" $ do+ let read_with f = f (reciprocal_dir </> "reciprocal.tix")+ tix1 <- read_with readTix+ tix2 <- read_with readTix'+ assertEqual "readTix'" tix1 tix2+ ]++ , testGroup "readMix'"+ [ testCase "compare" $ do+ let read_with f = f [reciprocal_dir </> ".hpc"] (Left "Main")+ mix1 <- read_with readMix+ mix2 <- read_with readMix'+ assertEqual "readMix'" mix1 mix2++ , testCase "malformed timestamp" $+ shouldFail $ readMix' [reciprocal_dir </> ".hpc"] (Left "Malformed")+ ]+ ]+ where+ reciprocal_dir = joinPath ["test", "data", "reciprocal"]+ exceptionTest :: TestTree exceptionTest = testGroup "exception" [ testCase "NoTarget" $ assertEqual "NoTarget" "NoTarget" (show NoTarget)@@ -130,6 +169,12 @@ ,"--verbose" ,"--format=lcov" ,"test/data/reciprocal/reciprocal.tix"])+ , testCase "recip-cobertura-data-to-stdout"+ (main' ["--mix=test/data/reciprocal/.hpc"+ ,"--src=test/data/reciprocal"+ ,"--verbose"+ ,"--format=cobertura"+ ,"test/data/reciprocal/reciprocal.tix"]) , testCase "recip-data-no-src" (shouldFail (main' ["--mix=test/data/reciprocal/.hpc"@@ -166,6 +211,7 @@ , sra_mixs :: [FilePath] , sra_excludes :: [String] , sra_verbose :: Bool+ , sra_format :: Format , sra_out :: Maybe FilePath } @@ -174,6 +220,7 @@ , sra_mixs = [] , sra_excludes = [] , sra_verbose = False+ , sra_format = Codecov , sra_out = Nothing } getBuildTool :: IO (Maybe BuildTool)@@ -256,6 +303,12 @@ selfReport getArgs = testGroup "self" [ testCase "self-data-to-stdout" (getArgs >>= sraMain)+ , testCase "self-data-to-stdout-lcov"+ (do args <- getArgs+ sraMain (args {sra_format=Lcov}))+ , testCase "self-data-to-stdout-cobertura"+ (do args <- getArgs+ sraMain (args {sra_format=Cobertura})) , testCase "self-data-to-stdout-verbose" (do args <- getArgs sraMain (args {sra_verbose=True}))@@ -292,24 +345,55 @@ withProject name act = case getAcquireAndRelease Stack name [] of (a,r) -> withResource a r (const act) in testGroup "discover_stack"- [ t "project1"- [ "--root=" ++ testData "project1"- , "--verbose"- , "stack:project1-test"]- []- , t "project1"- [ "--root=" ++ testData "project1"- , "--verbose"- , "--build=dot-stack-work"- , "stack:project1-test.tix"]- ["--work-dir=dot-stack-work"]- , t "project1"- [ "--root=" ++ testData "project1"- , "--verbose"- , "--format=lcov"- , "stack:project1-test"]- []+ [ testGroup "plain"+ [ t "project1"+ [ "--root=" ++ testData "project1"+ , "--verbose"+ , "stack:project1-test"]+ []+ ] + , testGroup "dot-stack-work"+ [ t "project1"+ [ "--root=" ++ testData "project1"+ , "--verbose"+ , "--build=dot-stack-work"+ , "stack:project1-test.tix"]+ ["--work-dir=dot-stack-work"]+ ]++ , testGroup "lcov"+ [ t "project1"+ [ "--root=" ++ testData "project1"+ , "--verbose"+ , "--format=lcov"+ , "stack:project1-test"]+ []+ ]++ , testGroup "cobertura"+ [ t "project1"+ [ "--root=" ++ testData "project1"+ , "--verbose"+ , "--format=cobertura"+ , "--out=project1.xml"+ , "stack:project1-test"]+ []+ ]++ , after AllSucceed "cobertura.project1" $+ testGroup "golden"+ [ let ofile = "project1-refilled.xml"+ golden_file =+ if os == "mingw32" then+ "project1-windows.xml.golden"+ else+ "project1.xml.golden"+ golden_path = joinPath ["test", "data", "golden", golden_file]+ act = refillTimestampWithZero "project1.xml" ofile+ in goldenVsFile "cobertura" golden_path ofile act+ ]+ , withProject "project1" $ testCase "project1" $ withCurrentDirectory (testData "project1") $ main'@@ -329,6 +413,17 @@ main' [ "--verbose", "stack:" ++ canonical_tix_path ]) ] +refillTimestampWithZero :: FilePath -> FilePath -> IO ()+refillTimestampWithZero ipath opath = do+ hdl <- openBinaryFile ipath ReadMode+ contents <- hGetContents hdl+ writeBinaryFile opath $+ unwords [ w' | w <- words contents+ , let w' =+ if "timestamp" `isPrefixOf` w+ then "timestamp=\"0\""+ else w ]+ discoverCabalTest :: TestTree discoverCabalTest = let t = buildAndTestWithCabal@@ -430,7 +525,9 @@ map ("--exclude=" ++) (sra_excludes sra) ++ maybe [] (\p -> ["--out=" ++ p]) (sra_out sra) ++ ["--verbose" | sra_verbose sra] +++ ["--format=" ++ asFormat (sra_format sra)] ++ [sra_tix sra]+ asFormat = map toLower . show -- | Run test with path to temporary file. withTempFile :: (IO FilePath -> TestTree) -> TestTree@@ -439,7 +536,7 @@ acquire = do (path,hdl) <- openTempFile "." "test.tmp" hClose hdl return path- release path = removeFile path+ release = removeFile withTempDir :: (IO FilePath -> TestTree) -> TestTree withTempDir = withResource acquire release
test/data/project1/project1.cabal view
@@ -1,10 +1,8 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack------ hash: 2a82452cb1b1a322c856e7d346b38bfb8136930e2638507eb703234a0658f2dc name: project1 version: 0.1.0.0@@ -28,6 +26,9 @@ library exposed-modules: Lib+ Lib.Bar+ Lib.Bar.Buzz+ Lib.Foo other-modules: Paths_project1 hs-source-dirs:
test/data/project1/src/Lib.hs view
@@ -1,7 +1,13 @@ module Lib ( someFunc , anotherFunc+ , yetAnotherFunc+ , theNewFunc+ , theReturnedFunc ) where++import Lib.Bar+import Lib.Foo someFunc :: Int -> IO () someFunc n =
+ test/data/project1/src/Lib/Bar.hs view
@@ -0,0 +1,13 @@+module Lib.Bar+ ( module Lib.Bar+ , module Lib.Bar.Buzz+ ) where++import Lib.Bar.Buzz++theNewFunc :: Int -> Int -> Int -> IO ()+theNewFunc a b c+ | even a = print (a * b + c)+ | even b = print (a * c + b)+ | odd a, odd b = print (b * c + a)+ | otherwise = pure ()
+ test/data/project1/src/Lib/Bar/Buzz.hs view
@@ -0,0 +1,7 @@+module Lib.Bar.Buzz where++theReturnedFunc :: Int -> Int -> Int -> IO ()+theReturnedFunc a b c = print (a + b + c)++(<&&>) :: Bool -> Bool -> Bool+a <&&> b = a && b
+ test/data/project1/src/Lib/Foo.hs view
@@ -0,0 +1,7 @@+module Lib.Foo where++yetAnotherFunc :: Int -> Int -> Int -> IO ()+yetAnotherFunc a b c+ | a <= b, b <= c = putStrLn "b in the middle"+ | b <= a, a <= c = putStrLn "a in the middle"+ | otherwise = pure ()
test/data/project1/stack.yaml view
@@ -17,7 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml-resolver: lts-21.16+resolver: lts-21.19 # User packages to be built. # Various formats can be used as shown in the example below.
test/data/project1/test/Spec.hs view
@@ -4,3 +4,6 @@ main = do someFunc 42 anotherFunc 1 2 (-3)+ yetAnotherFunc 1 2 3+ theNewFunc 4 5 (-6)+ theReturnedFunc (-7) 8 9