packages feed

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 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 @@ [![GitHub](https://img.shields.io/github/actions/workflow/status/8c6794b6/hpc-codecov/ci.yml?branch=master&logo=github)](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+      '>' -> "&gt;" <> go rest+      '<' -> "&lt;" <> go rest+      '"' -> "&quot;" <> go rest+      '&' -> "&amp;" <> 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