{-# LANGUAGE RecordWildCards #-}

module Trace.Hpc.Lcov.Report (
  LcovReport (..),
  FileReport (..),
  FunctionReport (..),
  BranchReport (..),
  LineReport (..),
  writeReport,
  showReport,
) where

import Data.List (intercalate)
import Trace.Hpc.Util (Hash)

-- http://ltp.sourceforge.net/coverage/lcov/geninfo.1.php
newtype LcovReport = LcovReport [FileReport]

data FileReport = FileReport
  { FileReport -> FilePath
fileReportLocation :: FilePath
  , FileReport -> [FunctionReport]
fileReportFunctions :: [FunctionReport] -- anything top level is considered a function
  , FileReport -> [BranchReport]
fileReportBranches :: [BranchReport]
  , FileReport -> [LineReport]
fileReportLines :: [LineReport]
  }
  deriving (Int -> FileReport -> ShowS
[FileReport] -> ShowS
FileReport -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileReport] -> ShowS
$cshowList :: [FileReport] -> ShowS
show :: FileReport -> FilePath
$cshow :: FileReport -> FilePath
showsPrec :: Int -> FileReport -> ShowS
$cshowsPrec :: Int -> FileReport -> ShowS
Show, FileReport -> FileReport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileReport -> FileReport -> Bool
$c/= :: FileReport -> FileReport -> Bool
== :: FileReport -> FileReport -> Bool
$c== :: FileReport -> FileReport -> Bool
Eq)

data FunctionReport = FunctionReport
  { FunctionReport -> Int
functionReportLine :: Int
  , FunctionReport -> FilePath
functionReportName :: String
  , FunctionReport -> Integer
functionReportHits :: Integer
  }
  deriving (Int -> FunctionReport -> ShowS
[FunctionReport] -> ShowS
FunctionReport -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FunctionReport] -> ShowS
$cshowList :: [FunctionReport] -> ShowS
show :: FunctionReport -> FilePath
$cshow :: FunctionReport -> FilePath
showsPrec :: Int -> FunctionReport -> ShowS
$cshowsPrec :: Int -> FunctionReport -> ShowS
Show, FunctionReport -> FunctionReport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionReport -> FunctionReport -> Bool
$c/= :: FunctionReport -> FunctionReport -> Bool
== :: FunctionReport -> FunctionReport -> Bool
$c== :: FunctionReport -> FunctionReport -> Bool
Eq)

data BranchReport = BranchReport
  { BranchReport -> Int
branchReportLine :: Int
  , BranchReport -> Hash
branchReportHash :: Hash
  , BranchReport -> Integer
branchReportTrueHits :: Integer
  , BranchReport -> Integer
branchReportFalseHits :: Integer
  }
  deriving (Int -> BranchReport -> ShowS
[BranchReport] -> ShowS
BranchReport -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BranchReport] -> ShowS
$cshowList :: [BranchReport] -> ShowS
show :: BranchReport -> FilePath
$cshow :: BranchReport -> FilePath
showsPrec :: Int -> BranchReport -> ShowS
$cshowsPrec :: Int -> BranchReport -> ShowS
Show, BranchReport -> BranchReport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BranchReport -> BranchReport -> Bool
$c/= :: BranchReport -> BranchReport -> Bool
== :: BranchReport -> BranchReport -> Bool
$c== :: BranchReport -> BranchReport -> Bool
Eq)

data LineReport = LineReport
  { LineReport -> Int
lineReportLine :: Int
  , LineReport -> Integer
lineReportHits :: Integer
  }
  deriving (Int -> LineReport -> ShowS
[LineReport] -> ShowS
LineReport -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LineReport] -> ShowS
$cshowList :: [LineReport] -> ShowS
show :: LineReport -> FilePath
$cshow :: LineReport -> FilePath
showsPrec :: Int -> LineReport -> ShowS
$cshowsPrec :: Int -> LineReport -> ShowS
Show, LineReport -> LineReport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineReport -> LineReport -> Bool
$c/= :: LineReport -> LineReport -> Bool
== :: LineReport -> LineReport -> Bool
$c== :: LineReport -> LineReport -> Bool
Eq)

writeReport :: FilePath -> LcovReport -> IO ()
writeReport :: FilePath -> LcovReport -> IO ()
writeReport FilePath
fp = FilePath -> FilePath -> IO ()
writeFile FilePath
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. LcovReport -> FilePath
showReport

showReport :: LcovReport -> String
showReport :: LcovReport -> FilePath
showReport (LcovReport [FileReport]
fileReports) = [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FileReport -> [FilePath]
generateFileReport [FileReport]
fileReports
  where
    generateFileReport :: FileReport -> [FilePath]
generateFileReport FileReport{FilePath
[LineReport]
[BranchReport]
[FunctionReport]
fileReportLines :: [LineReport]
fileReportBranches :: [BranchReport]
fileReportFunctions :: [FunctionReport]
fileReportLocation :: FilePath
fileReportLines :: FileReport -> [LineReport]
fileReportBranches :: FileReport -> [BranchReport]
fileReportFunctions :: FileReport -> [FunctionReport]
fileReportLocation :: FileReport -> FilePath
..} =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [FilePath -> [FilePath] -> FilePath
line FilePath
"TN" []]
        , [FilePath -> [FilePath] -> FilePath
line FilePath
"SF" [FilePath
fileReportLocation]]
        , forall a b. (a -> b) -> [a] -> [b]
map FunctionReport -> FilePath
showFunctionDefinition [FunctionReport]
fileReportFunctions
        , forall a b. (a -> b) -> [a] -> [b]
map FunctionReport -> FilePath
showFunctionHits [FunctionReport]
fileReportFunctions
        , [FilePath -> [FilePath] -> FilePath
line FilePath
"FNF" [forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [FunctionReport]
fileReportFunctions]]
        , [FilePath -> [FilePath] -> FilePath
line FilePath
"FNH" [forall a. (a -> Integer) -> [a] -> FilePath
countHits FunctionReport -> Integer
functionReportHits [FunctionReport]
fileReportFunctions]]
        , forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BranchReport -> [FilePath]
generateBranchReport [BranchReport]
fileReportBranches
        , [FilePath -> [FilePath] -> FilePath
line FilePath
"BRF" [forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [BranchReport]
fileReportBranches forall a. Num a => a -> a -> a
* Int
2]] -- multiplying by 2 for true and false branches
        , [FilePath -> [FilePath] -> FilePath
line FilePath
"BRH" [forall a. (a -> Integer) -> [a] -> FilePath
countHits BranchReport -> Integer
branchReportHits [BranchReport]
fileReportBranches]]
        , forall a b. (a -> b) -> [a] -> [b]
map LineReport -> FilePath
showLineReport [LineReport]
fileReportLines
        , [FilePath -> [FilePath] -> FilePath
line FilePath
"LF" [forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [LineReport]
fileReportLines]]
        , [FilePath -> [FilePath] -> FilePath
line FilePath
"LH" [forall a. (a -> Integer) -> [a] -> FilePath
countHits LineReport -> Integer
lineReportHits [LineReport]
fileReportLines]]
        , [FilePath
"end_of_record"]
        ]

    showFunctionDefinition :: FunctionReport -> FilePath
showFunctionDefinition FunctionReport{Int
Integer
FilePath
functionReportHits :: Integer
functionReportName :: FilePath
functionReportLine :: Int
functionReportHits :: FunctionReport -> Integer
functionReportName :: FunctionReport -> FilePath
functionReportLine :: FunctionReport -> Int
..} = FilePath -> [FilePath] -> FilePath
line FilePath
"FN" [forall a. Show a => a -> FilePath
show Int
functionReportLine, FilePath
functionReportName]

    showFunctionHits :: FunctionReport -> FilePath
showFunctionHits FunctionReport{Int
Integer
FilePath
functionReportHits :: Integer
functionReportName :: FilePath
functionReportLine :: Int
functionReportHits :: FunctionReport -> Integer
functionReportName :: FunctionReport -> FilePath
functionReportLine :: FunctionReport -> Int
..} = FilePath -> [FilePath] -> FilePath
line FilePath
"FNDA" [forall a. Show a => a -> FilePath
show Integer
functionReportHits, FilePath
functionReportName]

    generateBranchReport :: BranchReport -> [FilePath]
generateBranchReport BranchReport{Int
Integer
Hash
branchReportFalseHits :: Integer
branchReportTrueHits :: Integer
branchReportHash :: Hash
branchReportLine :: Int
branchReportFalseHits :: BranchReport -> Integer
branchReportTrueHits :: BranchReport -> Integer
branchReportHash :: BranchReport -> Hash
branchReportLine :: BranchReport -> Int
..} =
      let mkBranchLine :: Int -> a -> FilePath
mkBranchLine Int
branchNum a
hits =
            FilePath -> [FilePath] -> FilePath
line
              FilePath
"BRDA"
              [ forall a. Show a => a -> FilePath
show Int
branchReportLine
              , forall a. Show a => a -> FilePath
show Hash
branchReportHash
              , forall a. Show a => a -> FilePath
show (Int
branchNum :: Int)
              , forall a. Show a => a -> FilePath
show a
hits
              ]
       in [forall {a}. Show a => Int -> a -> FilePath
mkBranchLine Int
0 Integer
branchReportTrueHits, forall {a}. Show a => Int -> a -> FilePath
mkBranchLine Int
1 Integer
branchReportFalseHits]

    showLineReport :: LineReport -> FilePath
showLineReport LineReport{Int
Integer
lineReportHits :: Integer
lineReportLine :: Int
lineReportHits :: LineReport -> Integer
lineReportLine :: LineReport -> Int
..} = FilePath -> [FilePath] -> FilePath
line FilePath
"DA" [forall a. Show a => a -> FilePath
show Int
lineReportLine, forall a. Show a => a -> FilePath
show Integer
lineReportHits]

    {- Helpers -}

    line :: String -> [String] -> String
    line :: FilePath -> [FilePath] -> FilePath
line FilePath
label [FilePath]
info = FilePath
label forall a. [a] -> [a] -> [a]
++ FilePath
":" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"," [FilePath]
info

    countHits :: (a -> Integer) -> [a] -> String
    countHits :: forall a. (a -> Integer) -> [a] -> FilePath
countHits a -> Integer
f = forall a. Show a => a -> FilePath
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Integer
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
f)

    branchReportHits :: BranchReport -> Integer
branchReportHits BranchReport{Int
Integer
Hash
branchReportFalseHits :: Integer
branchReportTrueHits :: Integer
branchReportHash :: Hash
branchReportLine :: Int
branchReportFalseHits :: BranchReport -> Integer
branchReportTrueHits :: BranchReport -> Integer
branchReportHash :: BranchReport -> Hash
branchReportLine :: BranchReport -> Int
..} = Integer
branchReportTrueHits forall a. Num a => a -> a -> a
+ Integer
branchReportFalseHits