codecov-haskell (empty) → 0.1.0

raw patch · 16 files changed

+740/−0 lines, 16 filesdep +HUnitdep +aesondep +asyncsetup-changed

Dependencies added: HUnit, aeson, async, base, bytestring, cmdargs, codecov-haskell, containers, curl, hpc, process, regex-posix, safe, split

Files

• CHANGELOG.md +3/−0
• LICENSE +30/−0
• README.md +128/−0
• Setup.hs +2/−0
• codecov-haskell.cabal +100/−0
• src/CodecovHaskellCmdLine.hs +29/−0
• src/CodecovHaskellMain.hs +53/−0
• src/RunCabalTestMain.hs +62/−0
• src/Trace/Hpc/Codecov.hs +111/−0
• src/Trace/Hpc/Codecov/Config.hs +6/−0
• src/Trace/Hpc/Codecov/Curl.hs +46/−0
• src/Trace/Hpc/Codecov/Lix.hs +47/−0
• src/Trace/Hpc/Codecov/Paths.hs +31/−0
• src/Trace/Hpc/Codecov/Types.hs +33/−0
• src/Trace/Hpc/Codecov/Util.hs +43/−0
• test/TestAll.hs +16/−0

@@ -0,0 +1,3 @@+0.1.0+-----+* Initial release

@@ -0,0 +1,30 @@+Copyright (c) 2014, Guillaume Nargeot++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Guillaume Nargeot nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,128 @@+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 converts and sends Haskell projects hpc code coverage to [codecov.io](http://codecov.io/).++At the moment, only [Travis CI](http://travis-ci.org) has been tested, but codecov-haskell should be compatible with other CI services in the near future.++codecov-haskell is still under development and any contributions are welcome!++# Usage++## Travis CI++Below is the simplest example of configuration for your project `.travis.yml`:+```yaml+script:+  - cabal configure --enable-tests --enable-library-coverage && cabal build && cabal test+after_script:+  - cabal install codecov-haskell+  - codecov-haskell [options] [test-suite-names]+```++If your build fails during the test phase with an error message starting by "hpc:", just replace the `cabal test` command by `run-cabal-test`, as in the following example:+```yaml+before_install:+  - cabal install codecov-haskell+script:+  - cabal configure --enable-tests --enable-library-coverage && cabal build+  - run-cabal-test [options] [cabal-test-options]+after_script:+  - codecov-haskell [options] [test-suite-names]+```++This will prevent the build to fail because of hpc related reasons, which are usually not fatal and should not affect the coverage data. Details are available in the next section.++You may also experience some issues related to your project dependencies, which can be solved by using the `--avoid-reinstalls`/`--force-reinstalls` flags.</br>+Another way to solve problems related dependencies is to install codecov-haskell in a sandbox, as in the example below:+```yaml+  - cabal sandbox init && cabal install codecov-haskell+  - .cabal-sandbox/bin/codecov-haskell [options] [test-suite-names]+```++## The run-cabal-test command++Under certain conditions related to the project structure and the version of hpc, `cabal test` may output an error message and exit with the error code `1`, which would result in a build failure.<br/>++To prevent this from happening, codecov-haskell provides the `run-cabal-test` command which runs `cabal test` and returns with `0` if the following regular expression never matches any line of the output:++```perl+/^Test suite .*: FAIL$/+```++Below are some of the conditions under which you will likely need to use `run-cabal-test`:+- when using GHC 7.6 (hpc 0.6 known issue)+- when using GHC 7.8 with multiple test suites covering the same module(s)++### Options++The `--cabal-name` option can be used to specify a custom executable name instead of the default `cabal` when calling `cabal test`.<br/>+Below is an example which can be useful for projects with a Travis configuration based on [multi-ghc-travis](https://github.com/hvr/multi-ghc-travis):++```yaml+run-cabal-test --cabal-name=cabal-1.18+```++## The codecov-haskell command++This command parses the hpc generated output, converts its to Codecov json format and finally sends it to codecov.io over http.<br/>+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.<br/>+For example, if your test suite are named `test1` and `test2`, use the command as follows:++```yaml+codecov-haskell test1 test2+```++### Options++#### --exclude-dir++The `--exclude-dir` option allows to exclude source files located under a given directory from the coverage report.<br/>+You can exclude source files located under the `test/` directory by using this option as in the following example:++```yaml+codecov-haskell --exclude-dir=test [test-suite-names]+```++You can specify multiple excluded folders by using the following example syntax:++```yaml+codecov-haskell --exclude-dir=test1 --exclude-dir=test2 [test-suite-names]+```++#### --dont-send++This boolean option prevents codecov-haskell from sending the coverage report to codecov.io.+This option can be used together with `--display-report` for testing purpose.<br/>+For example, you can try various combinations of the other options and confirm the difference in the resulting report outputs.++#### --print-response++This boolean option prints the raw json response received after posting the coverage report to codecov.io.++# Limitations++## Total coverage++Because of the way hpc works, coverage data is only generated for modules that are referenced directly or indirectly by the test suites.+As a result, the total package coverage computed by Codecov may be higher than what it really is.+An option will be added soon in order to allow specifying source folders to include in the total coverage computation.++## Expression level coverage++Even though hpc supports expression level coverage, this version of codecov-haskell does not support it yet, but this feature will be implemented soon.+Meanwhile, the hpc coverage information is converted into a line based report, in which a line can be: fully covered (green), partially covered (yellow) and not covered (red).++# Contributing++codecov-haskell is still under development and any contributions are welcome!++Please share your comments and suggestions on codecov-haskell [Gitter channel](https://gitter.im/guillaume-nargeot/codecov-haskell)!++# License++BSD3 ([tl;dr](https://tldrlegal.com/license/bsd-3-clause-license-(revised)))++# Notes++- HPC publication: http://ittc.ku.edu/~andygill/papers/Hpc07.pdf

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,100 @@+name:           codecov-haskell+version:        0.1.0+synopsis:       Codecov.io support for Haskell.+description:+  This utility converts and sends Haskell projects hpc code coverage to+  <http://codecov.io/ codecov.io>.+  .+  /Usage/+  .+  Below is the simplest example of .travis.yml configuration to use with Travis CI:+  .+  > language: haskell+  > ghc: 7.8+  > script:+  >   - cabal configure --enable-tests --enable-library-coverage && cabal build && cabal test+  > after_script:+  >   - cabal install codecov-haskell+  >   - codecov-haskell [options] [test-suite-names]+  .+  Further information can be found in the <https://github.com/guillaume-nargeot/codecov-haskell README>.++license:        BSD3+license-file:   LICENSE+author:         Guillaume Nargeot+maintainer:     Guillaume Nargeot <guillaume+hackage@nargeot.com>+copyright:      (c) 2014 Guillaume Nargeot+category:       Control+build-type:     Simple+stability:      experimental+cabal-version:  >= 1.8+tested-with:    GHC == 7.6, GHC == 7.8+homepage:       https://github.com/guillaume-nargeot/codecov-haskell+bug-reports:    https://github.com/guillaume-nargeot/codecov-haskell/issues++extra-source-files:+  README.md,+  CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/guillaume-nargeot/codecov-haskell.git++library+  hs-source-dirs: src+  exposed-modules:+    Trace.Hpc.Codecov,+    Trace.Hpc.Codecov.Lix,+    Trace.Hpc.Codecov.Types,+    Trace.Hpc.Codecov.Util+  other-modules:+    CodecovHaskellCmdLine,+    Trace.Hpc.Codecov.Config,+    Trace.Hpc.Codecov.Curl,+    Trace.Hpc.Codecov.Paths+  build-depends:+    aeson,+    base >=4 && < 5,+    bytestring >= 0.10,+    containers >= 0.5,+    cmdargs >= 0.10,+    curl >= 1.3.8,+    hpc >= 0.6,+    safe >= 0.3,+    split++executable codecov-haskell+  hs-source-dirs: src+  main-is:        CodecovHaskellMain.hs+  build-depends:+    aeson,+    base >= 4 && < 5,+    bytestring >= 0.10,+    containers >= 0.5,+    cmdargs >= 0.10,+    curl >= 1.3.8,+    hpc >= 0.6,+    safe >= 0.3,+    split+  ghc-options:    -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns++executable run-cabal-test+  hs-source-dirs: src+  main-is:        RunCabalTestMain.hs+  build-depends:+    async >= 2.0,+    base >=4 && < 5,+    process,+    regex-posix,+    split+  ghc-options:    -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns++test-suite test-all+  hs-source-dirs: test+  type:           exitcode-stdio-1.0+  main-is:        TestAll.hs+  build-depends:+    base,+    codecov-haskell,+    HUnit+  ghc-options:    -Wall

@@ -0,0 +1,29 @@+{-# LANGUAGE DeriveDataTypeable #-}++module CodecovHaskellCmdLine where++import Data.List+import Data.Version (Version(..))+import Paths_codecov_haskell (version)+import System.Console.CmdArgs++data CodecovHaskellArgs = CmdMain+    { token         :: Maybe String+    , excludeDirs   :: [String]+    , testSuites    :: [String]+    , displayReport :: Bool+    , printResponse :: Bool+    , dontSend      :: Bool+    } deriving (Data, Show, Typeable)++codecovHaskellArgs :: CodecovHaskellArgs+codecovHaskellArgs = CmdMain+    { token         = Nothing &= explicit &= typDir     &= name "token"          &= help "Codecov token for this repository"+    , excludeDirs   = []      &= explicit &= typDir     &= name "exclude-dir"    &= help "Exclude sources files under the matching directory from the coverage report"+    , displayReport = False   &= explicit               &= name "display-report" &= help "Display the json code coverage report that will be sent to codecov.io"+    , printResponse = False   &= explicit               &= name "print-response" &= help "Prints the json reponse received from codecov.io"+    , dontSend      = False   &= explicit               &= name "dont-send"      &= help "Do not send the report to codecov.io"+    , testSuites    = []      &= typ "TEST-SUITE" &= args+    } &= summary ("codecov-haskell-" ++ versionString version ++ ", (C) Guillaume Nargeot 2014")+      &= program "codecov-haskell"+    where versionString = intercalate "." . map show . versionBranch

@@ -0,0 +1,53 @@+module Main where++import           Control.Applicative+import           Control.Monad+import           Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as BSL+import           Data.List+import           Data.Maybe+import           CodecovHaskellCmdLine+import           System.Console.CmdArgs+import           System.Environment (getEnv, getEnvironment)+import           System.Exit (exitFailure, exitSuccess)+import           Trace.Hpc.Codecov+import           Trace.Hpc.Codecov.Config (Config(Config))+import           Trace.Hpc.Codecov.Curl++baseUrlApiV1 :: String+baseUrlApiV1 = "https://codecov.io/upload/v1"++getUrlApiV1 :: IO String+getUrlApiV1 = do+    env <- getEnvironment+    case snd <$> find (isJust . flip lookup env . fst) ciEnvVars of+        Just ((idParamName, idParamEnvVar), commitEnvVar, branchEnvVar) -> do+            idParamValue <- getEnv idParamEnvVar+            commit <- getEnv commitEnvVar+            branch <- getEnv branchEnvVar+            return $ baseUrlApiV1 ++ "?" ++ idParamName ++ "=" ++ idParamValue ++ "&commit=" ++ commit ++ "&branch=" ++ branch+        _ -> error "Unsupported CI service."+    where ciEnvVars = [+           ("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)++main :: IO ()+main = do+    cha <- cmdArgs codecovHaskellArgs+    case getConfig cha of+        Nothing -> putStrLn "Please specify a target test suite name" >> exitSuccess+        Just config -> do+            codecovJson <- generateCodecovFromTix config+            when (displayReport cha) $ BSL.putStrLn $ encode codecovJson+            unless (dontSend cha) $ do+                apiUrl <- getUrlApiV1+                response <- postJson (BSL.unpack $ encode codecovJson) apiUrl (printResponse cha)+                case response of+                    PostSuccess url totalCoverage -> do+                        putStrLn ("URL: " ++ url)+                        putStrLn ("Coverage: " ++ totalCoverage)+                    PostFailure msg -> putStrLn ("Error: " ++ msg) >> exitFailure

@@ -0,0 +1,62 @@+module Main where++import Control.Concurrent.Async (Async, async, waitBoth)+import Control.Monad+import Data.List+import Data.List.Split+import GHC.IO.Handle+import System.IO (hPutStrLn, stdout, stderr)+import System.Exit (exitFailure, exitSuccess)+import System.Environment (getArgs)+import System.Process+import Text.Regex.Posix++defaultCabalName :: String+defaultCabalName = "cabal"++isTestFailure :: String -> Bool+isTestFailure line = line =~ "^Test suite .*: FAIL$"++readLines :: Handle -> Handle -> IO [String]+readLines hIn hOut = do+    isEOF <- hIsEOF hIn+    if isEOF+        then return []+        else do+            x <- hGetLine hIn+            hPutStrLn hOut x+            xs <- readLines hIn hOut+            return (x : xs)++checkFailure :: Handle -> Handle -> IO (Async Bool)+checkFailure hIn = async . liftM (not . any isTestFailure) . readLines hIn++runCabalTest :: String -> [String] -> IO Bool+runCabalTest cabalName args = do+    (_, out, err, _) <- runInteractiveCommand (cabalName ++ " test " ++ unwords args)+    aOutResult <- checkFailure out stdout+    aErrResult <- checkFailure err stderr+    results <- waitBoth aOutResult aErrResult+    return $ uncurry (&&) results++getCabalName :: [String] -> Maybe String+getCabalName [] = Just defaultCabalName+getCabalName [arg] = case splitOn "=" arg of+    (_ : cabalName : _) -> Just cabalName+    _ -> Nothing+getCabalName _ = Nothing++main :: IO ()+main = do+    cmdArgs <- getArgs+    case cmdArgs of+        ["--help"] -> usage >> exitSuccess+        ["-h"] -> usage >> exitSuccess+        options -> case mCabalName of+            Just cabalName -> do+                result <- runCabalTest cabalName cabalTestArgs+                if result then exitSuccess else exitFailure+            Nothing -> usage >> exitFailure+            where (runCabalTestArgs, cabalTestArgs) = partition (=~ "^--cabal-name=.*") options+                  mCabalName = getCabalName runCabalTestArgs+    where usage = putStrLn "Usage: run-cabal-test [run-cabal-test-options] [cabal-test-options]"

@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module:      Trace.Hpc.Codecov+-- Copyright:   (c) 2014 Guillaume Nargeot+-- License:     BSD3+-- Maintainer:  Guillaume Nargeot <guillaume+hackage@nargeot.com>+-- Stability:   experimental+--+-- Functions for converting and sending hpc output to codecov.io.++module Trace.Hpc.Codecov ( generateCodecovFromTix ) where++import           Data.Aeson+import           Data.Aeson.Types ()+import           Data.List+import qualified Data.Map.Strict as M+import           System.Exit (exitFailure)+import           Trace.Hpc.Codecov.Config+import           Trace.Hpc.Codecov.Lix+import           Trace.Hpc.Codecov.Paths+import           Trace.Hpc.Codecov.Types+import           Trace.Hpc.Codecov.Util+import           Trace.Hpc.Mix+import           Trace.Hpc.Tix+import           Trace.Hpc.Util++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 codecov.io+type SimpleCoverage = [CoverageValue]++-- Is there a way to restrict this to only Number and Null?+type CoverageValue = Value++type LixConverter = Lix -> SimpleCoverage++defaultConverter :: LixConverter+defaultConverter = map $ \lix -> case lix of+    Full       -> Number 1+    Partial    -> Bool True+    None       -> Number 0+    Irrelevant -> Null++toSimpleCoverage :: LixConverter -> Int -> [CoverageEntry] -> SimpleCoverage+toSimpleCoverage convert lineCount = (:) Null . convert . toLix lineCount++getExprSource :: [String] -> MixEntry -> [String]+getExprSource source (hpcPos, _) = subSubSeq startCol endCol subLines+    where subLines = subSeq startLine endLine source+          startLine = startLine' - 1+          startCol = startCol' - 1+          (startLine', startCol', endLine, endCol) = fromHpcPos hpcPos++-- TODO possible renaming to "getModuleCoverage"+coverageToJson :: LixConverter -> ModuleCoverageData -> SimpleCoverage+coverageToJson converter (source, mix, tixs) = simpleCoverage+    where simpleCoverage = toSimpleCoverage converter lineCount mixEntryTixs+          lineCount = length $ lines source+          mixEntryTixs = zip3 mixEntries tixs (map getExprSource' mixEntries)+          Mix _ _ _ _ mixEntries = mix+          getExprSource' = getExprSource $ lines source++toCodecovJson :: LixConverter -> TestSuiteCoverageData -> Value+toCodecovJson converter testSuiteCoverageData = object [+    "coverage" .= toJsonCoverageMap testSuiteCoverageData]+    where toJsonCoverageMap = M.map (coverageToJson converter)++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 [getMixPath name tix] (Right tix)++-- | Create a list of coverage data from the tix input+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++-- | Generate codecov json formatted code coverage from hpc coverage data+generateCodecovFromTix :: Config   -- ^ codecov-haskell configuration+                       -> IO Value -- ^ code coverage result in json format+generateCodecovFromTix config = do+    testSuitesCoverages <- mapM (`readCoverageData` excludedDirPatterns) testSuiteNames+    return $ toCodecovJson converter $ mergeCoverageData testSuitesCoverages+    where excludedDirPatterns = excludedDirs config+          testSuiteNames = testSuites config+          converter = defaultConverter

@@ -0,0 +1,6 @@+module Trace.Hpc.Codecov.Config where++data Config = Config {+    testSuites   :: ![String],+    excludedDirs :: ![FilePath]+    }

@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}++-- |+-- Module:      Trace.Hpc.Codecov.Curl+-- Copyright:   (c) 2014 Guillaume Nargeot+-- License:     BSD3+-- Maintainer:  Guillaume Nargeot <guillaume+hackage@nargeot.com>+-- Stability:   experimental+--+-- Functions for sending coverage report files over http.++module Trace.Hpc.Codecov.Curl ( postJson, PostResult (..) ) where++import           Control.Monad+import           Data.Aeson+import           Data.Aeson.Types (parseMaybe)+import qualified Data.ByteString.Lazy.Char8 as LBS+import           Data.Maybe+import           Network.Curl+import           Trace.Hpc.Codecov.Types++parseResponse :: CurlResponse -> PostResult+parseResponse r = case respCurlCode r of+    CurlOK -> PostSuccess (getField "url") (show (getField "coverage" :: Integer) ++ "%")+    _      -> PostFailure $ getField "message"+    where getField fieldName = fromJust $ mGetField fieldName+          mGetField fieldName = do+              result <- decode $ LBS.pack (respBody r)+              parseMaybe (.: fieldName) result++-- | Send json coverage report over HTTP using POST request+postJson :: String        -- ^ json coverage report+         -> URLString     -- ^ target url+         -> Bool          -- ^ print response body if true+         -> IO PostResult -- ^ POST request result+postJson jsonCoverage url printResponse = do+    h <- initialize+    setopt h (CurlPost True)+    setopt h (CurlVerbose True)+    setopt h (CurlURL url)+    setopt h (CurlHttpHeaders ["Content-Type: application/json"])+    setopt h (CurlPostFields [jsonCoverage])+    r <- perform_with_response_ h+    when printResponse $ putStrLn $ respBody r+    return $ parseResponse r

@@ -0,0 +1,47 @@+-- |+-- Module:      Trace.Hpc.Codecov.Lix+-- Copyright:   (c) 2014 Guillaume Nargeot+-- License:     BSD3+-- Maintainer:  Guillaume Nargeot <guillaume+hackage@nargeot.com>+-- Stability:   experimental+-- Portability: portable+--+-- Functions for converting hpc output to line-based code coverage data.++module Trace.Hpc.Codecov.Lix where++import Data.List+import Data.Ord+import Prelude hiding (getLine)+import Trace.Hpc.Codecov.Types+import Trace.Hpc.Codecov.Util+import Trace.Hpc.Mix+import Trace.Hpc.Util++toHit :: [Bool] -> Hit+toHit []  = Irrelevant+toHit [x] = if x then Full else None+toHit xs+    | and xs    = Full+    | or xs     = Partial+    | otherwise = None++getLine :: MixEntry -> Int+getLine = fffst . fromHpcPos . fst+    where fffst (x, _, _, _) = x++toLineHit :: CoverageEntry -> (Int, Bool)+toLineHit (entry, cnt, _source) = (getLine entry - 1, cnt > 0)++adjust :: CoverageEntry -> CoverageEntry+adjust coverageEntry@(mixEntry, _, source) = case (snd mixEntry, source) of+    (BinBox GuardBinBox False, ["otherwise"]) -> (mixEntry, 1, source)+    _ -> coverageEntry++-- | Convert hpc coverage entries into a line based coverage format+toLix :: Int             -- ^ Source line count+      -> [CoverageEntry] -- ^ Mix entries and associated hit count+      -> Lix             -- ^ Line coverage+toLix lineCount entries = map toHit (groupByIndex lineCount sortedLineHits)+    where sortedLineHits = sortBy (comparing fst) lineHits+          lineHits = map (toLineHit . adjust) entries

@@ -0,0 +1,31 @@+-- |+-- Module:      Trace.Hpc.Codecov.Paths+-- Copyright:   (c) 2014 Guillaume Nargeot+-- License:     BSD3+-- Maintainer:  Guillaume Nargeot <guillaume+hackage@nargeot.com>+-- Stability:   experimental+--+-- Paths constants and functions for hpc coverage report output.++module Trace.Hpc.Codecov.Paths where++import Trace.Hpc.Tix++hpcDir :: FilePath+hpcDir = "dist/hpc/"++tixDir :: FilePath+tixDir = hpcDir ++ "tix/"++mixDir :: FilePath+mixDir = hpcDir ++ "mix/"++getMixPath :: String -> TixModule -> FilePath+getMixPath testSuiteName tix = mixDir ++ dirName ++ "/"+    where dirName = case span (/= '/') modName of+              (_, []) -> testSuiteName+              (packageId, _) -> packageId+          TixModule modName _ _ _ = tix++getTixPath :: String -> IO FilePath+getTixPath testSuiteName = return $ tixDir ++ testSuiteName ++ "/" ++ getTixFileName testSuiteName

@@ -0,0 +1,33 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- |+-- Module:      Trace.Hpc.Codecov.Types+-- Copyright:   (c) 2014 Guillaume Nargeot+-- License:     BSD3+-- Maintainer:  Guillaume Nargeot <guillaume+hackage@nargeot.com>+-- Stability:   experimental+--+-- Types to represent hpc code coverage data.++module Trace.Hpc.Codecov.Types where++import Network.Curl+import Trace.Hpc.Mix++type CoverageEntry = (+    MixEntry, -- mix entry+    Integer,  -- tix value+    [String])   -- entry source code++data Hit = Full+         | Partial+         | None+         | Irrelevant+    deriving (Eq, Show)++type Lix = [Hit]++-- | Result to the POST request to codecov.io+data PostResult =+    PostSuccess URLString String -- ^ Codecov job url and total coverage percentage+  | PostFailure String           -- ^ error message

@@ -0,0 +1,43 @@+-- |+-- Module:      Trace.Hpc.Codecov.Util+-- Copyright:   (c) 2014 Guillaume Nargeot+-- License:     BSD3+-- Maintainer:  Guillaume Nargeot <guillaume+hackage@nargeot.com>+-- Stability:   experimental+--+-- Utility functions.++module Trace.Hpc.Codecov.Util where++import Data.List++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))++matchAny :: [String] -> String -> Bool+matchAny patterns fileName = any (`isPrefixOf` fileName) patterns++mapFirst :: (a -> a) -> [a] -> [a]+mapFirst f (x : xs) = f x : xs+mapFirst _ []       = []+ +mapLast :: (a -> a) -> [a] -> [a]+mapLast f [x]      = [f x]+mapLast f (x : xs) = x : mapLast f xs+mapLast _ []       = []++subSeq :: Int -> Int -> [a] -> [a]+subSeq start end = drop start . take end++subSubSeq :: Int -> Int -> [[a]] -> [[a]]+subSubSeq start end = mapFirst (drop start) . mapLast (take end)++groupByIndex :: Int -> [(Int, a)] -> [[a]]+groupByIndex size = take size . flip (++) (repeat []) . groupByIndex' 0 []+    where groupByIndex' _ ys [] = [ys]+          groupByIndex' i ys xx@((xi, x) : xs) = if xi == i+              then groupByIndex' i (x : ys) xs+              else ys : groupByIndex' (i + 1) [] xx

@@ -0,0 +1,16 @@+module Main where++import System.Exit ( exitFailure, exitSuccess )+import Test.HUnit+import TestCodecovHaskellLix+import TestCodecovHaskellUtil++allTests :: [Test]+allTests = [testLix, testUtil]++main :: IO Counts+main = do+    cnt <- runTestTT (test allTests)+    if errors cnt + failures cnt == 0+        then exitSuccess+        else exitFailure