hpc-coveralls 0.8.2 → 0.8.3

raw patch · 5 files changed

+82/−7 lines, 5 filesdep ~processPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: process

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• hpc-coveralls.cabal +4/−1
• src/HpcCoverallsMain.hs +3/−1
• src/Trace/Hpc/Coveralls.hs +9/−5
• src/Trace/Hpc/Coveralls/GitInfo.hs +62/−0

@@ -1,3 +1,7 @@+[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)+ [0.8.2](https://github.com/guillaume-nargeot/hpc-coveralls/issues?q=milestone:v0.8.2+is:closed) ----- * Add option to send repo token (issue #36)

@@ -1,5 +1,5 @@ name:           hpc-coveralls-version:        0.8.2+version:        0.8.3 synopsis:       Coveralls.io support for Haskell. description:   This utility converts and sends Haskell projects hpc code coverage to@@ -51,6 +51,7 @@     HpcCoverallsCmdLine,     Trace.Hpc.Coveralls.Config,     Trace.Hpc.Coveralls.Curl,+    Trace.Hpc.Coveralls.GitInfo,     Trace.Hpc.Coveralls.Paths   build-depends:     aeson,@@ -60,6 +61,7 @@     cmdargs >= 0.10,     curl >= 1.3.8,     hpc >= 0.6,+    process >= 1.1.0.1,     retry >= 0.5,     safe >= 0.3,     split@@ -75,6 +77,7 @@     cmdargs >= 0.10,     curl >= 1.3.8,     hpc >= 0.6,+    process >= 1.1.0.1,     retry >= 0.5,     safe >= 0.3,     split

@@ -14,6 +14,7 @@ import           Trace.Hpc.Coveralls import           Trace.Hpc.Coveralls.Config (Config(Config)) import           Trace.Hpc.Coveralls.Curl+import           Trace.Hpc.Coveralls.GitInfo (getGitInfo) import           Trace.Hpc.Coveralls.Util  urlApiV1 :: String@@ -47,7 +48,8 @@         Nothing -> putStrLn "Please specify a target test suite name" >> exitSuccess         Just config -> do             (serviceName, jobId) <- getServiceAndJobID-            coverallsJson <- generateCoverallsFromTix serviceName jobId config+            gitInfo <- getGitInfo+            coverallsJson <- generateCoverallsFromTix serviceName jobId gitInfo config             when (displayReport hca) $ BSL.putStrLn $ encode coverallsJson             let filePath = serviceName ++ "-" ++ jobId ++ ".json"             writeJson filePath coverallsJson

@@ -19,6 +19,7 @@ import qualified Data.Map.Strict as M import           System.Exit (exitFailure) import           Trace.Hpc.Coveralls.Config+import           Trace.Hpc.Coveralls.GitInfo (GitInfo) import           Trace.Hpc.Coveralls.Lix import           Trace.Hpc.Coveralls.Paths import           Trace.Hpc.Coveralls.Types@@ -83,14 +84,16 @@           Mix _ _ _ _ mixEntries = mix           getExprSource' = getExprSource $ lines source -toCoverallsJson :: String -> String -> Maybe String -> LixConverter -> TestSuiteCoverageData -> Value-toCoverallsJson serviceName jobId repoTokenM converter testSuiteCoverageData =-    object $ mcons (("repo_token" .=) <$> repoTokenM) base+toCoverallsJson :: String -> String -> Maybe String -> GitInfo -> LixConverter -> TestSuiteCoverageData -> Value+toCoverallsJson serviceName jobId repoTokenM gitInfo converter testSuiteCoverageData =+    object $ if serviceName == "travis-ci" then withRepoToken else withGitInfo     where base = [               "service_job_id" .= jobId,               "service_name" .= serviceName,               "source_files" .= toJsonCoverageList testSuiteCoverageData]           toJsonCoverageList = map (uncurry $ coverageToJson converter) . M.toList+          withRepoToken = mcons (("repo_token" .=) <$> repoTokenM) base+          withGitInfo   = ("git" .= gitInfo) : withRepoToken  mergeModuleCoverageData :: ModuleCoverageData -> ModuleCoverageData -> ModuleCoverageData mergeModuleCoverageData (source, mix, tixs1) (_, _, tixs2) =@@ -124,11 +127,12 @@ -- | Generate coveralls json formatted code coverage from hpc coverage data generateCoverallsFromTix :: String   -- ^ CI name                          -> String   -- ^ CI Job ID+                         -> GitInfo  -- ^ Git repo information                          -> Config   -- ^ hpc-coveralls configuration                          -> IO Value -- ^ code coverage result in json format-generateCoverallsFromTix serviceName jobId config = do+generateCoverallsFromTix serviceName jobId gitInfo config = do     testSuitesCoverages <- mapM (`readCoverageData` excludedDirPatterns) testSuiteNames-    return $ toCoverallsJson serviceName jobId repoTokenM converter $ mergeCoverageData testSuitesCoverages+    return $ toCoverallsJson serviceName jobId repoTokenM gitInfo converter $ mergeCoverageData testSuitesCoverages     where excludedDirPatterns = excludedDirs config           testSuiteNames = testSuites config           repoTokenM = repoToken config

@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}++module Trace.Hpc.Coveralls.GitInfo (getGitInfo, GitInfo) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (guard)+import Data.Aeson+import Data.List (nubBy)+import Data.Function (on)+import System.Process (readProcess)++data GitInfo = GitInfo { headRef :: Commit+                       , branch  :: String+                       , remotes :: [Remote] }++instance ToJSON GitInfo where+    toJSON i = object [ "head"    .= headRef i+                      , "branch"  .= branch i+                      , "remotes" .= remotes i]++data Commit = Commit { hash           :: String+                     , authorName     :: String+                     , authorEmail    :: String+                     , committerName  :: String+                     , committerEmail :: String+                     , message        :: String }++instance ToJSON Commit where+    toJSON c = object [ "id"              .= hash c+                      , "author_name"     .= authorName c+                      , "author_email"    .= authorEmail c+                      , "committer_name"  .= committerName c+                      , "committer_email" .= committerEmail c+                      , "message"         .= message c ]++data Remote = Remote { name :: String+                     , url  :: String }++instance ToJSON Remote where+    toJSON r = object [ "name" .= name r+                      , "url"  .= url r ]++git :: [String] -> IO String+git args = init <$> readProcess "git" args []  -- init to strip trailing \n++-- | Get information about the Git repo in the current directory.+getGitInfo :: IO GitInfo+getGitInfo = GitInfo <$> headRef <*> branch <*> getRemotes where+    headRef = Commit <$> git ["rev-parse", "HEAD"]+                  <*> git ["log", "-1", "--pretty=%aN"] <*> git ["log", "-1", "--pretty=%aE"]+                  <*> git ["log", "-1", "--pretty=%cN"] <*> git ["log", "-1", "--pretty=%cE"]+                  <*> git ["log", "-1", "--pretty=%s"]+    branch = git ["rev-parse", "--abbrev-ref", "HEAD"]++getRemotes :: IO [Remote]+getRemotes = nubBy ((==) `on` name) <$> parseRemotes <$> git ["remote", "-v"] where+    parseRemotes :: String -> [Remote]+    parseRemotes input = do+        line <- lines input+        let fields = words line+        guard $ length fields >= 2+        return $ Remote (head fields) (fields !! 1)