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 +12/−0
- LICENSE +1/−1
- README.md +21/−17
- hpc-codecov.cabal +14/−7
- src/Trace/Hpc/Codecov/Discover.hs +1/−1
- src/Trace/Hpc/Codecov/Exception.hs +4/−1
- src/Trace/Hpc/Codecov/Main.hs +1/−1
- src/Trace/Hpc/Codecov/Options.hs +23/−4
- src/Trace/Hpc/Codecov/Parser.hs +273/−0
- src/Trace/Hpc/Codecov/Report.hs +273/−124
- test/Test/Main.hs +50/−27
- test/data/project1/src/Lib.hs +8/−0
- test/data/project1/stack.yaml +1/−2
- test/data/project1/test/Spec.hs +3/−1
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 [](https://hackage.haskell.org/package/hpc-codecov) [](https://www.stackage.org/lts/package/hpc-codecov) [](https://codecov.io/gh/8c6794b6/hpc-codecov)-[](https://travis-ci.com/8c6794b6/hpc-codecov) [](https://circleci.com/gh/8c6794b6/hpc-codecov) [](https://ci.appveyor.com/project/8c6794b6/hpc-codecov)-[](https://github.com/8c6794b6/hpc-codecov/actions/workflows/ci.yml)+[](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)