module Trace.Hpc.Lcov (
  generateLcovFromTix,
  writeReport,
  FileInfo,
) where

import Control.Arrow ((&&&))
import Data.List (intercalate, maximumBy)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe)
import Data.Ord (comparing)
import Trace.Hpc.Mix (BoxLabel (..), MixEntry)
import Trace.Hpc.Tix (TixModule (..), tixModuleName, tixModuleTixs)
import Trace.Hpc.Util (HpcPos, fromHpcPos, toHash)

import Trace.Hpc.Lcov.Report

-- | Path to source file and entries from the corresponding .mix file.
type FileInfo = (FilePath, [MixEntry])

-- | Generate LCOV format from HPC coverage data.
generateLcovFromTix ::
  -- | Mapping from module name to file info
  [(String, FileInfo)] ->
  [TixModule] ->
  LcovReport
generateLcovFromTix :: [(String, FileInfo)] -> [TixModule] -> LcovReport
generateLcovFromTix [(String, FileInfo)]
moduleToMix = [FileReport] -> LcovReport
LcovReport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map TixModule -> FileReport
mkFileReport forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TixModule] -> [TixModule]
mergeTixModules
  where
    mkFileReport :: TixModule -> FileReport
mkFileReport TixModule
tixModule =
      let tickCounts :: [Integer]
tickCounts = TixModule -> [Integer]
tixModuleTixs TixModule
tixModule
          moduleName :: String
moduleName = TixModule -> String
tixModuleName TixModule
tixModule
          (String
fileLoc, [MixEntry]
mixEntries) =
            forall a. a -> Maybe a -> a
fromMaybe
              (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Could not find .mix file for: " forall a. [a] -> [a] -> [a]
++ String
moduleName)
              forall a b. (a -> b) -> a -> b
$ String
moduleName forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, FileInfo)]
moduleToMix
          overTixMix :: (Integer -> MixEntry -> Maybe a) -> [a]
overTixMix Integer -> MixEntry -> Maybe a
f = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> MixEntry -> Maybe a
f [Integer]
tickCounts [MixEntry]
mixEntries
       in FileReport
            { fileReportLocation :: String
fileReportLocation = String
fileLoc
            , fileReportFunctions :: [FunctionReport]
fileReportFunctions = forall {a}. (Integer -> MixEntry -> Maybe a) -> [a]
overTixMix Integer -> MixEntry -> Maybe FunctionReport
parseFunctionReport
            , fileReportBranches :: [BranchReport]
fileReportBranches = [(HpcPos, (Integer, Integer))] -> [BranchReport]
mergeBranchReports forall a b. (a -> b) -> a -> b
$ forall {a}. (Integer -> MixEntry -> Maybe a) -> [a]
overTixMix Integer -> MixEntry -> Maybe (HpcPos, (Integer, Integer))
parseBranchReport
            , fileReportLines :: [LineReport]
fileReportLines = [LineReport] -> [LineReport]
mergeLineReports forall a b. (a -> b) -> a -> b
$ forall {a}. (Integer -> MixEntry -> Maybe a) -> [a]
overTixMix Integer -> MixEntry -> Maybe LineReport
parseLineReport
            }

{- | Merge all tix modules representing the same module.

 If tix modules are duplicated, we are treating them as being hit in different test suites, so all
 tick counts should be added together.
-}
mergeTixModules :: [TixModule] -> [TixModule]
mergeTixModules :: [TixModule] -> [TixModule]
mergeTixModules = forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith TixModule -> TixModule -> TixModule
mergeTixs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (TixModule -> String
tixModuleName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id)
  where
    mergeTixs :: TixModule -> TixModule -> TixModule
mergeTixs (TixModule String
moduleName Hash
hash Int
len [Integer]
ticks1) (TixModule String
_ Hash
_ Int
_ [Integer]
ticks2) =
      String -> Hash -> Int -> [Integer] -> TixModule
TixModule String
moduleName Hash
hash Int
len forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+) [Integer]
ticks1 [Integer]
ticks2

parseFunctionReport :: Integer -> MixEntry -> Maybe FunctionReport
parseFunctionReport :: Integer -> MixEntry -> Maybe FunctionReport
parseFunctionReport Integer
tickCount (HpcPos
hpcPos, BoxLabel
boxLabel) = [String] -> FunctionReport
mkFunctionReport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [String]
mFunctionName
  where
    mkFunctionReport :: [String] -> FunctionReport
mkFunctionReport [String]
names =
      FunctionReport
        { functionReportLine :: Int
functionReportLine = HpcPos -> Int
hpcPosLine HpcPos
hpcPos
        , functionReportName :: String
functionReportName = forall a. [a] -> [[a]] -> [a]
intercalate String
"$" [String]
names
        , functionReportHits :: Integer
functionReportHits = Integer
tickCount
        }

    mFunctionName :: Maybe [String]
mFunctionName = case BoxLabel
boxLabel of
      TopLevelBox [String]
names -> forall a. a -> Maybe a
Just [String]
names
      LocalBox [String]
names -> forall a. a -> Maybe a
Just [String]
names
      BoxLabel
_ -> forall a. Maybe a
Nothing

parseBranchReport :: Integer -> MixEntry -> Maybe (HpcPos, (Integer, Integer))
parseBranchReport :: Integer -> MixEntry -> Maybe (HpcPos, (Integer, Integer))
parseBranchReport Integer
tickCount (HpcPos
hpcPos, BoxLabel
boxLabel) = case BoxLabel
boxLabel of
  BinBox CondBox
_ Bool
isTrue ->
    let branchHits :: (Integer, Integer)
branchHits = if Bool
isTrue then (Integer
tickCount, Integer
0) else (Integer
0, Integer
tickCount)
     in forall a. a -> Maybe a
Just (HpcPos
hpcPos, (Integer, Integer)
branchHits)
  BoxLabel
_ -> forall a. Maybe a
Nothing

mergeBranchReports :: [(HpcPos, (Integer, Integer))] -> [BranchReport]
mergeBranchReports :: [(HpcPos, (Integer, Integer))] -> [BranchReport]
mergeBranchReports = forall a b. (a -> b) -> [a] -> [b]
map (HpcPos, (Integer, Integer)) -> BranchReport
mkBranchReport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall {a} {b}. (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
addPairs
  where
    mkBranchReport :: (HpcPos, (Integer, Integer)) -> BranchReport
mkBranchReport (HpcPos
hpcPos, (Integer
trueHits, Integer
falseHits)) =
      BranchReport
        { branchReportLine :: Int
branchReportLine = HpcPos -> Int
hpcPosLine HpcPos
hpcPos
        , branchReportHash :: Hash
branchReportHash = forall a. HpcHash a => a -> Hash
toHash HpcPos
hpcPos
        , branchReportTrueHits :: Integer
branchReportTrueHits = Integer
trueHits
        , branchReportFalseHits :: Integer
branchReportFalseHits = Integer
falseHits
        }

    addPairs :: (a, b) -> (a, b) -> (a, b)
addPairs (a
a1, b
b1) (a
a2, b
b2) = (a
a1 forall a. Num a => a -> a -> a
+ a
a2, b
b1 forall a. Num a => a -> a -> a
+ b
b2)

parseLineReport :: Integer -> MixEntry -> Maybe LineReport
parseLineReport :: Integer -> MixEntry -> Maybe LineReport
parseLineReport Integer
tickCount (HpcPos
hpcPos, BoxLabel
boxLabel) = case BoxLabel
boxLabel of
  ExpBox Bool
_ ->
    forall a. a -> Maybe a
Just
      LineReport
        { lineReportLine :: Int
lineReportLine = HpcPos -> Int
hpcPosLine HpcPos
hpcPos
        , lineReportHits :: Integer
lineReportHits = Integer
tickCount
        }
  BoxLabel
_ -> forall a. Maybe a
Nothing

mergeLineReports :: [LineReport] -> [LineReport]
mergeLineReports :: [LineReport] -> [LineReport]
mergeLineReports = forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (forall b a. Ord b => (a -> b) -> a -> a -> a
maxBy LineReport -> Integer
lineReportHits) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (LineReport -> Int
lineReportLine forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id)

{- Utilities -}

hpcPosLine :: HpcPos -> Int
hpcPosLine :: HpcPos -> Int
hpcPosLine = (\(Int
startLine, Int
_, Int
_, Int
_) -> Int
startLine) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HpcPos -> (Int, Int, Int, Int)
fromHpcPos

maxBy :: Ord b => (a -> b) -> a -> a -> a
maxBy :: forall b a. Ord b => (a -> b) -> a -> a -> a
maxBy a -> b
f a
a a
b = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> b
f) [a
a, a
b]