hpc-coveralls-1.0.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 hiding (listToMaybe)
import           HpcCoverallsCmdLine
import           System.Console.CmdArgs
import           System.Environment (getEnv, getEnvironment)
import           System.Exit (exitFailure)
import           Trace.Hpc.Coveralls
import           Trace.Hpc.Coveralls.Cabal
import           Trace.Hpc.Coveralls.Config (Config(Config, cabalFile, serviceName))
import           Trace.Hpc.Coveralls.Curl
import           Trace.Hpc.Coveralls.GitInfo (getGitInfo)
import           Trace.Hpc.Coveralls.Util

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 = Config
    (optExcludeDirs hca)
    (optCoverageMode hca)
    (optCabalFile hca)
    (optServiceName hca)
    (optRepoToken hca)
    <$> listToMaybe (argTestSuites hca)

main :: IO ()
main = do
    hca <- cmdArgs hpcCoverallsArgs
    case getConfig hca of
        Nothing -> putStrLn "Please specify a target test suite name"
        Just config -> do
            (defaultServiceName, jobId) <- getServiceAndJobID
            let sn = fromMaybe defaultServiceName (serviceName config)
            gitInfo <- getGitInfo
            mPkgNameVer <- case cabalFile config of
                Just cabalFilePath -> getPackageNameVersion cabalFilePath
                Nothing -> currDirPkgNameVer
            gitInfo <- getGitInfo
            coverallsJson <- generateCoverallsFromTix sn jobId gitInfo config mPkgNameVer
            when (optDisplayReport hca) $ BSL.putStrLn $ encode coverallsJson
            let filePath = sn ++ "-" ++ jobId ++ ".json"
            writeJson filePath coverallsJson
            unless (optDontSend hca) $ do
                response <- postJson filePath urlApiV1 (optCurlVerbose hca)
                case response of
                    PostSuccess url -> do
                        putStrLn ("URL: " ++ url)
                        -- wait 10 seconds until the page is available
                        threadDelay (10 * 1000 * 1000)
                        coverageResult <- readCoverageResult url (optCurlVerbose hca)
                        case coverageResult of
                            Just totalCoverage -> putStrLn ("Coverage: " ++ totalCoverage)
                            Nothing -> putStrLn "Failed to read total coverage"
                    PostFailure msg -> do
                        putStrLn ("Error: " ++ msg)
                        putStrLn ("You can get support at " ++ gitterUrl)
                        exitFailure
                        where gitterUrl = "https://gitter.im/guillaume-nargeot/hpc-coveralls"