hpc-coveralls-0.6.0: src/HpcCoverallsMain.hs

module Main where

import           Control.Applicative
import           Control.Concurrent
import           Control.Monad
import           Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as BSL
import           Data.List
import           Data.Maybe
import           HpcCoverallsCmdLine
import           System.Console.CmdArgs
import           System.Environment (getEnv, getEnvironment)
import           System.Exit (exitFailure, exitSuccess)
import           Trace.Hpc.Coveralls
import           Trace.Hpc.Coveralls.Config (Config(Config))
import           Trace.Hpc.Coveralls.Curl

urlApiV1 :: String
urlApiV1 = "https://coveralls.io/api/v1/jobs"

getServiceAndJobID :: IO (String, String)
getServiceAndJobID = do
    env <- getEnvironment
    case snd <$> find (isJust . flip lookup env . fst) ciEnvVars of
        Just (ciName, jobIdVarName) -> do
            jobId <- getEnv jobIdVarName
            return (ciName, jobId)
        _ -> error "Unsupported CI service."
    where ciEnvVars = [
           ("TRAVIS",      ("travis-ci", "TRAVIS_JOB_ID")),
           ("CIRCLECI",    ("circleci",  "CIRCLE_BUILD_NUM")),
           ("SEMAPHORE",   ("semaphore", "REVISION")),
           ("JENKINS_URL", ("jenkins",   "BUILD_ID")),
           ("CI_NAME",     ("codeship",  "CI_BUILD_NUMBER"))]

writeJson :: String -> Value -> IO ()
writeJson filePath = BSL.writeFile filePath . encode

getConfig :: HpcCoverallsArgs -> Maybe Config
getConfig hca = case testSuites hca of
    []             -> Nothing
    testSuiteNames -> Just $ Config testSuiteNames (excludeDirs hca) (coverageMode hca)

main :: IO ()
main = do
    hca <- cmdArgs hpcCoverallsArgs
    case getConfig hca of
        Nothing -> putStrLn "Please specify a target test suite name" >> exitSuccess
        Just config -> do
            (serviceName, jobId) <- getServiceAndJobID
            coverallsJson <- generateCoverallsFromTix serviceName jobId config
            when (displayReport hca) $ BSL.putStrLn $ encode coverallsJson
            let filePath = serviceName ++ "-" ++ jobId ++ ".json"
            writeJson filePath coverallsJson
            unless (dontSend hca) $ do
                response <- postJson filePath urlApiV1 (printResponse hca)
                case response of
                    PostSuccess url -> do
                        putStrLn ("URL: " ++ url)
                        -- wait 5 seconds until the page is available
                        threadDelay (5 * 10000000)
                        coverageResult <- readCoverageResult url (printResponse hca)
                        case coverageResult of
                            Just totalCoverage -> putStrLn ("Coverage: " ++ totalCoverage) >> exitSuccess
                            Nothing -> exitSuccess
                    PostFailure msg -> putStrLn ("Error: " ++ msg) >> exitFailure