{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module:      SHC.Coveralls
-- Copyright:   (c) 2015 Michele Lacchia
-- License:     ISC
-- Maintainer:  Michele Lacchia <michelelacchia@gmail.com>
-- Stability:   experimental
--
-- Functions for reading, converting and sending HPC output to coveralls.io.

module SHC.Coveralls (generateCoverallsFromTix)
    where

import           Control.Applicative
import           Data.Aeson
import           Data.Aeson.Types ()
import qualified Data.ByteString.Lazy.Char8 as LBS
import           Data.Digest.Pure.MD5
import           Data.Function
import           Data.List
import qualified Data.Map.Strict as M
import           System.FilePath ((</>))
import           System.Exit (exitFailure)
import           SHC.Types
import           SHC.Utils
import           SHC.Lix
import           Trace.Hpc.Mix
import           Trace.Hpc.Tix
import           Trace.Hpc.Util

type ModuleCoverageData = (
    String,    -- file source code
    Mix,       -- module index data
    [Integer]) -- tixs recorded by hpc

type TestSuiteCoverageData = M.Map FilePath ModuleCoverageData

-- Is there a way to restrict this to only Number and Null?
type CoverageValue = Value

-- Single file coverage data in the format defined by coveralls.io
type SimpleCoverage = [CoverageValue]
type LixConverter = Lix -> SimpleCoverage

strictConverter :: LixConverter
strictConverter = map $ \case
    Full       -> Number 1
    Partial    -> Number 0
    None       -> Number 0
    Irrelevant -> Null

looseConverter :: LixConverter
looseConverter = map $ \lix -> case lix of
    Full       -> Number 2
    Partial    -> Number 1
    None       -> Number 0
    Irrelevant -> Null

toSimpleCoverage :: LixConverter -> Int -> [CoverageEntry] -> SimpleCoverage
toSimpleCoverage convert lineCount = convert . toLix lineCount

getExprSource :: [String] -> MixEntry -> [String]
getExprSource source (hpcPos, _) = subSubSeq startCol endCol subLines
    where subLines = subSeq startLine endLine source
          startLine = startLine' - 1
          startCol = startCol' - 1
          (startLine', startCol', endLine, endCol) = fromHpcPos hpcPos

groupMixEntryTixs :: [(MixEntry, Integer, [String])] -> [CoverageEntry]
groupMixEntryTixs = map mergeOnLst3 . groupBy ((==) `on` fst . fst3)
    where mergeOnLst3 xxs@(x : _) = (map fst3 xxs, map snd3 xxs, trd3 x)
          mergeOnLst3 [] = error "mergeOnLst3 appliedTo empty list"

coverageToJson :: LixConverter -> FilePath -> ModuleCoverageData -> Value
coverageToJson converter filePath (source, mix, tixs) = object [
    "name" .= filePath,
    "source_digest" .= (show . md5 . LBS.pack) source,
    "coverage" .= coverage]
    where coverage = toSimpleCoverage converter lineCount mixEntriesTixs
          lineCount = length $ lines source
          mixEntriesTixs = groupMixEntryTixs mixEntryTixs
          mixEntryTixs = zip3 mixEntries tixs (map getExprSource' mixEntries)
          Mix _ _ _ _ mixEntries = mix
          getExprSource' = getExprSource $ lines source

toCoverallsJson :: Config -> LixConverter -> TestSuiteCoverageData -> Value
toCoverallsJson conf converter testSuiteCoverageData =
    object $ if serviceName conf == "travis-ci" then withRepoToken else withGitInfo
    where base = [
              "service_job_id" .= jobId conf,
              "service_name"   .= serviceName conf,
              "source_files"   .= toJsonCoverageList testSuiteCoverageData]
          toJsonCoverageList = map (uncurry $ coverageToJson converter) . M.toList
          withRepoToken = mcons (("repo_token" .=) <$> repoToken conf) base
          withGitInfo   = ("git" .= gitInfo conf) : withRepoToken

mergeCoverageData :: [TestSuiteCoverageData] -> TestSuiteCoverageData
mergeCoverageData = foldr1 (M.unionWith mergeModule)
    where mergeModule (source, mix, tixs1) (_, _, tixs2) =
            (source, mix, zipWith (+) tixs1 tixs2)

readMix' :: Config -> TixModule -> IO Mix
readMix' conf tix = readMix [SHC.Types.mixDir conf] (Right tix)

-- | Create a list of coverage data from the tix input
readCoverageData :: Config -> String -> IO TestSuiteCoverageData
readCoverageData conf suite = do
    let tixPath = hpcDir conf </> "tix" </> suite </> getTixFileName suite
    mTix <- readTix tixPath
    case mTix of
        Nothing -> putStrLn ("Couldn't find the file " ++ tixPath) >>
                   dumpDirectoryTree (hpcDir conf) >> exitFailure
        Just (Tix tixs) -> do
            mixs <- mapM (readMix' conf) tixs
            let files = map filePath mixs
            sources <- mapM readFile files
            let coverageDataList = zip4 files sources mixs (map tixModuleTixs tixs)
            let filteredCoverageDataList = filter sourceDirFilter coverageDataList
            return $ M.fromList $ map toFirstAndRest filteredCoverageDataList
            where filePath (Mix fp _ _ _ _) = fp
                  sourceDirFilter = not . matchAny excludeDirPatterns . fst4
                  excludeDirPatterns = []  -- XXX: for now

-- | Generate Coveralls JSON formatted code coverage from HPC coverage data
generateCoverallsFromTix :: Config -> IO Value
generateCoverallsFromTix conf = do
    testSuitesCoverages <- mapM (readCoverageData conf) [testSuiteName] -- XXX: fix suites
    let coverageData = mergeCoverageData testSuitesCoverages
    return $ toCoverallsJson conf converter coverageData
    where testSuiteName = suiteName conf
          converter = case conversion conf of
              FullLines -> strictConverter
              PartialLines -> looseConverter