diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ ++[0.2.0](https://github.com/guillaume-nargeot/codcov-haskell/issues?q=milestone:v0.2.0+is:closed) +----- +* Fix coverage conversion rule for otherwise bug (issue #4) + 0.1.0 ----- * Initial release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -codecov-haskell [![Build Status](http://img.shields.io/travis/guillaume-nargeot/codecov-haskell/master.svg)](https://travis-ci.org/guillaume-nargeot/codecov-haskell) [![Gitter chat](http://img.shields.io/badge/gitter-chat--room-brightgreen.svg)](https://gitter.im/guillaume-nargeot/codecov-haskell) [![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29) [![v0.1.0 on Hackage](http://img.shields.io/badge/hackage-0.1.0-brightgreen.svg)](http://hackage.haskell.org/package/codecov-haskell-0.1.0) +codecov-haskell [![Build Status](http://img.shields.io/travis/guillaume-nargeot/codecov-haskell/master.svg)](https://travis-ci.org/guillaume-nargeot/codecov-haskell) [![Gitter chat](http://img.shields.io/badge/gitter-chat--room-brightgreen.svg)](https://gitter.im/guillaume-nargeot/codecov-haskell) [![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29) [![v0.2.0 on Hackage](http://img.shields.io/badge/hackage-0.2.0-brightgreen.svg)](http://hackage.haskell.org/package/codecov-haskell-0.2.0) =============== codecov-haskell converts and sends Haskell projects hpc code coverage to [codecov.io](http://codecov.io/). diff --git a/codecov-haskell.cabal b/codecov-haskell.cabal --- a/codecov-haskell.cabal +++ b/codecov-haskell.cabal @@ -1,5 +1,5 @@ name: codecov-haskell -version: 0.1.0 +version: 0.2.0 synopsis: Codecov.io support for Haskell. description: This utility converts and sends Haskell projects hpc code coverage to diff --git a/src/CodecovHaskellMain.hs b/src/CodecovHaskellMain.hs --- a/src/CodecovHaskellMain.hs +++ b/src/CodecovHaskellMain.hs @@ -5,7 +5,7 @@ import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as BSL import Data.List -import Data.Maybe +import Data.Maybe hiding (listToMaybe) import CodecovHaskellCmdLine import System.Console.CmdArgs import System.Environment (getEnv, getEnvironment) @@ -13,6 +13,7 @@ import Trace.Hpc.Codecov import Trace.Hpc.Codecov.Config (Config(Config)) import Trace.Hpc.Codecov.Curl +import Trace.Hpc.Codecov.Util baseUrlApiV1 :: String baseUrlApiV1 = "https://codecov.io/upload/v1" @@ -31,9 +32,7 @@ ("TRAVIS", (("travis_job_id", "TRAVIS_JOB_ID"), "TRAVIS_COMMIT", "TRAVIS_BRANCH"))] getConfig :: CodecovHaskellArgs -> Maybe Config -getConfig cha = case testSuites cha of - [] -> Nothing - testSuiteNames -> Just $ Config testSuiteNames (excludeDirs cha) +getConfig cha = Config (excludeDirs cha) <$> listToMaybe (testSuites cha) main :: IO () main = do diff --git a/src/Trace/Hpc/Codecov.hs b/src/Trace/Hpc/Codecov.hs --- a/src/Trace/Hpc/Codecov.hs +++ b/src/Trace/Hpc/Codecov.hs @@ -13,6 +13,7 @@ import Data.Aeson import Data.Aeson.Types () +import Data.Function import Data.List import qualified Data.Map.Strict as M import System.Exit (exitFailure) @@ -57,11 +58,17 @@ startCol = startCol' - 1 (startLine', startCol', endLine, endCol) = fromHpcPos hpcPos +groupMixEntryTixs :: [(MixEntry, Integer, [String])] -> [CoverageEntry] +groupMixEntryTixs = map mergeOnLst3 . groupBy ((==) `on` fst . fst3) + where mergeOnLst3 xxs@(x : _) = (map fst3 xxs, map snd3 xxs, trd3 x) + mergeOnLst3 [] = error "mergeOnLst3 appliedTo empty list" + -- TODO possible renaming to "getModuleCoverage" coverageToJson :: LixConverter -> ModuleCoverageData -> SimpleCoverage coverageToJson converter (source, mix, tixs) = simpleCoverage - where simpleCoverage = toSimpleCoverage converter lineCount mixEntryTixs + where simpleCoverage = toSimpleCoverage converter lineCount mixEntriesTixs lineCount = length $ lines source + mixEntriesTixs = groupMixEntryTixs mixEntryTixs mixEntryTixs = zip3 mixEntries tixs (map getExprSource' mixEntries) Mix _ _ _ _ mixEntries = mix getExprSource' = getExprSource $ lines source diff --git a/src/Trace/Hpc/Codecov/Config.hs b/src/Trace/Hpc/Codecov/Config.hs --- a/src/Trace/Hpc/Codecov/Config.hs +++ b/src/Trace/Hpc/Codecov/Config.hs @@ -1,6 +1,6 @@ module Trace.Hpc.Codecov.Config where data Config = Config { - testSuites :: ![String], - excludedDirs :: ![FilePath] + excludedDirs :: ![FilePath], + testSuites :: ![String] } diff --git a/src/Trace/Hpc/Codecov/Lix.hs b/src/Trace/Hpc/Codecov/Lix.hs --- a/src/Trace/Hpc/Codecov/Lix.hs +++ b/src/Trace/Hpc/Codecov/Lix.hs @@ -31,12 +31,22 @@ where fffst (x, _, _, _) = x toLineHit :: CoverageEntry -> (Int, Bool) -toLineHit (entry, cnt, _source) = (getLine entry - 1, cnt > 0) +toLineHit (entries, counts, _source) = (getLine (head entries) - 1, all (> 0) counts) +isOtherwiseEntry :: CoverageEntry -> Bool +isOtherwiseEntry (mixEntries, _, source) = + source == ["otherwise"] && boxLabels == otherwiseBoxLabels + where boxLabels = map snd mixEntries + otherwiseBoxLabels = [ + ExpBox False, + BinBox GuardBinBox True, + BinBox GuardBinBox False] + adjust :: CoverageEntry -> CoverageEntry -adjust coverageEntry@(mixEntry, _, source) = case (snd mixEntry, source) of - (BinBox GuardBinBox False, ["otherwise"]) -> (mixEntry, 1, source) - _ -> coverageEntry +adjust coverageEntry@(mixEntries, tixs, source) = + if isOtherwiseEntry coverageEntry && any (> 0) tixs + then (mixEntries, [1, 1, 1], source) + else coverageEntry -- | Convert hpc coverage entries into a line based coverage format toLix :: Int -- ^ Source line count diff --git a/src/Trace/Hpc/Codecov/Types.hs b/src/Trace/Hpc/Codecov/Types.hs --- a/src/Trace/Hpc/Codecov/Types.hs +++ b/src/Trace/Hpc/Codecov/Types.hs @@ -15,8 +15,8 @@ import Trace.Hpc.Mix type CoverageEntry = ( - MixEntry, -- mix entry - Integer, -- tix value + [MixEntry], -- mix entries + [Integer], -- tix values [String]) -- entry source code data Hit = Full diff --git a/src/Trace/Hpc/Codecov/Util.hs b/src/Trace/Hpc/Codecov/Util.hs --- a/src/Trace/Hpc/Codecov/Util.hs +++ b/src/Trace/Hpc/Codecov/Util.hs @@ -11,11 +11,24 @@ import Data.List +fst3 :: (a, b, c) -> a +fst3 (x, _, _) = x + +snd3 :: (a, b, c) -> b +snd3 (_, x, _) = x + +trd3 :: (a, b, c) -> c +trd3 (_, _, x) = x + fst4 :: (a, b, c, d) -> a fst4 (x, _, _, _) = x toFirstAndRest :: (a, b, c, d) -> (a, (b, c, d)) toFirstAndRest (a, b, c, d) = (a, (b, c, d)) + +listToMaybe :: [a] -> Maybe [a] +listToMaybe [] = Nothing +listToMaybe xs = Just xs matchAny :: [String] -> String -> Bool matchAny patterns fileName = any (`isPrefixOf` fileName) patterns