{-# LANGUAGE CPP #-}
module Trace.Hpc.Codecov.Report
(
Report(..)
, CoverageEntry(..)
, Format(..)
, LineHits
, Hit(..)
, FunctionHits
, BranchHits
, genReport
, genCoverageEntries
, emitCoverage
) where
import Control.Exception (ErrorCall, handle, throw, throwIO)
import Control.Monad (mplus, when)
import Control.Monad.ST (ST)
import Data.Function (on)
import Data.List (foldl', intercalate, intersperse)
import System.IO (IOMode (..), hPutStrLn, stderr, stdout,
withFile)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Array.Base (unsafeAt)
import Data.Array.IArray (assocs, listArray)
import Data.Array.MArray (newArray, readArray, writeArray)
import Data.Array.ST (STArray, runSTArray)
import Data.Array.Unboxed (UArray)
import Data.ByteString.Builder (Builder, char7, hPutBuilder, intDec,
string7, stringUtf8)
import Data.IntMap (insertLookupWithKey)
import System.Directory (doesFileExist)
import System.FilePath ((<.>), (</>))
import Trace.Hpc.Mix (BoxLabel (..), Mix (..), MixEntry)
import Trace.Hpc.Tix (Tix (..), TixModule (..))
import Trace.Hpc.Util (fromHpcPos)
import Trace.Hpc.Codecov.Exception
import Trace.Hpc.Codecov.Parser
data Report = Report
{ Report -> FilePath
reportTix :: FilePath
, Report -> [FilePath]
reportMixDirs :: [FilePath]
, Report -> [FilePath]
reportSrcDirs :: [FilePath]
, Report -> [FilePath]
reportExcludes :: [String]
, Report -> Maybe FilePath
reportOutFile :: Maybe FilePath
, Report -> Bool
reportVerbose :: Bool
, Report -> Format
reportFormat :: Format
} deriving (Report -> Report -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Report -> Report -> Bool
$c/= :: Report -> Report -> Bool
== :: Report -> Report -> Bool
$c== :: Report -> Report -> Bool
Eq, Tick -> Report -> ShowS
[Report] -> ShowS
Report -> FilePath
forall a.
(Tick -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Report] -> ShowS
$cshowList :: [Report] -> ShowS
show :: Report -> FilePath
$cshow :: Report -> FilePath
showsPrec :: Tick -> Report -> ShowS
$cshowsPrec :: Tick -> Report -> ShowS
Show)
#if MIN_VERSION_base(4,11,0)
instance Semigroup Report where
<> :: Report -> Report -> Report
(<>) = Report -> Report -> Report
mappendReport
#endif
instance Monoid Report where
mempty :: Report
mempty = Report
emptyReport
#if !MIN_VERSION_base(4,16,0)
mappend = mappendReport
#endif
emptyReport :: Report
emptyReport :: Report
emptyReport = Report
{ reportTix :: FilePath
reportTix = forall a e. Exception e => e -> a
throw HpcCodecovError
NoTarget
, reportMixDirs :: [FilePath]
reportMixDirs = []
, reportSrcDirs :: [FilePath]
reportSrcDirs = []
, reportExcludes :: [FilePath]
reportExcludes = []
, reportOutFile :: Maybe FilePath
reportOutFile = forall a. Maybe a
Nothing
, reportVerbose :: Bool
reportVerbose = Bool
False
, reportFormat :: Format
reportFormat = Format
Codecov
}
mappendReport :: Report -> Report -> Report
mappendReport :: Report -> Report -> Report
mappendReport Report
r1 Report
r2 =
let extend :: (b -> b -> c) -> (Report -> b) -> c
extend b -> b -> c
f Report -> b
g = (b -> b -> c
f forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Report -> b
g) Report
r1 Report
r2
in Report { reportTix :: FilePath
reportTix = Report -> FilePath
reportTix Report
r2
, reportMixDirs :: [FilePath]
reportMixDirs = forall {b} {c}. (b -> b -> c) -> (Report -> b) -> c
extend forall a. Semigroup a => a -> a -> a
(<>) Report -> [FilePath]
reportMixDirs
, reportSrcDirs :: [FilePath]
reportSrcDirs = forall {b} {c}. (b -> b -> c) -> (Report -> b) -> c
extend forall a. Semigroup a => a -> a -> a
(<>) Report -> [FilePath]
reportSrcDirs
, reportExcludes :: [FilePath]
reportExcludes = forall {b} {c}. (b -> b -> c) -> (Report -> b) -> c
extend forall a. Semigroup a => a -> a -> a
(<>) Report -> [FilePath]
reportExcludes
, reportOutFile :: Maybe FilePath
reportOutFile = forall {b} {c}. (b -> b -> c) -> (Report -> b) -> c
extend forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Report -> Maybe FilePath
reportOutFile
, reportVerbose :: Bool
reportVerbose = forall {b} {c}. (b -> b -> c) -> (Report -> b) -> c
extend Bool -> Bool -> Bool
(||) Report -> Bool
reportVerbose
, reportFormat :: Format
reportFormat = Report -> Format
reportFormat Report
r2
}
data CoverageEntry =
CoverageEntry { CoverageEntry -> FilePath
ce_filename :: FilePath
, CoverageEntry -> LineHits
ce_hits :: LineHits
, CoverageEntry -> FunctionHits
ce_fns :: FunctionHits
, CoverageEntry -> BranchHits
ce_branches :: BranchHits
} deriving (CoverageEntry -> CoverageEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoverageEntry -> CoverageEntry -> Bool
$c/= :: CoverageEntry -> CoverageEntry -> Bool
== :: CoverageEntry -> CoverageEntry -> Bool
$c== :: CoverageEntry -> CoverageEntry -> Bool
Eq, Tick -> CoverageEntry -> ShowS
[CoverageEntry] -> ShowS
CoverageEntry -> FilePath
forall a.
(Tick -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CoverageEntry] -> ShowS
$cshowList :: [CoverageEntry] -> ShowS
show :: CoverageEntry -> FilePath
$cshow :: CoverageEntry -> FilePath
showsPrec :: Tick -> CoverageEntry -> ShowS
$cshowsPrec :: Tick -> CoverageEntry -> ShowS
Show)
type LineHits = [(Int, Hit)]
data Hit
= Missed
| Partial Int
| Full Int
deriving (Hit -> Hit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hit -> Hit -> Bool
$c/= :: Hit -> Hit -> Bool
== :: Hit -> Hit -> Bool
$c== :: Hit -> Hit -> Bool
Eq, Tick -> Hit -> ShowS
[Hit] -> ShowS
Hit -> FilePath
forall a.
(Tick -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Hit] -> ShowS
$cshowList :: [Hit] -> ShowS
show :: Hit -> FilePath
$cshow :: Hit -> FilePath
showsPrec :: Tick -> Hit -> ShowS
$cshowsPrec :: Tick -> Hit -> ShowS
Show)
type FunctionHits = [(Int, Int, Int, String)]
type BranchHits = [(Int, Int, Bool, Int)]
data Format
= Codecov
| Lcov
deriving (Format -> Format -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, Tick -> Format -> ShowS
[Format] -> ShowS
Format -> FilePath
forall a.
(Tick -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> FilePath
$cshow :: Format -> FilePath
showsPrec :: Tick -> Format -> ShowS
$cshowsPrec :: Tick -> Format -> ShowS
Show)
genReport :: Report -> IO ()
genReport :: Report -> IO ()
genReport Report
rpt = do
[CoverageEntry]
entries <- Report -> IO [CoverageEntry]
genCoverageEntries Report
rpt
let mb_out :: Maybe FilePath
mb_out = Report -> Maybe FilePath
reportOutFile Report
rpt
oname :: FilePath
oname = forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"stdout" forall a. Show a => a -> FilePath
show Maybe FilePath
mb_out
Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Writing report to " forall a. [a] -> [a] -> [a]
++ FilePath
oname)
Format -> Maybe FilePath -> [CoverageEntry] -> IO ()
emitCoverage (Report -> Format
reportFormat Report
rpt) Maybe FilePath
mb_out [CoverageEntry]
entries
Report -> FilePath -> IO ()
say Report
rpt FilePath
"Done"
genCoverageEntries :: Report -> IO [CoverageEntry]
genCoverageEntries :: Report -> IO [CoverageEntry]
genCoverageEntries Report
rpt = Report -> FilePath -> IO Tix
readTixFile Report
rpt (Report -> FilePath
reportTix Report
rpt) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Report -> Tix -> IO [CoverageEntry]
tixToCoverage Report
rpt
emitCoverage
:: Format
-> Maybe FilePath
-> [CoverageEntry]
-> IO ()
emitCoverage :: Format -> Maybe FilePath -> [CoverageEntry] -> IO ()
emitCoverage Format
fmt Maybe FilePath
mb_outfile [CoverageEntry]
entries = forall {r}. (Handle -> IO r) -> IO r
wrap Handle -> IO ()
emit
where
wrap :: (Handle -> IO r) -> IO r
wrap = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. (a -> b) -> a -> b
$ Handle
stdout) (forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
`withFile` IOMode
WriteMode) Maybe FilePath
mb_outfile
emit :: Handle -> IO ()
emit = forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> Builder -> IO ()
hPutBuilder ([CoverageEntry] -> Builder
builder [CoverageEntry]
entries)
builder :: [CoverageEntry] -> Builder
builder = case Format
fmt of
Format
Codecov -> [CoverageEntry] -> Builder
buildJSON
Format
Lcov -> [CoverageEntry] -> Builder
buildLcov
buildJSON :: [CoverageEntry] -> Builder
buildJSON :: [CoverageEntry] -> Builder
buildJSON [CoverageEntry]
entries = Builder
contents
where
contents :: Builder
contents =
Builder -> Builder
braced (Builder -> Builder
key (FilePath -> Builder
string7 FilePath
"coverage") forall a. Semigroup a => a -> a -> a
<>
Builder -> Builder
braced ([Builder] -> Builder
listify (forall a b. (a -> b) -> [a] -> [b]
map CoverageEntry -> Builder
report [CoverageEntry]
entries))) forall a. Semigroup a => a -> a -> a
<>
Char -> Builder
char7 Char
'\n'
report :: CoverageEntry -> Builder
report CoverageEntry
ce =
Builder -> Builder
key (FilePath -> Builder
stringUtf8 (CoverageEntry -> FilePath
ce_filename CoverageEntry
ce)) forall a. Semigroup a => a -> a -> a
<>
Builder -> Builder
braced ([Builder] -> Builder
listify (forall a b. (a -> b) -> [a] -> [b]
map (Tick, Hit) -> Builder
hit (CoverageEntry -> LineHits
ce_hits CoverageEntry
ce)))
key :: Builder -> Builder
key Builder
x = Builder -> Builder
dquote Builder
x forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':'
dquote :: Builder -> Builder
dquote Builder
x = Char -> Builder
char7 Char
'"' forall a. Semigroup a => a -> a -> a
<> Builder
x forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'"'
braced :: Builder -> Builder
braced Builder
x = Char -> Builder
char7 Char
'{' forall a. Semigroup a => a -> a -> a
<> Builder
x forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'}'
listify :: [Builder] -> Builder
listify [Builder]
xs = forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Builder
comma [Builder]
xs)
hit :: (Tick, Hit) -> Builder
hit (Tick
n, Hit
tag) =
case Hit
tag of
Hit
Missed -> Builder
k forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'0'
Partial {} -> Builder
k forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
dquote (FilePath -> Builder
string7 FilePath
"1/2")
Full Tick
i -> Builder
k forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
i
where
k :: Builder
k = Builder -> Builder
key (Tick -> Builder
intDec Tick
n)
buildLcov :: [CoverageEntry] -> Builder
buildLcov :: [CoverageEntry] -> Builder
buildLcov = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map CoverageEntry -> Builder
buildLcovEntry
buildLcovEntry :: CoverageEntry -> Builder
buildLcovEntry :: CoverageEntry -> Builder
buildLcovEntry CoverageEntry
e =
FilePath -> Builder
string7 FilePath
"TN:" forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
FilePath -> Builder
string7 FilePath
"SF:" forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
stringUtf8 (CoverageEntry -> FilePath
ce_filename CoverageEntry
e) forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
Builder
fns_and_nl forall a. Semigroup a => a -> a -> a
<>
FilePath -> Builder
string7 FilePath
"FNF:" forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
fnf forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
FilePath -> Builder
string7 FilePath
"FNH:" forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
fnh forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
Builder
brdas_and_nl forall a. Semigroup a => a -> a -> a
<>
FilePath -> Builder
string7 FilePath
"BRF:" forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
brf forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
FilePath -> Builder
string7 FilePath
"BRH:" forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
brh forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
Builder
das_and_nl forall a. Semigroup a => a -> a -> a
<>
FilePath -> Builder
string7 FilePath
"LF:" forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
lf forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
FilePath -> Builder
string7 FilePath
"LH:" forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
lh forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
FilePath -> Builder
string7 FilePath
"end_of_record" forall a. Semigroup a => a -> a -> a
<> Builder
nl
where
fold_hits :: (a -> ([Builder], [Builder], b, c) -> ([Builder], [Builder], b, c))
-> t a -> (Builder, b, c)
fold_hits a -> ([Builder], [Builder], b, c) -> ([Builder], [Builder], b, c)
f t a
xs =
let ([Builder]
as, [Builder]
bs, b
nentry, c
nhit) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> ([Builder], [Builder], b, c) -> ([Builder], [Builder], b, c)
f ([],[],b
0,c
0) t a
xs
res :: [Builder]
res = [Builder]
as forall a. Semigroup a => a -> a -> a
<> [Builder]
bs
res_and_nl :: Builder
res_and_nl | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Builder]
res = forall a. Monoid a => a
mempty
| Bool
otherwise = forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Builder
nl [Builder]
res) forall a. Semigroup a => a -> a -> a
<> Builder
nl
in (Builder
res_and_nl, b
nentry, c
nhit)
(Builder
fns_and_nl, Tick
fnf, Tick
fnh) = forall {t :: * -> *} {b} {c} {a}.
(Foldable t, Num b, Num c) =>
(a -> ([Builder], [Builder], b, c) -> ([Builder], [Builder], b, c))
-> t a -> (Builder, b, c)
fold_hits forall {c} {d}.
(Num c, Num d) =>
(Tick, Tick, Tick, FilePath)
-> ([Builder], [Builder], c, d) -> ([Builder], [Builder], c, d)
ffn (CoverageEntry -> FunctionHits
ce_fns CoverageEntry
e)
ffn :: (Tick, Tick, Tick, FilePath)
-> ([Builder], [Builder], c, d) -> ([Builder], [Builder], c, d)
ffn (Tick
sl, Tick
el, Tick
n, FilePath
name) ([Builder]
fn_acc, [Builder]
fnda_acc, c
num_fns, d
num_hit_fns) =
( FilePath -> Builder
string7 FilePath
"FN:" forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
sl forall a. Semigroup a => a -> a -> a
<> Builder
comma forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
el forall a. Semigroup a => a -> a -> a
<>
Builder
comma forall a. Semigroup a => a -> a -> a
<> Builder
name' forall a. a -> [a] -> [a]
: [Builder]
fn_acc
, FilePath -> Builder
string7 FilePath
"FNDA:" forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
n forall a. Semigroup a => a -> a -> a
<> Builder
comma forall a. Semigroup a => a -> a -> a
<> Builder
name' forall a. a -> [a] -> [a]
: [Builder]
fnda_acc
, c
num_fns forall a. Num a => a -> a -> a
+ c
1
, if Tick
n forall a. Eq a => a -> a -> Bool
== Tick
0 then d
num_hit_fns else d
num_hit_fns forall a. Num a => a -> a -> a
+ d
1 )
where
name' :: Builder
name' = FilePath -> Builder
stringUtf8 FilePath
name
(Builder
brdas_and_nl, Tick
brf, Tick
brh) = forall {t :: * -> *} {b} {c} {a}.
(Foldable t, Num b, Num c) =>
(a -> ([Builder], [Builder], b, c) -> ([Builder], [Builder], b, c))
-> t a -> (Builder, b, c)
fold_hits forall {c} {d} {a} {a}.
(Num c, Num d) =>
(Tick, Tick, Bool, Tick)
-> (a, [Builder], c, d) -> ([a], [Builder], c, d)
fbr (CoverageEntry -> BranchHits
ce_branches CoverageEntry
e)
fbr :: (Tick, Tick, Bool, Tick)
-> (a, [Builder], c, d) -> ([a], [Builder], c, d)
fbr (Tick
sl, Tick
blk, Bool
bool, Tick
n) (a
_, [Builder]
br, c
num_brs, d
num_hit_brs) =
( []
, FilePath -> Builder
string7 FilePath
"BRDA:" forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
sl forall a. Semigroup a => a -> a -> a
<> Builder
comma forall a. Semigroup a => a -> a -> a
<>
Tick -> Builder
intDec Tick
blk forall a. Semigroup a => a -> a -> a
<> Builder
comma forall a. Semigroup a => a -> a -> a
<>
Char -> Builder
char7 (if Bool
bool then Char
'0' else Char
'1') forall a. Semigroup a => a -> a -> a
<> Builder
comma forall a. Semigroup a => a -> a -> a
<>
Tick -> Builder
intDec Tick
n forall a. a -> [a] -> [a]
: [Builder]
br
, c
num_brs forall a. Num a => a -> a -> a
+ c
1
, if Tick
n forall a. Eq a => a -> a -> Bool
== Tick
0 then d
num_hit_brs else d
num_hit_brs forall a. Num a => a -> a -> a
+ d
1 )
(Builder
das_and_nl, Tick
lf, Tick
lh) = forall {t :: * -> *} {b} {c} {a}.
(Foldable t, Num b, Num c) =>
(a -> ([Builder], [Builder], b, c) -> ([Builder], [Builder], b, c))
-> t a -> (Builder, b, c)
fold_hits forall {c} {d} {a} {a}.
(Num c, Num d) =>
(Tick, Hit) -> (a, [Builder], c, d) -> ([a], [Builder], c, d)
fda (CoverageEntry -> LineHits
ce_hits CoverageEntry
e)
fda :: (Tick, Hit) -> (a, [Builder], c, d) -> ([a], [Builder], c, d)
fda (Tick
n, Hit
hit) (a
_, [Builder]
da, c
num_lines, d
num_hits) =
case Hit
hit of
Hit
Missed -> ([], Tick -> Builder
da0 Tick
nforall a. a -> [a] -> [a]
:[Builder]
da, c
num_lines forall a. Num a => a -> a -> a
+ c
1, d
num_hits)
Partial Tick
i -> ([], Tick -> Tick -> Builder
dai Tick
n Tick
iforall a. a -> [a] -> [a]
:[Builder]
da, c
num_lines forall a. Num a => a -> a -> a
+ c
1, d
num_hits forall a. Num a => a -> a -> a
+ d
1)
Full Tick
i -> ([], Tick -> Tick -> Builder
dai Tick
n Tick
iforall a. a -> [a] -> [a]
:[Builder]
da, c
num_lines forall a. Num a => a -> a -> a
+ c
1, d
num_hits forall a. Num a => a -> a -> a
+ d
1)
da0 :: Tick -> Builder
da0 Tick
n = FilePath -> Builder
string7 FilePath
"DA:" forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
n forall a. Semigroup a => a -> a -> a
<> Builder
comma forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'0'
dai :: Tick -> Tick -> Builder
dai Tick
n Tick
i = FilePath -> Builder
string7 FilePath
"DA:" forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
n forall a. Semigroup a => a -> a -> a
<> Builder
comma forall a. Semigroup a => a -> a -> a
<> Tick -> Builder
intDec Tick
i
nl :: Builder
nl = Char -> Builder
char7 Char
'\n'
comma :: Builder
comma :: Builder
comma = Char -> Builder
char7 Char
','
tixToCoverage :: Report -> Tix -> IO [CoverageEntry]
tixToCoverage :: Report -> Tix -> IO [CoverageEntry]
tixToCoverage Report
rpt (Tix [TixModule]
tms) =
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Report -> TixModule -> IO CoverageEntry
tixModuleToCoverage Report
rpt) (Report -> [TixModule] -> [TixModule]
excludeModules Report
rpt [TixModule]
tms)
tixModuleToCoverage :: Report -> TixModule -> IO CoverageEntry
tixModuleToCoverage :: Report -> TixModule -> IO CoverageEntry
tixModuleToCoverage Report
rpt tm :: TixModule
tm@(TixModule FilePath
name Hash
_hash Tick
count [Integer]
ixs) = do
Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Searching mix: " forall a. [a] -> [a] -> [a]
++ FilePath
name)
Mix FilePath
path UTCTime
_ Hash
_ Tick
_ [MixEntry]
entries <- [FilePath] -> TixModule -> IO Mix
readMixFile (Report -> [FilePath]
reportMixDirs Report
rpt) TixModule
tm
Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Found mix: " forall a. [a] -> [a] -> [a]
++ FilePath
path)
let Info Tick
_ Tick
min_line Tick
max_line [(Tick, Tick, Tick)]
hits FunctionHits
fns PreBranchHits
pre_brs = Tick -> [Integer] -> [MixEntry] -> Info
makeInfo Tick
count [Integer]
ixs [MixEntry]
entries
lineHits :: LineHits
lineHits = Tick -> Tick -> [(Tick, Tick, Tick)] -> LineHits
makeLineHits Tick
min_line Tick
max_line [(Tick, Tick, Tick)]
hits
FilePath
path' <- Report -> FilePath -> IO FilePath
ensureSrcPath Report
rpt FilePath
path
forall (m :: * -> *) a. Monad m => a -> m a
return (CoverageEntry { ce_filename :: FilePath
ce_filename = FilePath
path'
, ce_hits :: LineHits
ce_hits = LineHits
lineHits
, ce_fns :: FunctionHits
ce_fns = FunctionHits
fns
, ce_branches :: BranchHits
ce_branches = PreBranchHits -> BranchHits
reBranch PreBranchHits
pre_brs })
excludeModules :: Report -> [TixModule] -> [TixModule]
excludeModules :: Report -> [TixModule] -> [TixModule]
excludeModules Report
rpt = forall a. (a -> Bool) -> [a] -> [a]
filter TixModule -> Bool
exclude
where
exclude :: TixModule -> Bool
exclude (TixModule FilePath
pkg_slash_name Hash
_ Tick
_ [Integer]
_) =
let modname :: FilePath
modname = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'/') FilePath
pkg_slash_name of
(FilePath
_, Char
'/':FilePath
name) -> FilePath
name
(FilePath
name, FilePath
_) -> FilePath
name
in forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem FilePath
modname (Report -> [FilePath]
reportExcludes Report
rpt)
readTixFile :: Report -> FilePath -> IO Tix
readTixFile :: Report -> FilePath -> IO Tix
readTixFile Report
rpt FilePath
path = do
Maybe Tix
mb_tix <- {-# SCC "readTixFile.readTix'" #-} FilePath -> IO (Maybe Tix)
readTix' FilePath
path
case Maybe Tix
mb_tix of
Maybe Tix
Nothing -> forall e a. Exception e => e -> IO a
throwIO (FilePath -> HpcCodecovError
TixNotFound FilePath
path)
Just Tix
tix -> Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Found tix file: " forall a. [a] -> [a] -> [a]
++ FilePath
path) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Tix
tix
readMixFile :: [FilePath] -> TixModule -> IO Mix
readMixFile :: [FilePath] -> TixModule -> IO Mix
readMixFile [FilePath]
dirs tm :: TixModule
tm@(TixModule FilePath
name Hash
_h Tick
_c [Integer]
_i) = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall a. ErrorCall -> IO a
handler IO Mix
go
where
handler :: ErrorCall -> IO a
handler :: forall a. ErrorCall -> IO a
handler ErrorCall
_ = forall e a. Exception e => e -> IO a
throwIO (FilePath -> [FilePath] -> HpcCodecovError
MixNotFound FilePath
name [FilePath]
dirs')
dirs' :: [FilePath]
dirs' = forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ShowS
</> (FilePath
name FilePath -> ShowS
<.> FilePath
"mix")) [FilePath]
dirs
go :: IO Mix
go = {-# SCC "readMixFile.readMix'" #-} [FilePath] -> Either FilePath TixModule -> IO Mix
readMix' [FilePath]
dirs (forall a b. b -> Either a b
Right TixModule
tm)
ensureSrcPath :: Report -> FilePath -> IO FilePath
ensureSrcPath :: Report -> FilePath -> IO FilePath
ensureSrcPath Report
rpt FilePath
path = [FilePath] -> [FilePath] -> IO FilePath
go [] (Report -> [FilePath]
reportSrcDirs Report
rpt)
where
go :: [FilePath] -> [FilePath] -> IO FilePath
go [FilePath]
acc [] = forall e a. Exception e => e -> IO a
throwIO (FilePath -> [FilePath] -> HpcCodecovError
SrcNotFound FilePath
path [FilePath]
acc)
go [FilePath]
acc (FilePath
dir:[FilePath]
dirs) = do
let path' :: FilePath
path' = FilePath
dir FilePath -> ShowS
</> FilePath
path
Bool
exist <- FilePath -> IO Bool
doesFileExist FilePath
path'
if Bool
exist
then Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Found source: " forall a. [a] -> [a] -> [a]
++ FilePath
path') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path'
else [FilePath] -> [FilePath] -> IO FilePath
go (FilePath
path'forall a. a -> [a] -> [a]
:[FilePath]
acc) [FilePath]
dirs
reBranch :: PreBranchHits -> BranchHits
reBranch :: PreBranchHits -> BranchHits
reBranch = forall {c} {d}.
IntMap Tick -> [(Tick, c, d)] -> [(Tick, Tick, c, d)]
go forall a. Monoid a => a
mempty
where
go :: IntMap Tick -> [(Tick, c, d)] -> [(Tick, Tick, c, d)]
go IntMap Tick
im0 ((Tick
lf,c
brf,d
nf) : (Tick
lt,c
brt,d
nt) : [(Tick, c, d)]
rest) =
let (Maybe Tick
mb_i, IntMap Tick
im1) = forall a.
(Tick -> a -> a -> a)
-> Tick -> a -> IntMap a -> (Maybe a, IntMap a)
insertLookupWithKey forall {p} {p}. p -> p -> Tick -> Tick
f Tick
lf Tick
0 IntMap Tick
im0
f :: p -> p -> Tick -> Tick
f p
_key p
_new Tick
old = Tick
old forall a. Num a => a -> a -> a
+ Tick
1 :: Int
i :: Tick
i = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Tick
0 forall a. Enum a => a -> a
succ Maybe Tick
mb_i
in (Tick
lt,Tick
i,c
brt,d
nt) forall a. a -> [a] -> [a]
: (Tick
lf,Tick
i,c
brf,d
nf) forall a. a -> [a] -> [a]
: IntMap Tick -> [(Tick, c, d)] -> [(Tick, Tick, c, d)]
go IntMap Tick
im1 [(Tick, c, d)]
rest
go IntMap Tick
_ [(Tick, c, d)]
_ = []
say :: Report -> String -> IO ()
say :: Report -> FilePath -> IO ()
say Report
rpt FilePath
msg = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Report -> Bool
reportVerbose Report
rpt) (Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
msg)
type Tick = Int
type Count = Int
type PreBranchHits = [(Int, Bool, Count)]
data Info =
Info {-# UNPACK #-} !Int
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
[(Int, Tick, Count)]
FunctionHits
PreBranchHits
makeLineHits :: Int -> Int -> [(Int, Tick, Count)] -> LineHits
makeLineHits :: Tick -> Tick -> [(Tick, Tick, Tick)] -> LineHits
makeLineHits Tick
min_line Tick
max_line [(Tick, Tick, Tick)]
hits = [(Tick, (Tick, Tick))] -> LineHits
ticksToHits (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs Array Tick (Tick, Tick)
merged)
where
merged :: Array Tick (Tick, Tick)
merged = forall i e. (forall s. ST s (STArray s i e)) -> Array i e
runSTArray forall a b. (a -> b) -> a -> b
$ do
STArray s Tick (Tick, Tick)
arr <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Tick
min_line, Tick
max_line) (Tick
ignored, Tick
0)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall s.
STArray s Tick (Tick, Tick) -> (Tick, Tick, Tick) -> ST s ()
updateOne STArray s Tick (Tick, Tick)
arr) [(Tick, Tick, Tick)]
hits
forall (m :: * -> *) a. Monad m => a -> m a
return STArray s Tick (Tick, Tick)
arr
updateOne :: STArray s Int (Tick, Count) -> (Int, Tick, Count) -> ST s ()
updateOne :: forall s.
STArray s Tick (Tick, Tick) -> (Tick, Tick, Tick) -> ST s ()
updateOne STArray s Tick (Tick, Tick)
arr (Tick
i, Tick
hit, Tick
count) = do
(Tick
old_hit, Tick
old_count) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s Tick (Tick, Tick)
arr Tick
i
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Tick (Tick, Tick)
arr Tick
i (Tick -> Tick -> Tick
mergeEntry Tick
old_hit Tick
hit, forall a. Ord a => a -> a -> a
max Tick
old_count Tick
count)
mergeEntry :: Tick -> Tick -> Tick
mergeEntry Tick
prev Tick
curr
| Tick -> Bool
isMissed Tick
prev, Tick -> Bool
isFull Tick
curr = Tick
partial
| Tick -> Bool
isFull Tick
prev, Tick -> Bool
isMissed Tick
curr = Tick
partial
| Tick -> Bool
isPartial Tick
prev = Tick
prev
| Bool
otherwise = Tick
curr
ticksToHits :: [(Int, (Tick, Count))] -> LineHits
ticksToHits :: [(Tick, (Tick, Tick))] -> LineHits
ticksToHits = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. (a, (Tick, Tick)) -> [(a, Hit)] -> [(a, Hit)]
f []
where
f :: (a, (Tick, Tick)) -> [(a, Hit)] -> [(a, Hit)]
f (a
i,(Tick
tck,Tick
n)) [(a, Hit)]
acc
| Tick -> Bool
isIgnored Tick
tck = [(a, Hit)]
acc
| Tick -> Bool
isMissed Tick
tck = (a
i, Hit
Missed) forall a. a -> [a] -> [a]
: [(a, Hit)]
acc
| Tick -> Bool
isFull Tick
tck = (a
i, Tick -> Hit
Full Tick
n) forall a. a -> [a] -> [a]
: [(a, Hit)]
acc
| Bool
otherwise = (a
i, Tick -> Hit
Partial Tick
n) forall a. a -> [a] -> [a]
: [(a, Hit)]
acc
ignored, missed, partial, full :: Tick
ignored :: Tick
ignored = -Tick
1
missed :: Tick
missed = Tick
0
partial :: Tick
partial = Tick
1
full :: Tick
full = Tick
2
isIgnored :: Tick -> Bool
isIgnored :: Tick -> Bool
isIgnored = (forall a. Eq a => a -> a -> Bool
== Tick
ignored)
isMissed :: Tick -> Bool
isMissed :: Tick -> Bool
isMissed = (forall a. Eq a => a -> a -> Bool
== Tick
missed)
isPartial :: Tick -> Bool
isPartial :: Tick -> Bool
isPartial = (forall a. Eq a => a -> a -> Bool
== Tick
partial)
isFull :: Tick -> Bool
isFull :: Tick -> Bool
isFull = (forall a. Eq a => a -> a -> Bool
== Tick
full)
notTicked, ticked :: Tick
notTicked :: Tick
notTicked = Tick
missed
ticked :: Tick
ticked = Tick
full
makeInfo :: Int -> [Integer] -> [MixEntry] -> Info
makeInfo :: Tick -> [Integer] -> [MixEntry] -> Info
makeInfo Tick
size [Integer]
tixs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Info -> MixEntry -> Info
f Info
z
where
z :: Info
z = Tick
-> Tick
-> Tick
-> [(Tick, Tick, Tick)]
-> FunctionHits
-> PreBranchHits
-> Info
Info Tick
0 forall a. Bounded a => a
maxBound Tick
0 [] [] []
f :: Info -> MixEntry -> Info
f (Info Tick
i0 Tick
min_line Tick
max_line [(Tick, Tick, Tick)]
txs FunctionHits
fns PreBranchHits
brs) (HpcPos
pos, BoxLabel
boxLabel) =
let binBox :: [(Tick, Tick, Tick)]
binBox =
case (Tick -> Bool
isTicked Tick
i0, Tick -> Bool
isTicked Tick
i1) of
(Bool
False, Bool
False) -> [(Tick, Tick, Tick)]
txs
(Bool
True, Bool
False) -> (Tick
sl, Tick
partial, Tick -> Tick
numTicked Tick
i0) forall a. a -> [a] -> [a]
: [(Tick, Tick, Tick)]
txs
(Bool
False, Bool
True) -> (Tick
sl, Tick
partial, Tick -> Tick
numTicked Tick
i1) forall a. a -> [a] -> [a]
: [(Tick, Tick, Tick)]
txs
(Bool
True, Bool
True) -> [(Tick, Tick, Tick)]
txs
tickBox :: [(Tick, Tick, Tick)]
tickBox =
let t :: Tick
t | Tick -> Bool
isTicked Tick
i0 = Tick
ticked
| Bool
otherwise = Tick
notTicked
in (Tick
sl, Tick
t, Tick -> Tick
numTicked Tick
i0) forall a. a -> [a] -> [a]
: [(Tick, Tick, Tick)]
txs
tlBox :: [FilePath] -> FunctionHits
tlBox [FilePath]
ns = (Tick
sl, Tick
el, Tick -> Tick
numTicked Tick
i0, forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"." [FilePath]
ns) forall a. a -> [a] -> [a]
: FunctionHits
fns
br :: b -> (Tick, b, Tick)
br b
bool = (Tick
sl, b
bool, Tick -> Tick
numTicked Tick
i0)
([(Tick, Tick, Tick)]
txs', FunctionHits
fns', PreBranchHits
brs') =
case BoxLabel
boxLabel of
ExpBox {} -> ([(Tick, Tick, Tick)]
tickBox, FunctionHits
fns, PreBranchHits
brs)
TopLevelBox [FilePath]
ns -> ([(Tick, Tick, Tick)]
tickBox, [FilePath] -> FunctionHits
tlBox [FilePath]
ns, PreBranchHits
brs)
LocalBox {} -> ([(Tick, Tick, Tick)]
tickBox, FunctionHits
fns, PreBranchHits
brs)
BinBox CondBox
_ Bool
True -> ([(Tick, Tick, Tick)]
binBox, FunctionHits
fns, forall {b}. b -> (Tick, b, Tick)
br Bool
True forall a. a -> [a] -> [a]
: PreBranchHits
brs)
BinBox CondBox
_ Bool
False -> ([(Tick, Tick, Tick)]
txs, FunctionHits
fns, forall {b}. b -> (Tick, b, Tick)
br Bool
False forall a. a -> [a] -> [a]
: PreBranchHits
brs)
(Tick
sl, Tick
_, Tick
el, Tick
_) = HpcPos -> (Tick, Tick, Tick, Tick)
fromHpcPos HpcPos
pos
i1 :: Tick
i1 = Tick
i0 forall a. Num a => a -> a -> a
+ Tick
1
in Tick
-> Tick
-> Tick
-> [(Tick, Tick, Tick)]
-> FunctionHits
-> PreBranchHits
-> Info
Info Tick
i1 (forall a. Ord a => a -> a -> a
min Tick
sl Tick
min_line) (forall a. Ord a => a -> a -> a
max Tick
el Tick
max_line) [(Tick, Tick, Tick)]
txs' FunctionHits
fns' PreBranchHits
brs'
numTicked :: Tick -> Tick
numTicked = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Tick -> e
unsafeAt UArray Tick Tick
arr_tix
isTicked :: Tick -> Bool
isTicked Tick
n = Tick -> Tick
numTicked Tick
n forall a. Eq a => a -> a -> Bool
/= Tick
0
arr_tix :: UArray Int Tick
arr_tix :: UArray Tick Tick
arr_tix = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Tick
0, Tick
size forall a. Num a => a -> a -> a
- Tick
1) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
tixs)