codecov-haskell 0.4.0.2 → 0.5.0
raw patch · 9 files changed
+79/−44 lines, 9 filesdep +retry
Dependencies added: retry
Files
- CHANGELOG.md +4/−0
- README.md +5/−3
- codecov-haskell.cabal +4/−2
- src/CodecovHaskellCmdLine.hs +12/−7
- src/CodecovHaskellMain.hs +7/−1
- src/Trace/Hpc/Codecov.hs +8/−7
- src/Trace/Hpc/Codecov/Config.hs +3/−1
- src/Trace/Hpc/Codecov/Curl.hs +22/−11
- src/Trace/Hpc/Codecov/Paths.hs +14/−12
CHANGELOG.md view
@@ -1,3 +1,7 @@++[0.5.0](https://github.com/guillaume-nargeot/codcov-haskell/issues?q=milestone:v0.5.0+is:closed)+-----+* Adding commandline arguments to allow setting mix and tix paths (issue #12)+ +[0.4.0.2](https://github.com/guillaume-nargeot/codcov-haskell/issues?q=milestone:v0.4.0.2+is:closed) ----- * Introduce retry policy to http requests (issue #6)
README.md view
@@ -1,4 +1,4 @@-codecov-haskell [](https://travis-ci.org/guillaume-nargeot/codecov-haskell) [](https://gitter.im/guillaume-nargeot/codecov-haskell) [](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29) [](http://hackage.haskell.org/package/codecov-haskell-0.3.0)+codecov-haskell [](https://travis-ci.org/guillaume-nargeot/codecov-haskell) [](https://gitter.im/guillaume-nargeot/codecov-haskell) [](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29) [](http://hackage.haskell.org/package/codecov-haskell) =============== codecov-haskell converts and sends Haskell projects hpc code coverage to [codecov.io](http://codecov.io/).@@ -14,6 +14,8 @@ Below is the simplest example of configuration for your project `.travis.yml`: ```yaml+language: haskell+ghc: 7.8 script: - cabal configure --enable-tests --enable-library-coverage && cabal build && cabal test after_script:@@ -69,7 +71,7 @@ post: - codecov-haskell [options] [test-suite-names] ```- + ## Jenkins CI In your build script add the following commands: ```bash@@ -138,7 +140,7 @@ #### --display-report -This boolean option prints the raw json coverage report to be sent to coveralls.io.+This boolean option prints the raw json coverage report to be sent to codecov.io. #### --dont-send
codecov-haskell.cabal view
@@ -1,5 +1,5 @@ name: codecov-haskell-version: 0.4.0.2+version: 0.5.0 synopsis: Codecov.io support for Haskell. description: This utility converts and sends Haskell projects hpc code coverage to@@ -23,7 +23,7 @@ license-file: LICENSE author: Guillaume Nargeot maintainer: Guillaume Nargeot <guillaume+hackage@nargeot.com>-copyright: (c) 2014 Guillaume Nargeot+copyright: (c) 2014-2015 Guillaume Nargeot category: Control build-type: Simple stability: experimental@@ -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
src/CodecovHaskellCmdLine.hs view
@@ -6,12 +6,15 @@ import Data.Version (Version(..)) import Paths_codecov_haskell (version) import System.Console.CmdArgs+import Trace.Hpc.Codecov.Paths (defaultTixDir,defaultMixDir) data CodecovHaskellArgs = CmdMain { token :: Maybe String , accessToken :: Maybe String , excludeDirs :: [String] , testSuites :: [String]+ , tixDir :: FilePath+ , mixDir :: FilePath , displayReport :: Bool , printResponse :: Bool , dontSend :: Bool@@ -19,13 +22,15 @@ codecovHaskellArgs :: CodecovHaskellArgs codecovHaskellArgs = CmdMain- { token = Nothing &= explicit &= typDir &= name "token" &= help "Codecov upload token for this repository"- , accessToken = Nothing &= explicit &= typDir &= name "access-token" &= help "Codecov access token to retrieve reports for private repos"- , 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+ { token = Nothing &= explicit &= typDir &= name "token" &= help "Codecov upload token for this repository"+ , accessToken = Nothing &= explicit &= typDir &= name "access-token" &= help "Codecov access token to retrieve reports for private repos"+ , excludeDirs = [] &= explicit &= typDir &= name "exclude-dir" &= help "Exclude sources files under the matching directory from the coverage report"+ , tixDir = defaultTixDir &= explicit &= typDir &= name "tix-dir" &= help "Exclude sources files under the matching directory from the coverage report"+ , mixDir = defaultMixDir &= explicit &= typDir &= name "mix-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
src/CodecovHaskellMain.hs view
@@ -13,6 +13,7 @@ import System.Exit (exitFailure, exitSuccess) import Trace.Hpc.Codecov import Trace.Hpc.Codecov.Config (Config(Config))+import qualified Trace.Hpc.Codecov.Config as Config import Trace.Hpc.Codecov.Curl import Trace.Hpc.Codecov.Util @@ -39,7 +40,12 @@ getUrlWithToken apiUrl param (Just t) = return $ apiUrl ++ "&" ++ param ++ "=" ++ t getConfig :: CodecovHaskellArgs -> Maybe Config-getConfig cha = Config (excludeDirs cha) <$> listToMaybe (testSuites cha)+getConfig cha = do _testSuites <- listToMaybe (testSuites cha)+ return Config { Config.excludedDirs = excludeDirs cha+ , Config.testSuites = _testSuites+ , Config.tixDir = tixDir cha+ , Config.mixDir = mixDir cha+ } main :: IO () main = do
src/Trace/Hpc/Codecov.hs view
@@ -85,20 +85,21 @@ mergeCoverageData :: [TestSuiteCoverageData] -> TestSuiteCoverageData mergeCoverageData = foldr1 (M.unionWith mergeModuleCoverageData) -readMix' :: String -> TixModule -> IO Mix-readMix' name tix = readMix [getMixPath name tix] (Right tix)+readMix' :: Config -> String -> TixModule -> IO Mix+readMix' config name tix = readMix (getMixPaths config name tix) $ Right tix -- | Create a list of coverage data from the tix input-readCoverageData :: String -- ^ test suite name+readCoverageData :: Config -- ^ codecov-haskell configuration + -> String -- ^ test suite name -> [String] -- ^ excluded source folders -> IO TestSuiteCoverageData -- ^ coverage data list-readCoverageData testSuiteName excludeDirPatterns = do- tixPath <- getTixPath testSuiteName+readCoverageData config testSuiteName excludeDirPatterns = do+ tixPath <- getTixPath config 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+ mixs <- mapM (readMix' config testSuiteName) tixs let files = map filePath mixs sources <- mapM readFile files let coverageDataList = zip4 files sources mixs (map tixModuleTixs tixs)@@ -111,7 +112,7 @@ generateCodecovFromTix :: Config -- ^ codecov-haskell configuration -> IO Value -- ^ code coverage result in json format generateCodecovFromTix config = do- testSuitesCoverages <- mapM (`readCoverageData` excludedDirPatterns) testSuiteNames+ testSuitesCoverages <- mapM (flip (readCoverageData config) excludedDirPatterns) testSuiteNames return $ toCodecovJson converter $ mergeCoverageData testSuitesCoverages where excludedDirPatterns = excludedDirs config testSuiteNames = testSuites config
src/Trace/Hpc/Codecov/Config.hs view
@@ -2,5 +2,7 @@ data Config = Config { excludedDirs :: ![FilePath],- testSuites :: ![String]+ testSuites :: ![String],+ tixDir :: !FilePath,+ mixDir :: !FilePath }
src/Trace/Hpc/Codecov/Curl.hs view
@@ -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@@ -46,6 +47,14 @@ 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+ extractCoverage :: String -> Maybe String extractCoverage rBody = (++ "%") . show <$> (getField "coverage" :: Maybe Integer) where getField fieldName = do@@ -56,14 +65,16 @@ readCoverageResult :: URLString -- ^ target url -> Bool -- ^ print json response if true -> IO (Maybe String) -- ^ coverage result-readCoverageResult url printResponse = 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,- CurlVerbose True,- CurlFollowLocation True]+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,+ CurlVerbose True,+ CurlFollowLocation True]
src/Trace/Hpc/Codecov/Paths.hs view
@@ -10,22 +10,24 @@ module Trace.Hpc.Codecov.Paths where import Trace.Hpc.Tix+import Trace.Hpc.Codecov.Config -hpcDir :: FilePath-hpcDir = "dist/hpc/"+defaultHpcDir :: FilePath+defaultHpcDir = "dist/hpc/" -tixDir :: FilePath-tixDir = hpcDir ++ "tix/"+defaultTixDir :: FilePath+defaultTixDir = defaultHpcDir ++ "tix/" -mixDir :: FilePath-mixDir = hpcDir ++ "mix/"+defaultMixDir :: FilePath+defaultMixDir = defaultHpcDir ++ "mix/" -getMixPath :: String -> TixModule -> FilePath-getMixPath testSuiteName tix = mixDir ++ dirName ++ "/"+getMixPaths :: Config -> String -> TixModule -> [FilePath]+getMixPaths config testSuiteName tix = do _dirName <- dirName+ return $ mixDir config ++ _dirName ++ "/" where dirName = case span (/= '/') modName of- (_, []) -> testSuiteName- (packageId, _) -> packageId+ (_, []) -> [ testSuiteName ]+ (packageId, _) -> [ "", packageId ] TixModule modName _ _ _ = tix -getTixPath :: String -> IO FilePath-getTixPath testSuiteName = return $ tixDir ++ testSuiteName ++ "/" ++ getTixFileName testSuiteName+getTixPath :: Config -> String -> IO FilePath+getTixPath config testSuiteName = return $ tixDir config ++ testSuiteName ++ "/" ++ getTixFileName testSuiteName