diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,4 +1,10 @@
+[0.3.0](https://github.com/guillaume-nargeot/hpc-coveralls/issues?milestone=4&state=closed)
+-----
+* Support setting multiple test suites (issue #14)
+* Process --exclude-dir value as a string prefix instead of a regex (issue #16)
+
[0.2.2](https://github.com/guillaume-nargeot/hpc-coveralls/issues?milestone=3&state=closed)
+-----
* Prevent double compilation (issue #11)
* Concurrently process cabal test stdout and stderr channels (issue #12)
* Test with GHC 7.8.2
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
-hpc-coveralls [](https://travis-ci.org/guillaume-nargeot/hpc-coveralls)
+hpc-coveralls [](https://travis-ci.org/guillaume-nargeot/hpc-coveralls) [](https://gitter.im/guillaume-nargeot/hpc-coveralls) [](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29)
=============
hpc-coveralls converts and sends Haskell projects hpc code coverage to [coverall.io](http://coveralls.io/).
@@ -18,7 +18,7 @@
script:
- cabal configure --enable-tests --enable-library-coverage && cabal build && cabal test
after_script:
- - hpc-coveralls [options] [test-suite-name]
+ - hpc-coveralls [options] [test-suite-names]
```
When using a GHC version prior to 7.8, you have to replace the `cabal test` command by `run-cabal-test`, as in the following example:
@@ -29,7 +29,7 @@
- cabal configure --enable-tests --enable-library-coverage && cabal build
- run-cabal-test [options] [cabal-test-options]
after_script:
- - hpc-coveralls [options] [test-suite-name]
+ - hpc-coveralls [options] [test-suite-names]
```
The reason for this is explained in the next section.
@@ -56,10 +56,12 @@
## The hpc-coveralls command
-At the moment, you can specify only one suite. For example, if your test suite is named `test-all`, use the command as follows:
+This command parses the hpc generated output, converts its to Coveralls json format and finally sends it to coveralls.io over http.
+Multiple test suites can be specified, in which case the coverage report will be made of the merged coverage data generated by the specified test suites.
+For example, if your test suite are named `test1` and `test2`, use the command as follows:
```yaml
-hpc-coveralls test-all
+hpc-coveralls test1 test2
```
### Options
@@ -68,13 +70,13 @@
You can exclude source files located under the `test/` by using this option as in the following example:
```yaml
-hpc-coveralls --exclude-dir=test [test-suite-name]
+hpc-coveralls --exclude-dir=test [test-suite-names]
```
You can specify multiple excluded folders by using the following example syntax:
```yaml
-hpc-coveralls --exclude-dir=test1 --exclude-dir=test2 [test-suite-name]
+hpc-coveralls --exclude-dir=test1 --exclude-dir=test2 [test-suite-names]
```
# Limitations
diff --git a/hpc-coveralls.cabal b/hpc-coveralls.cabal
--- a/hpc-coveralls.cabal
+++ b/hpc-coveralls.cabal
@@ -1,5 +1,5 @@
name: hpc-coveralls
-version: 0.2.2
+version: 0.3.0
synopsis: Coveralls.io support for Haskell.
description:
This utility converts and sends Haskell projects hpc code coverage to
@@ -14,7 +14,7 @@
> script:
> - cabal configure --enable-tests --enable-library-coverage && cabal build && cabal test
> after_script:
- > - hpc-coveralls [options] [test-suite-name]
+ > - hpc-coveralls [options] [test-suite-names]
.
Further information can be found in the .
@@ -46,15 +46,17 @@
Trace.Hpc.Coveralls,
Trace.Hpc.Coveralls.Config,
Trace.Hpc.Coveralls.Curl,
+ Trace.Hpc.Coveralls.Types,
+ Trace.Hpc.Paths,
Trace.Hpc.Lix
build-depends:
aeson,
base < 5,
bytestring >= 0.10,
+ containers >= 0.5,
cmdargs >= 0.10,
curl >= 1.3.8,
- hpc >= 0.6.0.0,
- regex-posix
+ hpc >= 0.6.0.0
executable hpc-coveralls
hs-source-dirs: src
@@ -63,10 +65,10 @@
aeson,
base < 5,
bytestring >= 0.10,
+ containers >= 0.5,
cmdargs >= 0.10,
curl >= 1.3.8,
- hpc >= 0.6.0.0,
- regex-posix
+ hpc >= 0.6.0.0
ghc-options: -Wall -fwarn-tabs
executable run-cabal-test
diff --git a/src/HpcCoverallsMain.hs b/src/HpcCoverallsMain.hs
--- a/src/HpcCoverallsMain.hs
+++ b/src/HpcCoverallsMain.hs
@@ -10,7 +10,7 @@
import System.Environment (getEnv, getEnvironment)
import System.Exit (exitFailure, exitSuccess)
import Trace.Hpc.Coveralls
-import Trace.Hpc.Coveralls.Config
+import Trace.Hpc.Coveralls.Config (Config(Config))
import Trace.Hpc.Coveralls.Curl
urlApiV1 :: String
@@ -36,8 +36,8 @@
toConfig :: HpcCoverallsArgs -> Maybe Config
toConfig hca = case testSuites hca of
- [testSuite] -> Just $ Config [testSuite] (excludeDirs hca)
- _ -> Nothing
+ [] -> Nothing
+ testSuiteNames -> Just $ Config testSuiteNames (excludeDirs hca)
main :: IO ()
main = do
diff --git a/src/Trace/Hpc/Coveralls.hs b/src/Trace/Hpc/Coveralls.hs
--- a/src/Trace/Hpc/Coveralls.hs
+++ b/src/Trace/Hpc/Coveralls.hs
@@ -14,34 +14,15 @@
import Data.Aeson
import Data.Aeson.Types ()
import Data.List
+import qualified Data.Map.Strict as M
import System.Exit (exitFailure)
-import Text.Regex.Posix
import Trace.Hpc.Coveralls.Config
+import Trace.Hpc.Coveralls.Types
import Trace.Hpc.Lix
import Trace.Hpc.Mix
+import Trace.Hpc.Paths
import Trace.Hpc.Tix
-type CoverageData = (
- String, -- source file path
- String, -- file source code
- Mix, -- module index data
- TixModule) -- tixs recorded by hpc
-
--- single file coverage data in the format defined by coveralls.io
-type SimpleCoverage = [CoverageEntry]
-
--- Is there a way to restrict this to only Number and Null?
-type CoverageEntry = Value
-
-hpcDir :: String
-hpcDir = "dist/hpc/"
-
-tixDir :: String
-tixDir = hpcDir ++ "tix/"
-
-mixDir :: String
-mixDir = hpcDir ++ "mix/"
-
lixToSimpleCoverage :: Lix -> SimpleCoverage
lixToSimpleCoverage = map conv
where conv Full = Number 2
@@ -52,47 +33,67 @@
toSimpleCoverage :: Int -> [(MixEntry, Integer)] -> SimpleCoverage
toSimpleCoverage lineCount = lixToSimpleCoverage . toLix lineCount
-coverageToJson :: CoverageData -> Value
-coverageToJson (filePath, source, mix, tix) = object [
+coverageToJson :: FilePath -> ModuleCoverageData -> Value
+coverageToJson filePath (source, mix, tixs) = object [
"name" .= filePath,
"source" .= source,
"coverage" .= coverage]
where coverage = toSimpleCoverage lineCount mixEntryTixs
lineCount = length $ lines source
- mixEntryTixs = zip (getMixEntries mix) (tixModuleTixs tix)
+ mixEntryTixs = zip (getMixEntries mix) tixs
getMixEntries (Mix _ _ _ _ mixEntries) = mixEntries
-toCoverallsJson :: String -> String -> [CoverageData] -> Value
-toCoverallsJson serviceName jobId coverageData = object [
+toCoverallsJson :: String -> String -> TestSuiteCoverageData -> Value
+toCoverallsJson serviceName jobId testSuiteCoverageData = object [
"service_job_id" .= jobId,
"service_name" .= serviceName,
- "source_files" .= map coverageToJson coverageData]
+ "source_files" .= toJsonCoverageList testSuiteCoverageData]
+ where toJsonCoverageList = map (uncurry coverageToJson) . M.toList
matchAny :: [String] -> String -> Bool
-matchAny patterns fileName = any (fileName =~) $ map ("^" ++) patterns
+matchAny patterns fileName = any (`isPrefixOf` fileName) patterns
+getMixPath :: String -> String -> FilePath
+getMixPath testSuiteName modName = mixDir ++ dirName ++ "/"
+ where dirName = case span (/= '/') modName of
+ (_, []) -> testSuiteName
+ (packageId, _) -> packageId
+
+mergeModuleCoverageData :: ModuleCoverageData -> ModuleCoverageData -> ModuleCoverageData
+mergeModuleCoverageData (source, mix, tixs1) (_, _, tixs2) =
+ (source, mix, zipWith (+) tixs1 tixs2)
+
+mergeCoverageData :: [TestSuiteCoverageData] -> TestSuiteCoverageData
+mergeCoverageData = foldr1 (M.unionWith mergeModuleCoverageData)
+
readMix' :: String -> TixModule -> IO Mix
readMix' name tix = readMix [mixPath] (Right tix)
- where mixPath = mixDir ++ dirName ++ "/"
- dirName = case span (/= '/') modName of
- (_, []) -> name
- (packageId, _) -> packageId
+ where mixPath = getMixPath name modName
TixModule modName _ _ _ = tix
+getTixPath :: String -> IO FilePath
+getTixPath testSuiteName = return $ tixDir ++ testSuiteName ++ "/" ++ getTixFileName testSuiteName
+
-- | Create a list of coverage data from the tix input
-toCoverageData :: String -- ^ test suite name
- -> Tix -- ^ tix data
- -> [String] -- ^ excluded source folders
- -> IO [CoverageData] -- ^ coverage data list
-toCoverageData testSuiteName (Tix tixs) excludeDirPatterns = do
- mixs <- mapM (readMix' testSuiteName) tixs
- let files = map filePath mixs
- sources <- mapM readFile files
- let coverageDataList = zip4 files sources mixs tixs
- return $ filter sourceDirFilter coverageDataList
- where filePath (Mix fp _ _ _ _) = fp
- sourceDirFilter = not . matchAny excludeDirPatterns . fst4
- fst4 (x, _, _, _) = x
+readCoverageData :: String -- ^ test suite name
+ -> [String] -- ^ excluded source folders
+ -> IO TestSuiteCoverageData -- ^ coverage data list
+readCoverageData testSuiteName excludeDirPatterns = do
+ tixPath <- getTixPath testSuiteName
+ mtix <- readTix tixPath
+ case mtix of
+ Nothing -> error ("Couldn't find the file " ++ tixPath) >> exitFailure
+ Just (Tix tixs) -> do
+ mixs <- mapM (readMix' testSuiteName) tixs
+ let files = map filePath mixs
+ sources <- mapM readFile files
+ let coverageDataList = zip4 files sources mixs (map tixModuleTixs tixs)
+ let filteredCoverageDataList = filter sourceDirFilter coverageDataList
+ return $ M.fromList $ map toFirstAndRest filteredCoverageDataList
+ where filePath (Mix fp _ _ _ _) = fp
+ sourceDirFilter = not . matchAny excludeDirPatterns . fst4
+ fst4 (x, _, _, _) = x
+ toFirstAndRest (a, b, c, d) = (a, (b, c, d))
-- | Generate coveralls json formatted code coverage from hpc coverage data
generateCoverallsFromTix :: String -- ^ CI name
@@ -100,11 +101,7 @@
-> Config -- ^ hpc-coveralls configuration
-> IO Value -- ^ code coverage result in json format
generateCoverallsFromTix serviceName jobId config = do
- mtix <- readTix tixPath
- case mtix of
- Nothing -> error ("Couldn't find the file " ++ tixPath) >> exitFailure
- Just tixs -> do
- coverageDatas <- toCoverageData testSuiteName tixs (excludedDirs config)
- return $ toCoverallsJson serviceName jobId coverageDatas
- where tixPath = tixDir ++ testSuiteName ++ "/" ++ getTixFileName testSuiteName
- testSuiteName = head (testSuiteNames config) -- multiple test suite mode is supported at the moment
+ testSuitesCoverages <- mapM (`readCoverageData` excludedDirPatterns) testSuiteNames
+ return $ toCoverallsJson serviceName jobId $ mergeCoverageData testSuitesCoverages
+ where excludedDirPatterns = excludedDirs config
+ testSuiteNames = testSuites config
diff --git a/src/Trace/Hpc/Coveralls/Config.hs b/src/Trace/Hpc/Coveralls/Config.hs
--- a/src/Trace/Hpc/Coveralls/Config.hs
+++ b/src/Trace/Hpc/Coveralls/Config.hs
@@ -1,6 +1,6 @@
module Trace.Hpc.Coveralls.Config where
data Config = Config {
- testSuiteNames :: [String],
- excludedDirs :: [String]
+ testSuites :: [String],
+ excludedDirs :: [FilePath]
}
diff --git a/src/Trace/Hpc/Coveralls/Types.hs b/src/Trace/Hpc/Coveralls/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Trace/Hpc/Coveralls/Types.hs
@@ -0,0 +1,28 @@
+-- |
+-- Module: Trace.Hpc.Coveralls.Types
+-- Copyright: (c) 2014 Guillaume Nargeot
+-- License: BSD3
+-- Maintainer: Guillaume Nargeot
+-- Stability: experimental
+--
+-- Types to represent code coverage data hpc.
+
+module Trace.Hpc.Coveralls.Types where
+
+import Data.Aeson.Types (Value)
+import qualified Data.Map as M
+import Trace.Hpc.Mix
+
+type ModuleCoverageData = (
+ String, -- file source code
+ Mix, -- module index data
+ [Integer]) -- tixs recorded by hpc
+
+type TestSuiteCoverageData = M.Map FilePath ModuleCoverageData
+
+-- single file coverage data in the format defined by coveralls.io
+type SimpleCoverage = [CoverageEntry]
+
+-- Is there a way to restrict this to only Number and Null?
+type CoverageEntry = Value
+
diff --git a/src/Trace/Hpc/Paths.hs b/src/Trace/Hpc/Paths.hs
new file mode 100644
--- /dev/null
+++ b/src/Trace/Hpc/Paths.hs
@@ -0,0 +1,19 @@
+-- |
+-- Module: Trace.Hpc.Paths
+-- Copyright: (c) 2014 Guillaume Nargeot
+-- License: BSD3
+-- Maintainer: Guillaume Nargeot
+-- Stability: experimental
+--
+-- Paths constants for hpc coverage report output.
+
+module Trace.Hpc.Paths where
+
+hpcDir :: FilePath
+hpcDir = "dist/hpc/"
+
+tixDir :: FilePath
+tixDir = hpcDir ++ "tix/"
+
+mixDir :: FilePath
+mixDir = hpcDir ++ "mix/"