packages feed

hpc-codecov 0.3.0.0 → 0.4.0.0

raw patch · 14 files changed

+685/−186 lines, 14 filesdep +containersdep +timePVP ok

version bump matches the API change (PVP)

Dependencies added: containers, time

API changes (from Hackage documentation)

- Paths_hpc_codecov: getBinDir :: IO FilePath
- Paths_hpc_codecov: getDataDir :: IO FilePath
- Paths_hpc_codecov: getDataFileName :: FilePath -> IO FilePath
- Paths_hpc_codecov: getDynLibDir :: IO FilePath
- Paths_hpc_codecov: getLibDir :: IO FilePath
- Paths_hpc_codecov: getLibexecDir :: IO FilePath
- Paths_hpc_codecov: getSysconfDir :: IO FilePath
- Paths_hpc_codecov: version :: Version
- Trace.Hpc.Codecov.Report: emitCoverageJSON :: Maybe FilePath -> [CoverageEntry] -> IO ()
+ Trace.Hpc.Codecov.Exception: InvalidFormat :: String -> HpcCodecovError
+ Trace.Hpc.Codecov.Parser: instance GHC.Base.Alternative Trace.Hpc.Codecov.Parser.P
+ Trace.Hpc.Codecov.Parser: instance GHC.Base.Applicative Trace.Hpc.Codecov.Parser.P
+ Trace.Hpc.Codecov.Parser: instance GHC.Base.Functor Trace.Hpc.Codecov.Parser.P
+ Trace.Hpc.Codecov.Parser: instance GHC.Base.Monad Trace.Hpc.Codecov.Parser.P
+ Trace.Hpc.Codecov.Parser: readMix' :: [String] -> Either String TixModule -> IO Mix
+ Trace.Hpc.Codecov.Parser: readTix' :: FilePath -> IO (Maybe Tix)
+ Trace.Hpc.Codecov.Report: Codecov :: Format
+ Trace.Hpc.Codecov.Report: Lcov :: Format
+ Trace.Hpc.Codecov.Report: [ce_branches] :: CoverageEntry -> BranchHits
+ Trace.Hpc.Codecov.Report: [ce_fns] :: CoverageEntry -> FunctionHits
+ Trace.Hpc.Codecov.Report: [reportFormat] :: Report -> Format
+ Trace.Hpc.Codecov.Report: data Format
+ Trace.Hpc.Codecov.Report: emitCoverage :: Format -> Maybe FilePath -> [CoverageEntry] -> IO ()
+ Trace.Hpc.Codecov.Report: instance GHC.Classes.Eq Trace.Hpc.Codecov.Report.Format
+ Trace.Hpc.Codecov.Report: instance GHC.Show.Show Trace.Hpc.Codecov.Report.Format
+ Trace.Hpc.Codecov.Report: type BranchHits = [(Int, Int, Bool, Int)]
+ Trace.Hpc.Codecov.Report: type FunctionHits = [(Int, Int, Int, String)]
- Trace.Hpc.Codecov.Report: CoverageEntry :: FilePath -> LineHits -> CoverageEntry
+ Trace.Hpc.Codecov.Report: CoverageEntry :: FilePath -> LineHits -> FunctionHits -> BranchHits -> CoverageEntry
- Trace.Hpc.Codecov.Report: Full :: Hit
+ Trace.Hpc.Codecov.Report: Full :: Int -> Hit
- Trace.Hpc.Codecov.Report: Partial :: Hit
+ Trace.Hpc.Codecov.Report: Partial :: Int -> Hit
- Trace.Hpc.Codecov.Report: Report :: FilePath -> [FilePath] -> [FilePath] -> [String] -> Maybe FilePath -> Bool -> Report
+ Trace.Hpc.Codecov.Report: Report :: FilePath -> [FilePath] -> [FilePath] -> [String] -> Maybe FilePath -> Bool -> Format -> Report

Files

CHANGELOG.md view
@@ -1,5 +1,17 @@ # Revision history for hpc-codecov +## 0.4.0.0 -- 2023-07++Add "--format" option to select the output report format. Add LCOV+tracefile format for generated report.++Modify the generated report to preserve line hit counts.++Add simple ``ByteString`` based parsers for reading ``.mix`` and+``.tix`` files to improve performance.++Remove ``Paths_hpc_codecov`` from exported modules.+ ## 0.3.0.0 -- 2021-04-02  Modify command-line argument to support TOOL:TEST_SUITE style target,
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2020, 8c6794b6+Copyright (c) 2022, 8c6794b6  All rights reserved. 
README.md view
@@ -1,18 +1,17 @@ # hpc-codecov [![Hackage](https://img.shields.io/hackage/v/hpc-codecov)](https://hackage.haskell.org/package/hpc-codecov) [![Stackage](https://www.stackage.org/package/hpc-codecov/badge/lts)](https://www.stackage.org/lts/package/hpc-codecov)  [![codecov](https://codecov.io/gh/8c6794b6/hpc-codecov/branch/master/graph/badge.svg)](https://codecov.io/gh/8c6794b6/hpc-codecov)-[![Travis](http://img.shields.io/travis/8c6794b6/codecov-haskell/master.svg?logo=travis)](https://travis-ci.com/8c6794b6/hpc-codecov) [![CircleCI](https://img.shields.io/circleci/build/gh/8c6794b6/hpc-codecov/master?logo=circleci)](https://circleci.com/gh/8c6794b6/hpc-codecov) [![AppVeyor](https://ci.appveyor.com/api/projects/status/dijqtsoqgc26oghj?svg=true)](https://ci.appveyor.com/project/8c6794b6/hpc-codecov)-[![GitHub](https://img.shields.io/github/workflow/status/8c6794b6/hpc-codecov/ci?logo=github)](https://github.com/8c6794b6/hpc-codecov/actions/workflows/ci.yml)+[![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 from-``.tix`` and ``.mix`` files made with+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 [hpc](https://hackage.haskell.org/package/hpc). The generated report is ready to be uploaded to Codecov with other tools such as [Codecov-Bash-uploader](https://docs.codecov.io/docs/about-the-codecov-bash-uploader).+uploader](https://docs.codecov.com/docs/codecov-uploader).  The ``hpc-codecov`` executable can search ``.tix`` and ``mix`` files under the directories made by the@@ -148,7 +147,17 @@ $ hpc-codecov stack:all -o codecov.json ``` +### 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+format to ``lcov.info``:++```consle+$ hpc-codecov stack:all -f lcov -o lcov.info+```++ Low-level examples ------------------ @@ -174,7 +183,7 @@ ``.mix`` files:  ```console-$ proj=hpc-codecov-0.3.0.0+$ proj=hpc-codecov-0.4.0.0 $ tix=$(find ./dist-newstyle -name $proj.tix) $ mix=$(find ./dist-newstyle -name vanilla -print -quit)/mix/$proj $ hpc-codecov --mix=$mix --exclude=Paths_hpc_codecov --out=codecov.json $tix@@ -198,14 +207,14 @@       "63": 1, ``` -Send the resulting JSON report file to Codecov with the [bash-uploader](https://github.com/codecov/codecov-bash/). The file name+Send the resulting JSON report file to Codecov with the [Codecov+uploader](https://github.com/codecov/uploader). The file name ``codecov.json`` is listed in the uploader script as one of the file name patterns to upload, no need to specify the report filename explicitly:  ```console-$ bash <(curl -s https://codecov.io/bash)+$ codecov -t ${CODECOV_TOKEN} ```  According to the Codecov@@ -214,7 +223,8 @@ [CircleCI](https://circleci.com/), [Azure](https://azure.microsoft.com/en-us/services/devops/pipelines), and [GitHub Actions](https://github.com/features/actions) for public-projects without the Codecov token.+projects without the Codecov token (i.e., without the `-t+${CODECOV_TOKEN}` option).   ### With stack@@ -236,12 +246,6 @@ $ tix=$(find $hpcroot -name 'test-main.tix') $ mix=$(stack path --dist-dir)/hpc $ hpc-codecov --mix=$mix --exclude=Paths_hpc_codecov -o codecov.json $tix-```--Then send the resulting report file:--```console-$ bash <(curl -s https://codecov.io/bash) ```  
hpc-codecov.cabal view
@@ -1,20 +1,21 @@ cabal-version:       2.0 name:                hpc-codecov-version:             0.3.0.0+version:             0.4.0.0 synopsis:            Generate codecov report from hpc data license:             BSD3 license-file:        LICENSE author:              8c6794b6 maintainer:          8c6794b6@gmail.com homepage:            https://github.com/8c6794b6/hpc-codecov#readme-copyright:           (c) 2020 8c6794b6+copyright:           (c) 2022 8c6794b6 category:            Test, Data build-type:          Simple  description:   The hpc-codecov package contains an executable and library codes for-  generating <https://codecov.io Codeocv> JSON coverage report from-  @.tix@ and @.mix@ files made with+  generating <https://codecov.io Codeocv> JSON coverage report or+  <https://github.com/linux-test-project/lcov LCOV> tracefile 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.@@ -42,24 +43,30 @@                      , GHC == 8.4.4                      , GHC == 8.6.5                      , GHC == 8.8.4-                     , GHC == 8.10.1-                     , GHC == 9.0.1+                     , GHC == 8.10.7+                     , GHC == 9.0.2+                     , GHC == 9.2.4+                     , GHC == 9.4.2+                     , GHC == 9.6.2  library   hs-source-dirs:      src   exposed-modules:     Trace.Hpc.Codecov.Exception                        Trace.Hpc.Codecov.Discover                        Trace.Hpc.Codecov.Main+                       Trace.Hpc.Codecov.Parser                        Trace.Hpc.Codecov.Report-                       Paths_hpc_codecov   other-modules:       Trace.Hpc.Codecov.Options+                       Paths_hpc_codecov   autogen-modules:     Paths_hpc_codecov   build-depends:       base        >= 4.10  && < 5                      , array       >= 0.1   && < 0.6                      , bytestring  >= 0.10  && < 0.12+                     , containers  >= 0.6   && < 0.8                      , directory   >= 1.3.0 && < 1.4.0                      , filepath    >= 1.4.1 && < 1.5                      , hpc         >= 0.6   && < 0.7+                     , time        >= 1.8   && < 1.13   default-language:    Haskell2010   ghc-options:         -Wall 
src/Trace/Hpc/Codecov/Discover.hs view
@@ -49,7 +49,7 @@     -- ^ Tool used to build Haskell cabal package.   , da_testsuite :: String     -- ^ Test suite name to search for @.tix@ file.-  , da_rootdir      :: FilePath+  , da_rootdir   :: FilePath     -- ^ The project root directory.   , da_builddir  :: Maybe String     -- ^ Name of the temporary build directory made by the build tool.
src/Trace/Hpc/Codecov/Exception.hs view
@@ -1,6 +1,6 @@ -- | -- Module:     Trace.Hpc.Codecov.Exception--- Copyright:  (c) 2020 8c6794b6+-- Copyright:  (c) 2022 8c6794b6 -- License:    BSD3 -- Maintainer: 8c6794b6 <8c6794b6@gmail.com> --@@ -47,6 +47,8 @@    -- file.   | InvalidBuildTool String    -- ^ Invalid build tool.+  | InvalidFormat String+   -- ^ Invalid report format.   | TestSuiteNotFound String    -- ^ Test suite was given, but not found.   | InvalidArgs [String]@@ -65,6 +67,7 @@     MixNotFound mix locs -> searchedLocations "mix" mix locs     SrcNotFound src locs -> searchedLocations "src" src locs     InvalidBuildTool tool-> "invalid build tool: `" ++ tool ++ "'\n"+    InvalidFormat fmt -> "invalid format: `" ++ fmt ++ "'\n"     TestSuiteNotFound name ->       "cannot find tix for test suite: " ++ show name ++ "\n"     InvalidArgs msgs ->
src/Trace/Hpc/Codecov/Main.hs view
@@ -1,6 +1,6 @@ -- | -- Module:     Trace.Hpc.Codecov.Main--- Copyright:  (c) 2020 8c6794b6+-- Copyright:  (c) 2022 8c6794b6 -- License:    BSD3 -- Maintainer: 8c6794b6 <8c6794b6@gmail.com> --
src/Trace/Hpc/Codecov/Options.hs view
@@ -1,7 +1,7 @@ {-# OPTIONS_HADDOCK hide #-} -- | -- Module:     Trace.Hpc.Codecov.Options--- Copyright:  (c) 2020 8c6794b6+-- Copyright:  (c) 2022 8c6794b6 -- License:    BSD3 -- Maintainer: 8c6794b6 <8c6794b6@gmail.com> --@@ -56,11 +56,14 @@   , optOutFile     :: Maybe FilePath     -- ^ Output file to write JSON report, if given. +  , optFormat      :: String+    -- ^ Format of generated report.+   , optVerbose     :: Bool     -- ^ Flag for showing verbose message during coverage report     -- generation. -  , optRootDir :: FilePath+  , optRootDir     :: FilePath     -- ^ Project root directory for the build tool.   , optBuildDir    :: Maybe FilePath     -- ^ Name of the build directory used by the build tool@@ -83,6 +86,7 @@   , optSrcDirs = []   , optExcludes = []   , optOutFile = Nothing+  , optFormat = "codecov"   , optVerbose = False   , optRootDir = ""   , optBuildDir = Nothing@@ -141,6 +145,13 @@            "Basename of directory to skip while\n\            \searching data for TOOL, can repeat" +  , Option ['f'] ["format"]+           (ReqArg (\s o -> o {optFormat = s})+                   "FMT")+           "Format of generated report\n\+           \'codecov' or 'lcov'\n\+           \(default: codecov)"+   , Option ['v'] ["verbose"]            (NoArg (\o -> o {optVerbose = True}))            "Show verbose output"@@ -202,6 +213,12 @@        (tool, ':':_)       -> throwIO $ InvalidBuildTool tool        _                   -> pure $ TixFile str +parseFormat :: String -> IO Format+parseFormat fmt = case fmt of+  "codecov" -> pure Codecov+  "lcov"    -> pure Lcov+  _         -> throwIO $ InvalidFormat fmt+ uncommas :: String -> [String] uncommas = go   where@@ -221,9 +238,11 @@         }       tix = optTix opt       verbose = optVerbose opt+  format <- parseFormat (optFormat opt)   target <- parseTarget tix   case target of-    TixFile path -> pure (rpt1 {reportTix = path})+    TixFile path -> pure (rpt1 {reportTix = path+                               ,reportFormat = format})     TestSuite tool name -> do       rpt2 <- discover DiscoverArgs         { da_tool = tool@@ -233,7 +252,7 @@         , da_skipdirs = optSkipDirs opt         , da_verbose = verbose         }-      pure $ rpt1 `mappend` rpt2+      pure $ rpt1 `mappend` rpt2 {reportFormat = format}  -- | Print help messages. printHelp :: IO ()
+ src/Trace/Hpc/Codecov/Parser.hs view
@@ -0,0 +1,273 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}+-- |+-- Module:     Trace.Hpc.Codecov.Parser+-- Copyright:  (c) 2023 8c6794b6+-- License:    BSD3+-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>+--+-- Simple bytestring parser for reading @.mix@ and @.tix@ files.+--+-- @since 0.4.0.0++module Trace.Hpc.Codecov.Parser+  ( readTix'+  , readMix'+  ) where++-- base+import           Control.Applicative            (Alternative (..))+import           Data.Functor                   (($>))+import           Prelude                        hiding (takeWhile)++-- bytestring+import           Data.ByteString.Char8          (ByteString)+import qualified Data.ByteString.Char8          as BS++-- 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)++-- time+import           Data.Time.Calendar.OrdinalDate (fromOrdinalDate)+import           Data.Time.Clock                (UTCTime (..))+++-- ------------------------------------------------------------------------+-- Exported+-- ------------------------------------------------------------------------++-- | Read a @.tix@ File.+--+-- This function is similar to 'Trace.Hpc.Tix.readTix', but internally+-- uses 'ByteString' to improve performance.+readTix' :: FilePath -> IO (Maybe Tix)+readTix' path =+  (runMaybeP parseTix <$> BS.readFile path) `catchIO` const (pure Nothing)++-- | Read a @.mix@ file.+--+-- 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+  -> IO Mix+readMix' dirs et_tm = go dirs+  where+    mixname = either id tixModuleName et_tm <.> "mix"+    handler _ = pure (Left "err ...")+    parse path = runEitherP parseMix <$> BS.readFile path+    go [] = error "Cannot find mix file"+    go (d:ds) = do+      et_mix <- parse (d </> mixname) `catchIO` handler+      case et_mix of+        Right mix -> pure mix+        Left _err -> go ds+++-- ------------------------------------------------------------------------+-- The parser+-- ------------------------------------------------------------------------++newtype P a =+  P {runP :: forall r. (String -> r) -- On error+          -> (a -> ByteString -> r)  -- On success+          -> ByteString              -- Input to consume+          -> r}++instance Functor P where+  fmap f p = P (\err ok -> runP p err (ok . f))+  {-# INLINE fmap #-}++instance Applicative P where+  pure x = P (\_ ok -> ok x)+  {-# INLINE pure #-}++  pf <*> pa = P (\err ok -> runP pf err (\f -> runP (fmap f pa) err ok))+  {-# INLINE (<*>) #-}++instance Monad P where+  m >>= k = P (\err ok -> runP m err (\x -> runP (k x) err ok))+  {-# INLINE (>>=) #-}++instance Alternative P where+  empty = P (\err _ _ -> err "Alternative.empty")+  {-# INLINE empty #-}++  p1 <|> p2 = P (\err go bs -> runP p1 (\_ -> runP p2 err go bs) go bs)+  {-# INLINE (<|>) #-}++runEitherP :: P a -> ByteString -> Either String a+runEitherP p = runP p Left (\a _ -> Right a)++runMaybeP :: P a -> ByteString -> Maybe a+runMaybeP p = runP p (const Nothing) (\a _ -> Just a)++char :: Char -> P ()+char c =+  P (\err ok bs ->+       case BS.uncons bs of+         Just (c', bs') | c == c' -> ok () bs'+         _                        -> err ("char: failed to get " <> show c))+{-# INLINABLE char #-}++bytes :: ByteString -> P ()+bytes target =+  P (\err ok bs ->+        case BS.splitAt (BS.length target) bs of+          (pre, post) | pre == target -> ok () post+          _ -> err ("bytes: failed to parse `" <> show target <> "'"))+{-# INLINABLE bytes #-}++int :: P Int+int =+  P (\err ok bs ->+       case BS.readInt bs of+         Just (n, bs') -> ok n bs'+         _             -> err "int: failed")+{-# INLINABLE int #-}++integer :: P Integer+integer = fmap fromIntegral int+{-# INLINEABLE integer #-}++spaces :: P ()+spaces = P (\_ ok bs -> ok () (BS.dropSpace bs))+{-# INLINABLE spaces #-}++takeWhile :: (Char -> Bool) -> P ByteString+takeWhile test =+  P (\_ ok bs -> case BS.span test bs of (pre, post) -> ok pre post)+{-# INLINABLE takeWhile #-}++sepBy :: Alternative f => f a -> f s -> f [a]+sepBy a s = sepBy1 a s <|> pure []+{-# INLINEABLE sepBy #-}++sepBy1 :: Alternative f => f a -> f s -> f [a]+sepBy1 a s = go+  where+    go = (:) <$> a <*> ((s *> go) <|> pure [])+{-# INLINABLE sepBy1 #-}++doubleQuoted :: P a -> P a+doubleQuoted p = char '"' *> p <* char '"'+{-# INLINEABLE doubleQuoted #-}++bracketed :: P a -> P a+bracketed p = char '[' *> p <* char ']'+{-# INLINABLE bracketed #-}++parenthesized :: P a -> P a+parenthesized p = char '(' *> p <* char ')'+{-# INLINABLE parenthesized #-}++comma :: P ()+comma = char ','+{-# INLINABLE comma #-}++bool :: P Bool+bool = true <|> false+  where+    true = bytes "True" $> True+    false = bytes "False" $> False+{-# INLINABLE bool #-}++string :: P String+string = BS.unpack <$> doubleQuoted (takeWhile (/= '"'))+{-# INLINABLE string #-}+++-- ------------------------------------------------------------------------+-- Tix parser+-- ------------------------------------------------------------------------++parseTix :: P Tix+parseTix = do+  bytes "Tix" *> spaces+  tix_modules <- bracketed (sepBy tixModule comma)+  pure (Tix tix_modules)++tixModule :: P TixModule+tixModule = do+  spaces *> bytes "TixModule" *> spaces+  name <- string <* spaces+  hash <- fmap toHash int <* spaces+  size <- int <* spaces+  ticks <- bracketed (sepBy integer comma)+  pure (TixModule name hash size ticks)+++-- ------------------------------------------------------------------------+-- Mix parser+-- ------------------------------------------------------------------------++parseMix :: P Mix+parseMix = do+  bytes "Mix" *> spaces+  path <- string <* spaces+  _year <- takeWhile (/= ' ') <* spaces+  _time <- takeWhile (/= ' ') <* spaces+  _zone <- takeWhile (/= ' ') <* spaces+  hash <- fmap toHash int <* spaces+  tabstop <- int <* spaces+  let dummy_date = UTCTime (fromOrdinalDate 1900 1) 0+  Mix path dummy_date hash tabstop <$> mixEntries++mixEntries :: P [MixEntry]+mixEntries = bracketed (sepBy mixEntry comma)+{-# INLINABLE mixEntries #-}++mixEntry :: P MixEntry+mixEntry = parenthesized $ do+  pos <- hpcPos+  comma+  box <- boxLabel+  pure (pos, box)+{-# INLINABLE mixEntry #-}++hpcPos :: P HpcPos+hpcPos = do+  sl <- int+  char ':'+  sc <- int+  char '-'+  el <- int+  char ':'+  ec <- int+  pure (toHpcPos (sl, sc, el, ec))+{-# INLINABLE hpcPos #-}++boxLabel :: P BoxLabel+boxLabel = expBox <|> topLevelBox <|> localBox <|> binBox+  where+    expBox = bytes "ExpBox" *> spaces *> fmap ExpBox bool+    topLevelBox = bytes "TopLevelBox" *> spaces *> fmap TopLevelBox names+    localBox = bytes "LocalBox" *> spaces *> fmap LocalBox names+    binBox = bytes "BinBox" *> spaces *>+             (BinBox <$> (condBox <* spaces) <*> bool)+{-# INLINABLE boxLabel #-}++names :: P [String]+names = bracketed (sepBy string comma)+{-# INLINABLE names #-}++condBox :: P CondBox+condBox = guard <|> cond <|> qual+  where+    guard = bytes "GuardBinBox" $> GuardBinBox+    cond = bytes "CondBinBox" $> CondBinBox+    qual = bytes "QualBinBox" $> QualBinBox+{-# INLINABLE condBox #-}
src/Trace/Hpc/Codecov/Report.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} -- | -- Module:     Trace.Hpc.Codecov.Report--- Copyright:  (c) 2020 8c6794b6+-- Copyright:  (c) 2022 8c6794b6 -- License:    BSD3 -- Maintainer: 8c6794b6 <8c6794b6@gmail.com> --@@ -11,13 +11,16 @@   ( -- * Types     Report(..)   , CoverageEntry(..)+  , Format(..)   , LineHits   , Hit(..)+  , FunctionHits+  , BranchHits      -- * Functions   , genReport   , genCoverageEntries-  , emitCoverageJSON+  , emitCoverage   ) where  -- base@@ -25,7 +28,7 @@ import Control.Monad               (mplus, when) import Control.Monad.ST            (ST) import Data.Function               (on)-import Data.List                   (foldl', intersperse)+import Data.List                   (foldl', intercalate, intersperse) import System.IO                   (IOMode (..), hPutStrLn, stderr, stdout,                                     withFile) #if !MIN_VERSION_base(4,11,0)@@ -34,15 +37,18 @@  -- array import Data.Array.Base             (unsafeAt)-import Data.Array.IArray           (bounds, listArray, range, (!))+import Data.Array.IArray           (assocs, listArray) import Data.Array.MArray           (newArray, readArray, writeArray)-import Data.Array.ST               (STUArray, runSTUArray)+import Data.Array.ST               (STArray, runSTArray) import Data.Array.Unboxed          (UArray)  -- bytestring import Data.ByteString.Builder     (Builder, char7, hPutBuilder, intDec,                                     string7, stringUtf8) +-- containers+import Data.IntMap                 (insertLookupWithKey)+ -- directory import System.Directory            (doesFileExist) @@ -50,13 +56,13 @@ import System.FilePath             ((<.>), (</>))  -- hpc-import Trace.Hpc.Mix               (BoxLabel (..), Mix (..), MixEntry,-                                    readMix)-import Trace.Hpc.Tix               (Tix (..), TixModule (..), readTix)-import Trace.Hpc.Util              (HpcPos, fromHpcPos)+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   -- ------------------------------------------------------------------------@@ -77,9 +83,13 @@  , reportExcludes :: [String]    -- ^ Module name strings to exclude from coverage report.  , reportOutFile  :: Maybe FilePath-   -- ^ Output file to write JSON report, if given.+   -- ^ 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)@@ -89,7 +99,9 @@  instance Monoid Report where   mempty = emptyReport+#if !MIN_VERSION_base(4,16,0)   mappend = mappendReport+#endif  emptyReport :: Report emptyReport = Report@@ -99,64 +111,110 @@   , reportExcludes = []   , reportOutFile = Nothing   , reportVerbose = False+  , reportFormat = Codecov   }  mappendReport :: Report -> Report -> Report mappendReport r1 r2 =-  let extend f = ((<>) `on` f) 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 = (mplus `on` reportOutFile) r1 r2-             , reportVerbose = ((||) `on` reportVerbose) r1 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. ----- See the--- <https://docs.codecov.io/docs/codecov-custom-coverage-format Codecov documentation>--- for detail. 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 -- ^ The line is partially covered.-  | Full    -- ^ The line is fully covered.+  | 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 JSON report to " ++ oname)-     emitCoverageJSON mb_out entries-     say rpt "Done"+genReport rpt = do+  entries <- genCoverageEntries rpt+  let mb_out = reportOutFile rpt+      oname = maybe "stdout" show mb_out+  say rpt ("Writing report to " ++ oname)+  emitCoverage (reportFormat rpt) mb_out entries+  say rpt "Done"  -- | Generate test coverage entries. genCoverageEntries :: Report -> IO [CoverageEntry]-genCoverageEntries rpt =-  readTixFile rpt (reportTix rpt) >>= tixToCoverage rpt+genCoverageEntries rpt = readTixFile rpt (reportTix rpt) >>= tixToCoverage rpt --- | Emit simple coverage JSON data.-emitCoverageJSON ::-  Maybe FilePath -- ^ 'Just' output file name, or 'Nothing' for-                 -- 'stdout'.-  -> [CoverageEntry] -- ^ Coverage entries to write.+-- | Emit simple coverage data.+emitCoverage+  :: Format+  -- ^ Format of the report.+  --+  -- @since 0.4.0.0+  -> Maybe FilePath+  -- ^ 'Just' output file name, or 'Nothing' for 'stdout'.+  -> [CoverageEntry]+  -- ^ Coverage entries to write.   -> IO ()-emitCoverageJSON mb_outfile entries = wrap emit+emitCoverage fmt mb_outfile entries = wrap emit   where     wrap = maybe ($ stdout) (`withFile` WriteMode) mb_outfile-    emit = flip hPutBuilder (buildJSON entries)+    emit = flip hPutBuilder (builder entries)+    builder = case fmt of+      Codecov -> buildJSON+      Lcov    -> buildLcov   -- ------------------------------------------------------------------------@@ -180,29 +238,90 @@     dquote x = char7 '"' <> x <> char7 '"'     braced x = char7 '{' <> x <> char7 '}'     listify xs = mconcat (intersperse comma xs)-    comma = char7 ','     hit (n, tag) =       case tag of-        Missed  -> k <> char7 '0'-        Partial -> k <> dquote (char7 '1' <> char7 '/' <> char7 '2')-        Full    -> k <> char7 '1'+        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)+tixToCoverage rpt (Tix tms) =+  mapM (tixModuleToCoverage rpt) (excludeModules rpt tms)  tixModuleToCoverage :: Report -> TixModule -> IO CoverageEntry-tixModuleToCoverage rpt tm@(TixModule name _hash _count _ixs) =-  do say rpt ("Search mix:   " ++ name)-     Mix path _ _ _ entries <- readMixFile (reportMixDirs rpt) tm-     say rpt ("Found mix:    "++ path)-     let Info _ min_line max_line hits = makeInfo tm entries-         lineHits = makeLineHits min_line max_line hits-     path' <- ensureSrcPath rpt path-     return (CoverageEntry { ce_filename = path'-                           , ce_hits = lineHits })+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]@@ -217,21 +336,21 @@ -- | Read tix file from file path, return a 'Tix' data or throw -- a 'TixNotFound' exception. readTixFile :: Report -> FilePath -> IO Tix-readTixFile rpt path =-  do mb_tix <- readTix path-     case mb_tix of-       Nothing  -> throwIO (TixNotFound path)-       Just tix -> say rpt ("Found tix file: " ++ path) >> return tix+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 (readMix dirs (Right tm))+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.@@ -239,59 +358,82 @@ ensureSrcPath rpt path = go [] (reportSrcDirs rpt)   where     go acc [] = throwIO (SrcNotFound path acc)-    go acc (dir:dirs) =-      do let path' = dir </> path-         exist <- doesFileExist path'-         if exist-            then do say rpt ("Found source: " ++ path')-                    return path'-            else go (path':acc) dirs+    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.+-- | 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-       ![(HpcPos, Tick)] -- ^ Pair of position and hit+       [(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 -> [(HpcPos, Tick)] -> LineHits-makeLineHits min_line max_line hits = ticksToHits (runSTUArray work)+makeLineHits :: Int -> Int -> [(Int, Tick, Count)] -> LineHits+makeLineHits min_line max_line hits = ticksToHits (assocs merged)   where-    work =-      do arr <- newArray (min_line, max_line) ignored-         mapM_ (updateHit arr) hits-         return arr-    updateHit arr (pos, hit) =-      let (ls, _, _, _) = fromHpcPos pos-      in  updateOne arr hit ls-    updateOne :: STUArray s Int Int -> Tick -> Int -> ST s ()-    updateOne arr hit i =-      do prev <- readArray arr i-         writeArray arr i (mergeEntry prev hit)-    mergeEntry prev hit-      | isIgnored prev              = hit-      | isMissed prev, isMissed hit = missed-      | isFull prev, isFull hit     = full-      | otherwise                   = partial+    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 :: UArray Int Tick -> LineHits-ticksToHits arr = foldr f [] (range (bounds arr))+ticksToHits :: [(Int, (Tick, Count))] -> LineHits+ticksToHits = foldr f []   where-    f i acc =-      case arr ! i of-        tck | isIgnored tck -> acc-            | isMissed tck  -> (i, Missed) : acc-            | isFull tck    -> (i, Full) : acc-            | otherwise     -> (i, Partial) : acc+    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@@ -299,47 +441,54 @@ partial = 1 full = 2 -isIgnored :: Int -> Bool+isIgnored :: Tick -> Bool isIgnored = (== ignored) -isMissed :: Int -> Bool+isMissed :: Tick -> Bool isMissed = (== missed) -isFull :: Int -> Bool+isPartial :: Tick -> Bool+isPartial = (== partial)++isFull :: Tick -> Bool isFull = (== full) -notTicked, tickedOnlyTrue, tickedOnlyFalse, ticked :: Tick+notTicked, ticked :: Tick notTicked = missed-tickedOnlyTrue = partial-tickedOnlyFalse = partial ticked = full  -- See also: "utils/hpc/HpcMarkup.hs" in "ghc" git repository.-makeInfo :: TixModule -> [MixEntry] -> Info-makeInfo tm = foldl' f z+makeInfo :: Int -> [Integer] -> [MixEntry] -> Info+makeInfo size tixs = foldl' f z   where-    z = Info 0 maxBound 0 []-    f (Info i min_line max_line acc) (pos, boxLabel) =-      let binBox = case (isTicked i, isTicked (i+1)) of-                     (False, False) -> acc-                     (True,  False) -> (pos, tickedOnlyTrue) : acc-                     (False, True)  -> (pos, tickedOnlyFalse) : acc-                     (True, True)   -> acc-          tickBox = if isTicked i-                       then (pos, ticked) : acc-                       else (pos, notTicked) : acc-          acc' = case boxLabel of-                   ExpBox {}      -> tickBox-                   TopLevelBox {} -> tickBox-                   LocalBox {}    -> tickBox-                   BinBox _ True  -> binBox-                   _              -> acc-          (ls, _, le, _) = fromHpcPos pos-      in Info (i+1) (min ls min_line) (max le max_line) acc'+    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 mix file does not contain out of bound index.-    isTicked n = unsafeAt arr_tix n /= 0+    -- 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 Int+    arr_tix :: UArray Int Tick     arr_tix = listArray (0, size - 1) (map fromIntegral tixs)-    TixModule _name _hash size tixs = tm
test/Test/Main.hs view
@@ -3,46 +3,47 @@ module Test.Main (main) where  -- base-import           Control.Exception          (SomeException (..), try)-import           Control.Monad              (when)-import           Data.List                  (isSubsequenceOf)-import           Data.Maybe                 (fromMaybe, isJust)-import           System.Environment         (getExecutablePath, lookupEnv,-                                             setEnv, unsetEnv, withArgs)-import           System.Exit                (ExitCode)-import           System.IO                  (hClose, openTempFile)+import           Control.Exception           (SomeException (..), try)+import           Control.Monad               (when)+import           Data.List                   (isSubsequenceOf)+import           Data.Maybe                  (fromMaybe, isJust)+import           System.Environment          (getExecutablePath, lookupEnv,+                                              setEnv, unsetEnv, withArgs)+import           System.Exit                 (ExitCode)+import           System.IO                   (hClose, openTempFile)  #if !MIN_VERSION_base(4,11,0)-import           Data.Monoid                ((<>))+import           Data.Monoid                 ((<>)) #endif   -- filepath-import           System.FilePath            (takeFileName, (</>))+import           System.FilePath             (takeFileName, (</>))  -- directory-import           System.Directory           (canonicalizePath,-                                             doesDirectoryExist,-                                             listDirectory,-                                             removeDirectoryRecursive,-                                             removeFile,-                                             withCurrentDirectory)+import           System.Directory            (canonicalizePath,+                                              doesDirectoryExist,+                                              listDirectory,+                                              removeDirectoryRecursive,+                                              removeFile,+                                              withCurrentDirectory)  -- process-import           System.Process             (CreateProcess (..),-                                             callProcess, shell,-                                             waitForProcess,-                                             withCreateProcess)+import           System.Process              (CreateProcess (..),+                                              callProcess, shell,+                                              waitForProcess,+                                              withCreateProcess)  -- tasty-import           Test.Tasty                 (TestTree, defaultMain,-                                             testGroup, withResource)-import           Test.Tasty.HUnit           (assertEqual, assertFailure,-                                             testCase)+import           Test.Tasty                  (TestTree, defaultMain,+                                              testGroup, withResource)+import           Test.Tasty.HUnit            (assertEqual, assertFailure,+                                              testCase)  -- Internal import           Trace.Hpc.Codecov.Discover-import qualified Trace.Hpc.Codecov.Main     as HpcCodecov+import           Trace.Hpc.Codecov.Exception+import qualified Trace.Hpc.Codecov.Main      as HpcCodecov import           Trace.Hpc.Codecov.Report  @@ -65,11 +66,18 @@     , "" ]    defaultMain $ testGroup "main" $-    [reportTest , cmdline, recipReport] +++    [reportTest, cmdline, recipReport, exceptionTest] ++     [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] +exceptionTest :: TestTree+exceptionTest = testGroup "exception"+  [ testCase "NoTarget" $ assertEqual "NoTarget" "NoTarget" (show NoTarget)+  , testCase "TixNotFound" $+    assertEqual "TixNotFound" "TixNotFound \"foo\"" (show (TixNotFound "foo"))+  ]+ reportTest :: TestTree reportTest = testGroup "report"   [ testCase "mempty" $ do@@ -101,6 +109,8 @@               (shouldFail (main' ["foo:tests"]))   , testCase "invalid-test-suite"               (shouldFail (main' ["cabal:no-such-test"]))+  , testCase "invalid-format"+             (shouldFail (main' ["--format=foo"]))   , testCase "help" (main' ["--help"])   , testCase "version" (main' ["--version"])   , testCase "numeric-version" (main' ["--numeric-version"])@@ -114,6 +124,12 @@                     ,"--exclude=NoSuchModule"                     ,"--verbose"                     ,"test/data/reciprocal/reciprocal.tix"])+  , testCase "recip-lcov-data-to-stdout"+             (main' ["--mix=test/data/reciprocal/.hpc"+                    ,"--src=test/data/reciprocal"+                    ,"--verbose"+                    ,"--format=lcov"+                    ,"test/data/reciprocal/reciprocal.tix"])   , testCase "recip-data-no-src"              (shouldFail                 (main' ["--mix=test/data/reciprocal/.hpc"@@ -287,6 +303,12 @@           , "--build=dot-stack-work"           , "stack:project1-test.tix"]           ["--work-dir=dot-stack-work"]+        , t "project1"+          [ "--root=" ++ testData "project1"+          , "--verbose"+          , "--format=lcov"+          , "stack:project1-test"]+          []          , withProject "project1" $             testCase "project1" $@@ -310,7 +332,7 @@ discoverCabalTest :: TestTree discoverCabalTest =   let t = buildAndTestWithCabal-      withProject name act = case getAcquireAndRelease Stack name [] of+      withProject name act = case getAcquireAndRelease Cabal name [] of         (a,r) -> withResource a r (const act)   in  testGroup "discover_cabal"         [ t "project1"@@ -331,6 +353,7 @@                   canonical_tix_path <- canonicalizePath tix_path                   main' [ "--verbose"                         , "-x", "Main,Paths_project1"+                        , "-f", "lcov"                         , "cabal:" ++ canonical_tix_path])         ] 
test/data/project1/src/Lib.hs view
@@ -1,5 +1,6 @@ module Lib     ( someFunc+    , anotherFunc     ) where  someFunc :: Int -> IO ()@@ -7,3 +8,10 @@     if even n       then putStrLn "got even number"       else putStrLn "not a even number"++anotherFunc :: Int -> Int -> Int -> IO ()+anotherFunc a b c+  | 0 < a, 0 < b, 0 < c = putStrLn "all positive"+  | even a, even b, even c = putStrLn "all even"+  | otherwise = pure ()+
test/data/project1/stack.yaml view
@@ -17,8 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml-resolver:-  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/7.yaml+resolver: lts-21.1  # User packages to be built. # Various formats can be used as shown in the example below.
test/data/project1/test/Spec.hs view
@@ -1,4 +1,6 @@ import Lib  main :: IO ()-main = someFunc 42+main = do+  someFunc 42+  anotherFunc 1 2 (-3)