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
type FileInfo = (FilePath, [MixEntry])
generateLcovFromTix ::
[(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
}
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)
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]