hpc-coveralls 0.8.3 → 0.9.0
raw patch · 8 files changed
+150/−76 lines, 8 filesdep +directorydep +directory-treedep +pureMD5PVP ok
version bump matches the API change (PVP)
Dependencies added: directory, directory-tree, pureMD5
API changes (from Hackage documentation)
Files
- CHANGELOG.md +9/−1
- README.md +9/−7
- hpc-coveralls.cabal +8/−2
- src/HpcCoverallsCmdLine.hs +14/−14
- src/HpcCoverallsMain.hs +15/−11
- src/Trace/Hpc/Coveralls.hs +30/−18
- src/Trace/Hpc/Coveralls/Curl.hs +19/−13
- src/Trace/Hpc/Coveralls/Paths.hs +46/−10
CHANGELOG.md view
@@ -1,3 +1,11 @@+[0.9.0](https://github.com/guillaume-nargeot/hpc-coveralls/issues?q=milestone:v0.9.0+is:closed)+-----+* Fix instructions and target hpc data directory for Cabal 1.22 / GHC 7.10 (issue #38)+* Print hpc coverage data directory tree when failing to read tix file (issue #39)+* Improve handling of coveralls response reading/parsing (issue #41)+* Send "source digest" instead of "source" (issue #43)+* Add --curl-verbose flag to enable curl verbose mode and replace --print-response (issue #42)+ [0.8.3](https://github.com/guillaume-nargeot/hpc-coveralls/issues?q=milestone:v0.8.3+is:closed) ----- * Send git repository info when using other CI services than Travis (issue #37)@@ -21,7 +29,7 @@ [0.6.1](https://github.com/guillaume-nargeot/hpc-coveralls/issues?milestone=8&state=closed) ------* Safer implementation of the result coverage value retrieval from coveralls.io (issue 25)+* Safer implementation of the result coverage value retrieval from coveralls.io (issue #25) * Set the delay before retrieving the result to 10 seconds (issue #26) [0.6.0](https://github.com/guillaume-nargeot/hpc-coveralls/issues?milestone=7&state=closed)
README.md view
@@ -24,7 +24,9 @@ - hpc-coveralls [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:+When building with Cabal 1.22 or a newer version, use the `--enable-coverage` flag instead of `--enable-library-coverage`.++If the 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 hpc-coveralls@@ -67,7 +69,7 @@ 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+```bash run-cabal-test --cabal-name=cabal-1.20 ``` @@ -77,7 +79,7 @@ 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+```bash hpc-coveralls test1 test2 ``` @@ -88,13 +90,13 @@ 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+```bash hpc-coveralls --exclude-dir=test [test-suite-names] ``` You can specify multiple excluded folders by using the following example syntax: -```yaml+```bash hpc-coveralls --exclude-dir=test1 --exclude-dir=test2 [test-suite-names] ``` @@ -131,9 +133,9 @@ 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+#### --curl-verbose -This boolean option prints the raw json response received after posting the coverage report to coveralls.io.+This boolean option enables curl verbose mode and prints the raw json response received after posting the coverage report to coveralls.io. # Limitations
hpc-coveralls.cabal view
@@ -1,5 +1,5 @@ name: hpc-coveralls-version: 0.8.3+version: 0.9.0 synopsis: Coveralls.io support for Haskell. description: This utility converts and sends Haskell projects hpc code coverage to@@ -55,13 +55,16 @@ Trace.Hpc.Coveralls.Paths build-depends: aeson,- base >=4 && < 5,+ base >= 4 && < 5, bytestring >= 0.10, containers >= 0.5, cmdargs >= 0.10, curl >= 1.3.8,+ directory >= 1.2,+ directory-tree >= 0.12, hpc >= 0.6, process >= 1.1.0.1,+ pureMD5 >= 2.1, retry >= 0.5, safe >= 0.3, split@@ -76,8 +79,11 @@ containers >= 0.5, cmdargs >= 0.10, curl >= 1.3.8,+ directory >= 1.2,+ directory-tree >= 0.12, hpc >= 0.6, process >= 1.1.0.1,+ pureMD5 >= 2.1, retry >= 0.5, safe >= 0.3, split
src/HpcCoverallsCmdLine.hs view
@@ -9,24 +9,24 @@ import Trace.Hpc.Coveralls.Types data HpcCoverallsArgs = CmdMain- { excludeDirs :: [String]- , testSuites :: [String]- , repoToken :: Maybe String- , displayReport :: Bool- , printResponse :: Bool- , dontSend :: Bool- , coverageMode :: CoverageMode+ { optExcludeDirs :: [String]+ , argTestSuites :: [String]+ , optRepoToken :: Maybe String+ , optDisplayReport :: Bool+ , optCurlVerbose :: Bool+ , optDontSend :: Bool+ , optCoverageMode :: CoverageMode } deriving (Data, Show, Typeable) hpcCoverallsArgs :: HpcCoverallsArgs hpcCoverallsArgs = CmdMain- { 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 coveralls.io"- , printResponse = False &= explicit &= name "print-response" &= help "Prints the json reponse received from coveralls.io"- , dontSend = False &= explicit &= name "dont-send" &= help "Do not send the report to coveralls.io"- , coverageMode = AllowPartialLines &= explicit &= typ "MODE" &= name "coverage-mode" &= help "Coverage conversion mode: AllowPartialLines (default), StrictlyFullLines"- , repoToken = Nothing &= explicit &= typ "TOKEN" &= name "repo-token" &= help "Coveralls repo token"- , testSuites = [] &= typ "TEST-SUITES" &= args+ { optExcludeDirs = [] &= explicit &= typDir &= name "exclude-dir" &= help "Exclude sources files under the matching directory from the coverage report"+ , optDisplayReport = False &= explicit &= name "display-report" &= help "Display the json code coverage report that will be sent to coveralls.io"+ , optCurlVerbose = False &= explicit &= name "curl-verbose" &= help "Enable curl verbose mode and prints the json response received from coveralls.io"+ , optDontSend = False &= explicit &= name "dont-send" &= help "Do not send the report to coveralls.io"+ , optCoverageMode = AllowPartialLines &= explicit &= typ "MODE" &= name "coverage-mode" &= help "Coverage conversion mode: AllowPartialLines (default), StrictlyFullLines"+ , optRepoToken = Nothing &= explicit &= typ "TOKEN" &= name "repo-token" &= help "Coveralls repo token"+ , argTestSuites = [] &= typ "TEST-SUITES" &= args } &= summary ("hpc-coveralls-" ++ versionString version ++ ", (C) Guillaume Nargeot 2014-2015") &= program "hpc-coveralls" where versionString = intercalate "." . map show . versionBranch
src/HpcCoverallsMain.hs view
@@ -10,7 +10,7 @@ import HpcCoverallsCmdLine import System.Console.CmdArgs import System.Environment (getEnv, getEnvironment)-import System.Exit (exitFailure, exitSuccess)+import System.Exit (exitFailure) import Trace.Hpc.Coveralls import Trace.Hpc.Coveralls.Config (Config(Config)) import Trace.Hpc.Coveralls.Curl@@ -39,29 +39,33 @@ writeJson filePath = BSL.writeFile filePath . encode getConfig :: HpcCoverallsArgs -> Maybe Config-getConfig hca = Config (excludeDirs hca) (coverageMode hca) (repoToken hca) <$> listToMaybe (testSuites hca)+getConfig hca = Config (optExcludeDirs hca) (optCoverageMode hca) (optRepoToken hca) <$> listToMaybe (argTestSuites hca) main :: IO () main = do hca <- cmdArgs hpcCoverallsArgs case getConfig hca of- Nothing -> putStrLn "Please specify a target test suite name" >> exitSuccess+ Nothing -> putStrLn "Please specify a target test suite name" Just config -> do (serviceName, jobId) <- getServiceAndJobID gitInfo <- getGitInfo coverallsJson <- generateCoverallsFromTix serviceName jobId gitInfo config- when (displayReport hca) $ BSL.putStrLn $ encode coverallsJson+ when (optDisplayReport hca) $ BSL.putStrLn $ encode coverallsJson let filePath = serviceName ++ "-" ++ jobId ++ ".json" writeJson filePath coverallsJson- unless (dontSend hca) $ do- response <- postJson filePath urlApiV1 (printResponse hca)+ unless (optDontSend hca) $ do+ response <- postJson filePath urlApiV1 (optCurlVerbose hca) case response of PostSuccess url -> do putStrLn ("URL: " ++ url) -- wait 10 seconds until the page is available- threadDelay (10 * 1000000)- coverageResult <- readCoverageResult url (printResponse hca)+ threadDelay (10 * 1000 * 1000)+ coverageResult <- readCoverageResult url (optCurlVerbose hca) case coverageResult of- Just totalCoverage -> putStrLn ("Coverage: " ++ totalCoverage) >> exitSuccess- Nothing -> putStrLn "Failed to read total coverage" >> exitSuccess- PostFailure msg -> putStrLn ("Error: " ++ msg) >> exitFailure+ Just totalCoverage -> putStrLn ("Coverage: " ++ totalCoverage)+ Nothing -> putStrLn "Failed to read total coverage"+ PostFailure msg -> do+ putStrLn ("Error: " ++ msg)+ putStrLn ("You can get support at " ++ gitterUrl)+ exitFailure+ where gitterUrl = "https://gitter.im/guillaume-nargeot/hpc-coveralls"
src/Trace/Hpc/Coveralls.hs view
@@ -14,6 +14,8 @@ import Control.Applicative import Data.Aeson import Data.Aeson.Types ()+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Digest.Pure.MD5 import Data.Function import Data.List import qualified Data.Map.Strict as M@@ -75,7 +77,7 @@ coverageToJson :: LixConverter -> FilePath -> ModuleCoverageData -> Value coverageToJson converter filePath (source, mix, tixs) = object [ "name" .= filePath,- "source" .= source,+ "source_digest" .= (show . md5 . LBS.pack) source, "coverage" .= coverage] where coverage = toSimpleCoverage converter lineCount mixEntriesTixs lineCount = length $ lines source@@ -102,20 +104,21 @@ mergeCoverageData :: [TestSuiteCoverageData] -> TestSuiteCoverageData mergeCoverageData = foldr1 (M.unionWith mergeModuleCoverageData) -readMix' :: String -> TixModule -> IO Mix-readMix' name tix = readMix [getMixPath name tix] (Right tix)+readMix' :: String -> String -> TixModule -> IO Mix+readMix' hpcDir name tix = readMix [getMixPath hpcDir name tix] (Right tix) -- | Create a list of coverage data from the tix input-readCoverageData :: String -- ^ test suite name+readCoverageData :: String -- ^ hpc data directory -> [String] -- ^ excluded source folders+ -> String -- ^ test suite name -> 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+readCoverageData hpcDir excludeDirPatterns testSuiteName = do+ let tixPath = getTixPath hpcDir testSuiteName+ mTix <- readTix tixPath+ case mTix of+ Nothing -> putStrLn ("Couldn't find the file " ++ tixPath) >> dumpDirectoryTree hpcDir >> ioFailure Just (Tix tixs) -> do- mixs <- mapM (readMix' testSuiteName) tixs+ mixs <- mapM (readMix' hpcDir testSuiteName) tixs let files = map filePath mixs sources <- mapM readFile files let coverageDataList = zip4 files sources mixs (map tixModuleTixs tixs)@@ -131,11 +134,20 @@ -> Config -- ^ hpc-coveralls configuration -> IO Value -- ^ code coverage result in json format generateCoverallsFromTix serviceName jobId gitInfo config = do- testSuitesCoverages <- mapM (`readCoverageData` excludedDirPatterns) testSuiteNames- return $ toCoverallsJson serviceName jobId repoTokenM gitInfo converter $ mergeCoverageData testSuitesCoverages- where excludedDirPatterns = excludedDirs config- testSuiteNames = testSuites config- repoTokenM = repoToken config- converter = case coverageMode config of- StrictlyFullLines -> strictConverter- AllowPartialLines -> looseConverter+ mHpcDir <- firstExistingDirectory hpcDirs+ case mHpcDir of+ Nothing -> putStrLn "Couldn't find the hpc data directory" >> dumpDirectory distDir >> ioFailure+ Just hpcDir -> do+ testSuitesCoverages <- mapM (readCoverageData hpcDir excludedDirPatterns) testSuiteNames+ let coverageData = mergeCoverageData testSuitesCoverages+ return $ toCoverallsJson serviceName jobId repoTokenM gitInfo converter coverageData+ where excludedDirPatterns = excludedDirs config+ testSuiteNames = testSuites config+ repoTokenM = repoToken config+ converter = case coverageMode config of+ StrictlyFullLines -> strictConverter+ AllowPartialLines -> looseConverter++ioFailure :: IO a+ioFailure = putStrLn ("You can get support at " ++ gitterUrl) >> exitFailure+ where gitterUrl = "https://gitter.im/guillaume-nargeot/hpc-coveralls" :: String
src/Trace/Hpc/Coveralls/Curl.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- | -- Module: Trace.Hpc.Coveralls.Curl@@ -25,13 +24,18 @@ import Trace.Hpc.Coveralls.Types parseResponse :: CurlResponse -> PostResult-parseResponse r = case respCurlCode r of- CurlOK -> PostSuccess $ getField "url"- _ -> PostFailure $ getField "message"- where getField fieldName = fromJust $ mGetField fieldName+parseResponse r = case mError of+ Just True -> PostFailure $ fromMaybe ("error message not found. " ++ responseDump) mMessage+ _ -> case respCurlCode r of+ CurlOK -> maybe (PostFailure $ "no url found. " ++ responseDump) PostSuccess mUrl+ _ -> PostFailure $ "curl failure. " ++ responseDump+ where mUrl = mGetField "url"+ mMessage = mGetField "message"+ mError = mGetField "error" mGetField fieldName = do result <- decode $ LBS.pack (respBody r) parseMaybe (.: fieldName) result+ responseDump = "CurlCode: " ++ show (respCurlCode r) ++ ", Body: " ++ show (respBody r) httpPost :: String -> [HttpPost] httpPost path = [HttpPost "json_file" Nothing (ContentFile path) [] Nothing]@@ -41,18 +45,19 @@ -> URLString -- ^ target url -> Bool -- ^ print json response if true -> IO PostResult -- ^ POST request result-postJson path url printResponse = do+postJson path url curlVerbose = do h <- initialize- setopt h (CurlVerbose True)- setopt h (CurlURL url)- setopt h (CurlHttpPost $ httpPost path)+ void $ setopt h (CurlVerbose curlVerbose)+ void $ setopt h (CurlURL url)+ void $ setopt h (CurlHttpPost $ httpPost path) r <- perform_with_response_ h- when printResponse $ putStrLn $ respBody r+ when curlVerbose $ putStrLn $ respBody r return $ parseResponse r -- | Exponential retry policy of 10 seconds initial delay, up to 5 times expRetryPolicy :: RetryPolicy-expRetryPolicy = exponentialBackoff (10 * 1000 * 1000) <> limitRetries 3+expRetryPolicy = exponentialBackoff tenSecondsInMicroSeconds <> limitRetries 3+ where tenSecondsInMicroSeconds = 10 * 1000 * 1000 performWithRetry :: IO (Maybe a) -> IO (Maybe a) performWithRetry = retrying expRetryPolicy isNothingM@@ -70,14 +75,15 @@ readCoverageResult :: URLString -- ^ target url -> Bool -- ^ print json response if true -> IO (Maybe String) -- ^ coverage result-readCoverageResult url printResponse =+readCoverageResult url curlVerbose = performWithRetry readAction where readAction = do response <- curlGetString url curlOptions- when printResponse $ putStrLn $ snd response+ when curlVerbose $ putStrLn $ snd response return $ case response of (CurlOK, body) -> extractCoverage body _ -> Nothing where curlOptions = [+ CurlVerbose curlVerbose, CurlTimeout 60, CurlConnectTimeout 60]
src/Trace/Hpc/Coveralls/Paths.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+ -- | -- Module: Trace.Hpc.Coveralls.Paths -- Copyright: (c) 2014-2015 Guillaume Nargeot@@ -9,23 +11,57 @@ module Trace.Hpc.Coveralls.Paths where +import Control.Monad+-- import Data.Foldable+import Data.Traversable (traverse)+import System.Directory (+ doesDirectoryExist, getDirectoryContents+ )+import System.Directory.Tree (+ AnchoredDirTree(..), dirTree, readDirectoryWith+ ) import Trace.Hpc.Tix -hpcDir :: FilePath-hpcDir = "dist/hpc/"+distDir :: FilePath+distDir = "dist/" -tixDir :: FilePath-tixDir = hpcDir ++ "tix/"+hpcDirs :: [FilePath]+hpcDirs = map (distDir ++) ["hpc/vanilla/", "hpc/"] -mixDir :: FilePath-mixDir = hpcDir ++ "mix/"+tixDir :: String -> FilePath+tixDir = (++ "tix/") -getMixPath :: String -> TixModule -> FilePath-getMixPath testSuiteName tix = mixDir ++ dirName ++ "/"+mixDir :: String -> FilePath+mixDir = (++ "mix/")++getMixPath :: String -> String -> TixModule -> FilePath+getMixPath hpcDir testSuiteName tix = mixDir hpcDir ++ dirName ++ "/" where dirName = case span (/= '/') modName of (_, []) -> testSuiteName (packageId, _) -> packageId TixModule modName _ _ _ = tix -getTixPath :: String -> IO FilePath-getTixPath testSuiteName = return $ tixDir ++ testSuiteName ++ "/" ++ getTixFileName testSuiteName+getTixPath :: String -> String -> FilePath+getTixPath hpcDir testSuiteName = tixDir hpcDir ++ testSuiteName ++ "/" ++ getTixFileName testSuiteName++firstExistingDirectory :: [FilePath] -> IO (Maybe FilePath)+firstExistingDirectory = fmap msum . mapM pathIfExist+ where pathIfExist path = do+ pathExists <- doesDirectoryExist path+ return $ if pathExists then Just path else Nothing++dumpDirectory :: FilePath -> IO ()+dumpDirectory path = do+ directoryExists <- doesDirectoryExist path+ unless directoryExists $ putStrLn ("Couldn't find the directory " ++ path)+ putStrLn ("Dumping " ++ path ++ " directory content:")+ contents <- getDirectoryContents path+ traverse putStrLn contents+ return ()++dumpDirectoryTree :: FilePath -> IO ()+dumpDirectoryTree path = do+ putStrLn ("Dumping " ++ path ++ " directory tree:")+ tree <- readDirectoryWith return path+ traverse putStrLn $ dirTree tree+ return ()