diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) 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.3.0 on Hackage](http://img.shields.io/badge/hackage-0.3.0-brightgreen.svg)](http://hackage.haskell.org/package/codecov-haskell-0.3.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) [![Version on Hackage](http://img.shields.io/hackage/v/codecov-haskell.svg)](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 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.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 -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 diff --git a/src/CodecovHaskellCmdLine.hs b/src/CodecovHaskellCmdLine.hs --- a/src/CodecovHaskellCmdLine.hs +++ b/src/CodecovHaskellCmdLine.hs @@ -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 diff --git a/src/CodecovHaskellMain.hs b/src/CodecovHaskellMain.hs --- a/src/CodecovHaskellMain.hs +++ b/src/CodecovHaskellMain.hs @@ -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 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 @@ -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 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 @@ -2,5 +2,7 @@ data Config = Config { excludedDirs :: ![FilePath], - testSuites :: ![String] + testSuites :: ![String], + tixDir :: !FilePath, + mixDir :: !FilePath } diff --git a/src/Trace/Hpc/Codecov/Curl.hs b/src/Trace/Hpc/Codecov/Curl.hs --- a/src/Trace/Hpc/Codecov/Curl.hs +++ b/src/Trace/Hpc/Codecov/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 @@ -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] diff --git a/src/Trace/Hpc/Codecov/Paths.hs b/src/Trace/Hpc/Codecov/Paths.hs --- a/src/Trace/Hpc/Codecov/Paths.hs +++ b/src/Trace/Hpc/Codecov/Paths.hs @@ -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