diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,11 @@ +[0.8.0](https://github.com/guillaume-nargeot/hpc-coveralls/issues?q=milestone:v0.8.0+is:closed) +----- +* Introduce retry policy to http requests (issue #31) +* Fix coverage result reading (issue #32) + [0.7.0](https://github.com/guillaume-nargeot/hpc-coveralls/issues?q=milestone:v0.7.0+is:closed) ----- -* Fix coverage conversion rule for otherwise bug +* Fix coverage conversion rule for otherwise (issue #20) [0.6.1](https://github.com/guillaume-nargeot/hpc-coveralls/issues?milestone=8&state=closed) ----- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ hpc-coveralls ============= -[![Build Status](http://img.shields.io/travis/guillaume-nargeot/hpc-coveralls/master.svg)](https://travis-ci.org/guillaume-nargeot/hpc-coveralls) [![Gitter chat](http://img.shields.io/badge/gitter-chat--room-brightgreen.svg)](https://gitter.im/guillaume-nargeot/hpc-coveralls) [![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29) [![v0.7.0 on Hackage](http://img.shields.io/badge/hackage-0.7.0-brightgreen.svg)](http://hackage.haskell.org/package/hpc-coveralls-0.7.0) [![Stories in Ready](https://badge.waffle.io/guillaume-nargeot/hpc-coveralls.png?label=ready&title=Ready)](https://waffle.io/guillaume-nargeot/hpc-coveralls) +[![Build Status](http://img.shields.io/travis/guillaume-nargeot/hpc-coveralls/master.svg)](https://travis-ci.org/guillaume-nargeot/hpc-coveralls) [![Gitter chat](http://img.shields.io/badge/gitter-chat--room-brightgreen.svg)](https://gitter.im/guillaume-nargeot/hpc-coveralls) [![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29) [![v0.8.0 on Hackage](http://img.shields.io/badge/hackage-0.8.0-brightgreen.svg)](http://hackage.haskell.org/package/hpc-coveralls-0.8.0) [![Stories in Ready](https://badge.waffle.io/guillaume-nargeot/hpc-coveralls.png?label=ready&title=Ready)](https://waffle.io/guillaume-nargeot/hpc-coveralls) hpc-coveralls converts and sends Haskell projects hpc code coverage to [coverall.io](http://coveralls.io/). @@ -66,7 +66,7 @@ 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 +run-cabal-test --cabal-name=cabal-1.20 ``` ## The hpc-coveralls command @@ -114,6 +114,10 @@ - `1` : the line is fully covered. Please also note that there is an [open issue](https://github.com/lemurheavy/coveralls-public/issues/216) on coveralls issue tracker in order to improve this (add support for partial line coverage). + +#### --display-report + +This boolean option prints the raw json coverage report to be sent to coveralls.io. #### --dont-send 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.7.0 +version: 0.8.0 synopsis: Coveralls.io support for Haskell. description: This utility converts and sends Haskell projects hpc code coverage to @@ -60,6 +60,7 @@ cmdargs >= 0.10, curl >= 1.3.8, hpc >= 0.6, + retry >= 0.5, safe >= 0.3, split @@ -74,6 +75,7 @@ cmdargs >= 0.10, curl >= 1.3.8, hpc >= 0.6, + retry >= 0.5, safe >= 0.3, split ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns diff --git a/src/HpcCoverallsMain.hs b/src/HpcCoverallsMain.hs --- a/src/HpcCoverallsMain.hs +++ b/src/HpcCoverallsMain.hs @@ -61,5 +61,5 @@ coverageResult <- readCoverageResult url (printResponse hca) case coverageResult of Just totalCoverage -> putStrLn ("Coverage: " ++ totalCoverage) >> exitSuccess - Nothing -> exitSuccess + Nothing -> putStrLn "Failed to read total coverage" >> exitSuccess PostFailure msg -> putStrLn ("Error: " ++ msg) >> exitFailure diff --git a/src/Trace/Hpc/Coveralls/Curl.hs b/src/Trace/Hpc/Coveralls/Curl.hs --- a/src/Trace/Hpc/Coveralls/Curl.hs +++ b/src/Trace/Hpc/Coveralls/Curl.hs @@ -14,6 +14,7 @@ import Control.Applicative import Control.Monad +import Control.Retry import Data.Aeson import Data.Aeson.Types (parseMaybe) import qualified Data.ByteString.Lazy.Char8 as LBS @@ -49,21 +50,34 @@ when printResponse $ 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 + +performWithRetry :: IO (Maybe a) -> IO (Maybe a) +performWithRetry = retrying expRetryPolicy isNothingM + where isNothingM _ = return . isNothing + -- | Extract the total coverage percentage value from coveralls coverage result -- page content. -- The current implementation is kept as low level as possible in order not -- to increase the library build time, by not relying on additional packages. extractCoverage :: String -> Maybe String extractCoverage body = splitOn "<" <$> splitOn prefix body `atMay` 1 >>= headMay - where prefix = "div class='coverage'>\n" + where prefix = "div class='run-statistics'>\n" -- | Read the coveraege result page from coveralls.io readCoverageResult :: URLString -- ^ target url -> Bool -- ^ print json response if true -> IO (Maybe String) -- ^ coverage result -readCoverageResult url printResponse = do - response <- curlGetString url [] - when printResponse $ putStrLn $ snd response - return $ case response of - (CurlOK, body) -> extractCoverage body - _ -> Nothing +readCoverageResult url printResponse = + performWithRetry readAction + where readAction = do + response <- curlGetString url curlOptions + when printResponse $ putStrLn $ snd response + return $ case response of + (CurlOK, body) -> extractCoverage body + _ -> Nothing + where curlOptions = [ + CurlTimeout 60, + CurlConnectTimeout 60]