{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Trace.Hpc.Codecov.Report.Emit
( buildCodecov
, buildLcov
, buildCobertura
) where
import Data.Char (isUpper)
import Data.List (foldl', intercalate,
intersperse)
import System.IO.Unsafe (unsafePerformIO)
#if !MIN_VERSION_bytestring(0,11,0)
import Text.Printf (printf)
#endif
import Data.ByteString.Builder (Builder, char7, intDec,
string7, stringUtf8)
#if MIN_VERSION_bytestring(0,11,0)
import Data.ByteString.Builder.RealFloat (formatDouble,
standardDefaultPrecision)
#endif
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import System.FilePath (dropExtension,
splitDirectories,
takeDirectory)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Trace.Hpc.Codecov.Report.Entry
buildCodecov :: [CoverageEntry] -> Builder
buildCodecov :: [CoverageEntry] -> Builder
buildCodecov [CoverageEntry]
entries = Builder
contents
where
contents :: Builder
contents =
Builder -> Builder
braced (Builder -> Builder
key (String -> Builder
string7 String
"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 (String -> Builder
stringUtf8 (CoverageEntry -> String
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 (Int, 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
':'
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 :: (Int, Hit) -> Builder
hit (Int
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 (String -> Builder
string7 String
"1/2")
Full Int
i -> Builder
k forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
i
where
k :: Builder
k = Builder -> Builder
key (Int -> Builder
intDec Int
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 =
String -> Builder
string7 String
"TN:" forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
String -> Builder
string7 String
"SF:" forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 (CoverageEntry -> String
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
<>
String -> Builder
string7 String
"FNF:" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
fnf forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
String -> Builder
string7 String
"FNH:" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
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
<>
String -> Builder
string7 String
"BRF:" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
brf forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
String -> Builder
string7 String
"BRH:" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
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
<>
String -> Builder
string7 String
"LF:" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
lf forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
String -> Builder
string7 String
"LH:" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
lh forall a. Semigroup a => a -> a -> a
<> Builder
nl forall a. Semigroup a => a -> a -> a
<>
String -> Builder
string7 String
"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, Int
fnf, Int
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) =>
(Int, Int, Int, String)
-> ([Builder], [Builder], c, d) -> ([Builder], [Builder], c, d)
ffn (CoverageEntry -> FunctionHits
ce_fns CoverageEntry
e)
ffn :: (Int, Int, Int, String)
-> ([Builder], [Builder], c, d) -> ([Builder], [Builder], c, d)
ffn (Int
sl, Int
el, Int
n, String
name) ([Builder]
fn_acc, [Builder]
fnda_acc, c
num_fns, d
num_hit_fns) =
( String -> Builder
string7 String
"FN:" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
sl forall a. Semigroup a => a -> a -> a
<> Builder
comma forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
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
, String -> Builder
string7 String
"FNDA:" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
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 Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then d
num_hit_fns else d
num_hit_fns forall a. Num a => a -> a -> a
+ d
1 )
where
name' :: Builder
name' = String -> Builder
stringUtf8 String
name
(Builder
brdas_and_nl, Int
brf, Int
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) =>
(Int, Int, Bool, Int)
-> (a, [Builder], c, d) -> ([a], [Builder], c, d)
fbr (CoverageEntry -> BranchHits
ce_branches CoverageEntry
e)
fbr :: (Int, Int, Bool, Int)
-> (a, [Builder], c, d) -> ([a], [Builder], c, d)
fbr (Int
sl, Int
blk, Bool
bool, Int
n) (a
_, [Builder]
br, c
num_brs, d
num_hit_brs) =
( []
, String -> Builder
string7 String
"BRDA:" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
sl forall a. Semigroup a => a -> a -> a
<> Builder
comma forall a. Semigroup a => a -> a -> a
<>
Int -> Builder
intDec Int
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
<>
Int -> Builder
intDec Int
n forall a. a -> [a] -> [a]
: [Builder]
br
, c
num_brs forall a. Num a => a -> a -> a
+ c
1
, if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then d
num_hit_brs else d
num_hit_brs forall a. Num a => a -> a -> a
+ d
1 )
(Builder
das_and_nl, Int
lf, Int
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) =>
(Int, Hit) -> (a, [Builder], c, d) -> ([a], [Builder], c, d)
fda (CoverageEntry -> LineHits
ce_hits CoverageEntry
e)
fda :: (Int, Hit) -> (a, [Builder], c, d) -> ([a], [Builder], c, d)
fda (Int
n, Hit
hit) (a
_, [Builder]
da, c
num_lines, d
num_hits) =
case Hit
hit of
Hit
Missed -> ([], Int -> Builder
da0 Int
nforall a. a -> [a] -> [a]
:[Builder]
da, c
num_lines forall a. Num a => a -> a -> a
+ c
1, d
num_hits)
Partial Int
i -> ([], Int -> Int -> Builder
dai Int
n Int
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 Int
i -> ([], Int -> Int -> Builder
dai Int
n Int
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 :: Int -> Builder
da0 Int
n = String -> Builder
string7 String
"DA:" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
n forall a. Semigroup a => a -> a -> a
<> Builder
comma forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'0'
dai :: Int -> Int -> Builder
dai Int
n Int
i = String -> Builder
string7 String
"DA:" forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
n forall a. Semigroup a => a -> a -> a
<> Builder
comma forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
i
nl :: Builder
nl = Char -> Builder
char7 Char
'\n'
class HasRate c e where
numValid :: c e -> Int
numCovered :: c e -> Int
newtype Lines a = Lines {forall a. Lines a -> a
unLines :: a}
newtype Branches a = Branches {forall a. Branches a -> a
unBranches :: a}
buildRateOf :: HasRate c e => c e -> Builder
buildRateOf :: forall (c :: * -> *) e. HasRate c e => c e -> Builder
buildRateOf c e
x = Int -> Int -> Builder
buildRate (forall (c :: * -> *) e. HasRate c e => c e -> Int
numCovered c e
x) (forall (c :: * -> *) e. HasRate c e => c e -> Int
numValid c e
x)
{-# INLINABLE buildRateOf #-}
buildRate :: Int -> Int -> Builder
buildRate :: Int -> Int -> Builder
buildRate Int
n Int
d =
if Int
d forall a. Eq a => a -> a -> Bool
== Int
0 then
String -> Builder
string7 String
"0.0"
else
Double -> Builder
formatStandardDouble (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
{-# INLINABLE buildRate #-}
data Acc = Acc
{ Acc -> Int
acc_valid_lines :: !Int
, Acc -> Int
acc_covered_lines :: !Int
, Acc -> Int
acc_valid_branches :: !Int
, Acc -> Int
acc_covered_branches :: !Int
}
accLinesAndBranches :: (HasRate Lines e, HasRate Branches e) => [e] -> Acc
accLinesAndBranches :: forall e. (HasRate Lines e, HasRate Branches e) => [e] -> Acc
accLinesAndBranches = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {e}.
(HasRate Lines e, HasRate Branches e) =>
Acc -> e -> Acc
f (Int -> Int -> Int -> Int -> Acc
Acc Int
0 Int
0 Int
0 Int
0)
where
f :: Acc -> e -> Acc
f Acc
acc e
e = Acc
acc
{ acc_valid_lines :: Int
acc_valid_lines = Acc -> Int
acc_valid_lines Acc
acc forall a. Num a => a -> a -> a
+ forall (c :: * -> *) e. HasRate c e => c e -> Int
numValid (forall a. a -> Lines a
Lines e
e)
, acc_covered_lines :: Int
acc_covered_lines = Acc -> Int
acc_covered_lines Acc
acc forall a. Num a => a -> a -> a
+ forall (c :: * -> *) e. HasRate c e => c e -> Int
numCovered (forall a. a -> Lines a
Lines e
e)
, acc_valid_branches :: Int
acc_valid_branches = Acc -> Int
acc_valid_branches Acc
acc forall a. Num a => a -> a -> a
+ forall (c :: * -> *) e. HasRate c e => c e -> Int
numValid (forall a. a -> Branches a
Branches e
e)
, acc_covered_branches :: Int
acc_covered_branches = Acc -> Int
acc_covered_branches Acc
acc forall a. Num a => a -> a -> a
+ forall (c :: * -> *) e. HasRate c e => c e -> Int
numCovered (forall a. a -> Branches a
Branches e
e)
}
data CoberturaPackage = CoberturaPackage
{ CoberturaPackage -> String
cp_name :: String
, CoberturaPackage -> Int
cp_lines_valid :: !Int
, CoberturaPackage -> Int
cp_lines_covered :: !Int
, CoberturaPackage -> Int
cp_branch_valid :: !Int
, CoberturaPackage -> Int
cp_branch_covered :: !Int
, CoberturaPackage -> [CoberturaClass]
cp_classes :: [CoberturaClass]
}
instance HasRate Lines CoberturaPackage where
numValid :: Lines CoberturaPackage -> Int
numValid = CoberturaPackage -> Int
cp_lines_valid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lines a -> a
unLines
{-# INLINE numValid #-}
numCovered :: Lines CoberturaPackage -> Int
numCovered = CoberturaPackage -> Int
cp_lines_covered forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lines a -> a
unLines
{-# INLINE numCovered #-}
instance HasRate Branches CoberturaPackage where
numValid :: Branches CoberturaPackage -> Int
numValid = CoberturaPackage -> Int
cp_branch_valid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Branches a -> a
unBranches
{-# INLINE numValid #-}
numCovered :: Branches CoberturaPackage -> Int
numCovered = CoberturaPackage -> Int
cp_branch_covered forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Branches a -> a
unBranches
{-# INLINE numCovered #-}
data CoberturaClass = CoberturaClass
{ CoberturaClass -> String
cc_filename :: String
, CoberturaClass -> Int
cc_lines_valid :: !Int
, CoberturaClass -> Int
cc_lines_covered :: !Int
, CoberturaClass -> Int
cc_branch_valid :: !Int
, CoberturaClass -> Int
cc_branch_covered :: !Int
, CoberturaClass -> [CoberturaMethod]
cc_methods :: [CoberturaMethod]
, CoberturaClass -> [CoberturaLine]
cc_lines :: [CoberturaLine]
}
instance HasRate Lines CoberturaClass where
numValid :: Lines CoberturaClass -> Int
numValid = CoberturaClass -> Int
cc_lines_valid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lines a -> a
unLines
{-# INLINE numValid #-}
numCovered :: Lines CoberturaClass -> Int
numCovered = CoberturaClass -> Int
cc_lines_covered forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lines a -> a
unLines
{-# INLINE numCovered #-}
instance HasRate Branches CoberturaClass where
numValid :: Branches CoberturaClass -> Int
numValid = CoberturaClass -> Int
cc_branch_valid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Branches a -> a
unBranches
{-# INLINE numValid #-}
numCovered :: Branches CoberturaClass -> Int
numCovered = CoberturaClass -> Int
cc_branch_covered forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Branches a -> a
unBranches
{-# INLINE numCovered #-}
data CoberturaMethod = CoberturaMethod
{ CoberturaMethod -> Int
cm_line_num :: !Int
, CoberturaMethod -> String
cm_name :: String
}
data CoberturaLine = CoberturaLine
{ CoberturaLine -> Int
cl_line_num :: !Int
, CoberturaLine -> Int
cl_num_hits :: !Int
, CoberturaLine -> Map (Int, Bool) Int
cl_branch_hits :: Map.Map (Int, Bool) Int
}
buildCobertura :: [CoverageEntry] -> Builder
buildCobertura :: [CoverageEntry] -> Builder
buildCobertura [CoverageEntry]
es =
String -> Builder
string7 String
"<?xml version=\"1.0\" ?>" forall a. Semigroup a => a -> a -> a
<>
String -> Builder
string7 String
"<!DOCTYPE coverage SYSTEM 'http://cobertura.sourceforge.nex/xml/coverage-0.4.dtd'>" forall a. Semigroup a => a -> a -> a
<>
String -> [(String, Builder)] -> Builder -> Builder
xmlTagWith String
"coverage" [(String, Builder)]
coverage_attrs
(String -> Builder -> Builder
xmlTag String
"sources" (String -> Builder -> Builder
xmlTag String
"source" (Char -> Builder
char7 Char
'.')) forall a. Semigroup a => a -> a -> a
<>
String -> Builder -> Builder
xmlTag String
"packages" (forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map CoberturaPackage -> Builder
buildCoberturaPackage [CoberturaPackage]
pkgs))) forall a. Semigroup a => a -> a -> a
<>
Char -> Builder
char7 Char
'\n'
where
coverage_attrs :: [(String, Builder)]
coverage_attrs =
[(String
"branch-rate", Int -> Int -> Builder
buildRate Int
bc Int
bv)
,(String
"branches-covered", Int -> Builder
intDec Int
bc)
,(String
"branches-valid", Int -> Builder
intDec Int
bv)
,(String
"complexity", Char -> Builder
char7 Char
'0')
,(String
"line-rate", Int -> Int -> Builder
buildRate Int
lc Int
lv)
,(String
"lines-covered", Int -> Builder
intDec Int
lc)
,(String
"lines-valid", Int -> Builder
intDec Int
lv)
,(String
"timestamp", Int -> Builder
intDec forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
unsafeGetTimestamp)
,(String
"version", String -> Builder
string7 String
"2.0.3")]
pkgs :: [CoberturaPackage]
pkgs = [CoverageEntry] -> [CoberturaPackage]
toCoberturaPackages [CoverageEntry]
es
Acc Int
lv Int
lc Int
bv Int
bc = forall e. (HasRate Lines e, HasRate Branches e) => [e] -> Acc
accLinesAndBranches [CoberturaPackage]
pkgs
unsafeGetTimestamp :: Integer
unsafeGetTimestamp :: Integer
unsafeGetTimestamp = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. IO a -> a
unsafePerformIO IO POSIXTime
getPOSIXTime)
{-# NOINLINE unsafeGetTimestamp #-}
buildCoberturaPackage :: CoberturaPackage -> Builder
buildCoberturaPackage :: CoberturaPackage -> Builder
buildCoberturaPackage CoberturaPackage
cp =
String -> [(String, Builder)] -> Builder -> Builder
xmlTagWith String
"package" [(String, Builder)]
package_attrs
(String -> Builder -> Builder
xmlTag String
"classes"
(forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map CoberturaClass -> Builder
buildCoberturaClass (CoberturaPackage -> [CoberturaClass]
cp_classes CoberturaPackage
cp))))
where
package_attrs :: [(String, Builder)]
package_attrs =
[(String
"name", String -> Builder
stringUtf8 forall a b. (a -> b) -> a -> b
$ CoberturaPackage -> String
cp_name CoberturaPackage
cp)
,(String
"line-rate", forall (c :: * -> *) e. HasRate c e => c e -> Builder
buildRateOf (forall a. a -> Lines a
Lines CoberturaPackage
cp))
,(String
"branch-rate", forall (c :: * -> *) e. HasRate c e => c e -> Builder
buildRateOf (forall a. a -> Branches a
Branches CoberturaPackage
cp))
,(String
"complexity", Char -> Builder
char7 Char
'0')]
buildCoberturaClass :: CoberturaClass -> Builder
buildCoberturaClass :: CoberturaClass -> Builder
buildCoberturaClass CoberturaClass
cc =
String -> [(String, Builder)] -> Builder -> Builder
xmlTagWith String
"class" [(String, Builder)]
class_attrs
(String -> Builder -> Builder
xmlTag String
"methods" (forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map CoberturaMethod -> Builder
method (CoberturaClass -> [CoberturaMethod]
cc_methods CoberturaClass
cc))) forall a. Semigroup a => a -> a -> a
<>
String -> Builder -> Builder
xmlTag String
"lines" (forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map CoberturaLine -> Builder
line (CoberturaClass -> [CoberturaLine]
cc_lines CoberturaClass
cc))))
where
class_attrs :: [(String, Builder)]
class_attrs =
[(String
"branch-rate", forall (c :: * -> *) e. HasRate c e => c e -> Builder
buildRateOf (forall a. a -> Branches a
Branches CoberturaClass
cc))
,(String
"complexity", Char -> Builder
char7 Char
'0')
,(String
"filename", String -> Builder
stringUtf8 forall a b. (a -> b) -> a -> b
$ CoberturaClass -> String
cc_filename CoberturaClass
cc)
,(String
"line-rate", forall (c :: * -> *) e. HasRate c e => c e -> Builder
buildRateOf (forall a. a -> Lines a
Lines CoberturaClass
cc))
,(String
"name", String -> Builder
stringUtf8 forall a b. (a -> b) -> a -> b
$ String -> String
toModuleName (CoberturaClass -> String
cc_filename CoberturaClass
cc))]
method :: CoberturaMethod -> Builder
method CoberturaMethod
cm =
String -> [(String, Builder)] -> Builder -> Builder
xmlTagWith String
"method" [(String, Builder)]
method_attrs
(String -> Builder -> Builder
xmlTag String
"lines" ([(String, Builder)] -> Builder
line_tag [(String, Builder)]
line_attrs))
where
method_attrs :: [(String, Builder)]
method_attrs =
[(String
"name", String -> Builder
stringUtf8 forall a b. (a -> b) -> a -> b
$ String -> String
xmlEscape (CoberturaMethod -> String
cm_name CoberturaMethod
cm))
,(String
"signature", forall a. Monoid a => a
mempty)
,(String
"line-rate", String -> Builder
string7 String
"0.0")
,(String
"branch-rate", String -> Builder
string7 String
"0.0")]
line_attrs :: [(String, Builder)]
line_attrs =
[(String
"hits", Char -> Builder
char7 Char
'0')
,(String
"number", Int -> Builder
intDec (CoberturaMethod -> Int
cm_line_num CoberturaMethod
cm))
,(String
"branch", String -> Builder
string7 String
"false")]
line :: CoberturaLine -> Builder
line CoberturaLine
cl = [(String, Builder)] -> Builder
line_tag [(String, Builder)]
line_attrs
where
is_branch :: Bool
is_branch = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CoberturaLine -> Map (Int, Bool) Int
cl_branch_hits CoberturaLine
cl))
line_attrs :: [(String, Builder)]
line_attrs =
[(String
"branch", String -> Builder
string7 forall a b. (a -> b) -> a -> b
$ if Bool
is_branch then String
"true" else String
"false")
,(String
"hits", Int -> Builder
intDec (CoberturaLine -> Int
cl_num_hits CoberturaLine
cl))
,(String
"number", Int -> Builder
intDec (CoberturaLine -> Int
cl_line_num CoberturaLine
cl)) ] forall a. Semigroup a => a -> a -> a
<>
[(String
"condition-coverage", forall a. Map a Int -> Builder
buildConditionCoverage (CoberturaLine -> Map (Int, Bool) Int
cl_branch_hits CoberturaLine
cl))
| Bool
is_branch ]
line_tag :: [(String, Builder)] -> Builder
line_tag [(String, Builder)]
attrs =
String -> Builder
string7 String
"<line" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (String, Builder) -> Builder
xmlAttr [(String, Builder)]
attrs) forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7 String
"/>"
buildConditionCoverage :: Map.Map a Int -> Builder
buildConditionCoverage :: forall a. Map a Int -> Builder
buildConditionCoverage Map a Int
m = Builder
fmt
where
fmt :: Builder
fmt = Builder
percentage forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
' ' forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'(' forall a. Semigroup a => a -> a -> a
<> Builder
fraction forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
')'
percentage :: Builder
percentage = Int -> Builder
intDec (forall a b. (RealFrac a, Integral b) => a -> b
round (Double
100 forall a. Num a => a -> a -> a
* Double
rate)) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'%'
fraction :: Builder
fraction = Int -> Builder
intDec Int
covered forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'/' forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
valid
rate :: Double
rate = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
covered forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
valid :: Double
(Int
covered, Int
valid) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a} {a} {b}.
(Ord a, Num a, Num a, Num b) =>
(a, b) -> a -> (a, b)
f (Int
0, Int
0) Map a Int
m
f :: (a, b) -> a -> (a, b)
f (a
c, b
v) a
num_hits = (if a
0 forall a. Ord a => a -> a -> Bool
< a
num_hits then a
c forall a. Num a => a -> a -> a
+ a
1 else a
c, b
v forall a. Num a => a -> a -> a
+ b
1)
toCoberturaPackages :: [CoverageEntry] -> [CoberturaPackage]
toCoberturaPackages :: [CoverageEntry] -> [CoberturaPackage]
toCoberturaPackages =
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' String
-> [CoberturaClass] -> [CoberturaPackage] -> [CoberturaPackage]
go [] 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. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map CoverageEntry -> (String, [CoberturaClass])
pair_with_pkgname
where
pair_with_pkgname :: CoverageEntry -> (String, [CoberturaClass])
pair_with_pkgname CoverageEntry
ce =
(String -> String
toCoberturaPackageName (CoverageEntry -> String
ce_filename CoverageEntry
ce), [CoverageEntry -> CoberturaClass
toCoberturaClass CoverageEntry
ce])
go :: String
-> [CoberturaClass] -> [CoberturaPackage] -> [CoberturaPackage]
go String
pkg_name [CoberturaClass]
ces [CoberturaPackage]
acc =
let Acc Int
lv Int
lc Int
bv Int
bc = forall e. (HasRate Lines e, HasRate Branches e) => [e] -> Acc
accLinesAndBranches [CoberturaClass]
ces
in CoberturaPackage { cp_name :: String
cp_name = String
pkg_name
, cp_lines_valid :: Int
cp_lines_valid = Int
lv
, cp_lines_covered :: Int
cp_lines_covered = Int
lc
, cp_branch_valid :: Int
cp_branch_valid = Int
bv
, cp_branch_covered :: Int
cp_branch_covered = Int
bc
, cp_classes :: [CoberturaClass]
cp_classes = [CoberturaClass]
ces
} forall a. a -> [a] -> [a]
: [CoberturaPackage]
acc
toCoberturaClass :: CoverageEntry -> CoberturaClass
toCoberturaClass :: CoverageEntry -> CoberturaClass
toCoberturaClass CoverageEntry
ce = CoberturaClass
{ cc_filename :: String
cc_filename = CoverageEntry -> String
ce_filename CoverageEntry
ce
, cc_lines_valid :: Int
cc_lines_valid = Int
lv
, cc_lines_covered :: Int
cc_lines_covered = Int
lc
, cc_branch_valid :: Int
cc_branch_valid = Int
bv
, cc_branch_covered :: Int
cc_branch_covered = Int
bc
, cc_methods :: [CoberturaMethod]
cc_methods = [CoberturaMethod]
methods
, cc_lines :: [CoberturaLine]
cc_lines = forall a. IntMap a -> [a]
IntMap.elems IntMap CoberturaLine
im1
}
where
(Int
lv, Int
lc, IntMap CoberturaLine
im0) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a} {b}.
(Num a, Num b) =>
(a, b, IntMap CoberturaLine)
-> (Int, Hit) -> (a, b, IntMap CoberturaLine)
acc_line (Int
0, Int
0, forall a. Monoid a => a
mempty) (CoverageEntry -> LineHits
ce_hits CoverageEntry
ce)
(Int
bv, Int
bc, IntMap CoberturaLine
im1) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a} {b}.
(Num a, Num b) =>
(a, b, IntMap CoberturaLine)
-> (Int, Int, Bool, Int) -> (a, b, IntMap CoberturaLine)
acc_branch (Int
0, Int
0, IntMap CoberturaLine
im0) (CoverageEntry -> BranchHits
ce_branches CoverageEntry
ce)
acc_line :: (a, b, IntMap CoberturaLine)
-> (Int, Hit) -> (a, b, IntMap CoberturaLine)
acc_line (a
lv0, b
lc0, IntMap CoberturaLine
im) (Int
n, Hit
hit) =
case Hit
hit of
Hit
Missed -> (a
lv0 forall a. Num a => a -> a -> a
+ a
1, b
lc0, forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
n (Int -> Int -> CoberturaLine
make_line Int
n Int
0) IntMap CoberturaLine
im)
Partial Int
i -> (a
lv0 forall a. Num a => a -> a -> a
+ a
1, b
lc0 forall a. Num a => a -> a -> a
+ b
1, forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
n (Int -> Int -> CoberturaLine
make_line Int
n Int
i) IntMap CoberturaLine
im)
Full Int
i -> (a
lv0 forall a. Num a => a -> a -> a
+ a
1, b
lc0 forall a. Num a => a -> a -> a
+ b
1, forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
n (Int -> Int -> CoberturaLine
make_line Int
n Int
i) IntMap CoberturaLine
im)
make_line :: Int -> Int -> CoberturaLine
make_line Int
n Int
i = Int -> Int -> Map (Int, Bool) Int -> CoberturaLine
CoberturaLine Int
n Int
i forall a. Monoid a => a
mempty
make_branch :: Int -> Int -> Int -> Bool -> CoberturaLine
make_branch Int
n Int
i Int
bn Bool
bool = Int -> Int -> Map (Int, Bool) Int -> CoberturaLine
CoberturaLine Int
n Int
i (forall k a. k -> a -> Map k a
Map.singleton (Int
bn,Bool
bool) Int
i)
merge_brs :: CoberturaLine -> CoberturaLine -> CoberturaLine
merge_brs CoberturaLine
new_cl CoberturaLine
old_cl = CoberturaLine
{ cl_line_num :: Int
cl_line_num = CoberturaLine -> Int
cl_line_num CoberturaLine
old_cl
, cl_num_hits :: Int
cl_num_hits = forall a. Ord a => a -> a -> a
max (CoberturaLine -> Int
cl_num_hits CoberturaLine
old_cl) (CoberturaLine -> Int
cl_num_hits CoberturaLine
new_cl)
, cl_branch_hits :: Map (Int, Bool) Int
cl_branch_hits =
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Num a => a -> a -> a
(+) (CoberturaLine -> Map (Int, Bool) Int
cl_branch_hits CoberturaLine
old_cl) (CoberturaLine -> Map (Int, Bool) Int
cl_branch_hits CoberturaLine
new_cl)
}
acc_branch :: (a, b, IntMap CoberturaLine)
-> (Int, Int, Bool, Int) -> (a, b, IntMap CoberturaLine)
acc_branch (a
bv0, b
bc0, IntMap CoberturaLine
im) (Int
n, Int
bn, Bool
bool, Int
count) =
let im' :: IntMap CoberturaLine
im' = forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWith CoberturaLine -> CoberturaLine -> CoberturaLine
merge_brs Int
n (Int -> Int -> Int -> Bool -> CoberturaLine
make_branch Int
n Int
count Int
bn Bool
bool) IntMap CoberturaLine
im
in (a
bv0 forall a. Num a => a -> a -> a
+ a
1, if Int
count forall a. Eq a => a -> a -> Bool
== Int
0 then b
bc0 else b
bc0 forall a. Num a => a -> a -> a
+ b
1, IntMap CoberturaLine
im')
methods :: [CoberturaMethod]
methods = forall a b. (a -> b) -> [a] -> [b]
map forall {b} {c}. (Int, b, c, String) -> CoberturaMethod
to_method (CoverageEntry -> FunctionHits
ce_fns CoverageEntry
ce)
to_method :: (Int, b, c, String) -> CoberturaMethod
to_method (Int
sl,b
_,c
_,String
name) = Int -> String -> CoberturaMethod
CoberturaMethod Int
sl String
name
toCoberturaPackageName :: FilePath -> String
toCoberturaPackageName :: String -> String
toCoberturaPackageName = forall a. [a] -> [[a]] -> [a]
intercalate String
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeDirectory
toModuleName :: FilePath -> String
toModuleName :: String -> String
toModuleName String
path = forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
paths'
where
paths' :: [String]
paths' = [String
p | p :: String
p@(Char
c:String
_) <- String -> [String]
splitDirectories (String -> String
dropExtension String
path), Char -> Bool
isUpper Char
c ]
xmlTag :: String -> Builder -> Builder
xmlTag :: String -> Builder -> Builder
xmlTag String
name = String -> [(String, Builder)] -> Builder -> Builder
xmlTagWith String
name []
xmlTagWith :: String -> [(String, Builder)] -> Builder -> Builder
xmlTagWith :: String -> [(String, Builder)] -> Builder -> Builder
xmlTagWith String
name [(String, Builder)]
attrs Builder
body =
Char -> Builder
char7 Char
'<' forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7 String
name forall a. Semigroup a => a -> a -> a
<> Builder
attrs' forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'>' forall a. Semigroup a => a -> a -> a
<>
Builder
body forall a. Semigroup a => a -> a -> a
<>
String -> Builder
string7 String
"</" forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7 String
name forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'>'
where
attrs' :: Builder
attrs' =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Builder)]
attrs then forall a. Monoid a => a
mempty else forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (String, Builder) -> Builder
xmlAttr [(String, Builder)]
attrs)
xmlAttr :: (String, Builder) -> Builder
xmlAttr :: (String, Builder) -> Builder
xmlAttr (String
name, Builder
val) = Char -> Builder
char7 Char
' ' forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7 String
name forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'=' forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
dquote Builder
val
xmlEscape :: String -> String
xmlEscape :: String -> String
xmlEscape = String -> String
go
where
go :: String -> String
go [] = []
go (Char
c:String
rest) = case Char
c of
Char
'>' -> String
">" forall a. Semigroup a => a -> a -> a
<> String -> String
go String
rest
Char
'<' -> String
"<" forall a. Semigroup a => a -> a -> a
<> String -> String
go String
rest
Char
'"' -> String
""" forall a. Semigroup a => a -> a -> a
<> String -> String
go String
rest
Char
'&' -> String
"&" forall a. Semigroup a => a -> a -> a
<> String -> String
go String
rest
Char
_ -> Char
cforall a. a -> [a] -> [a]
:String -> String
go String
rest
dquote :: Builder -> Builder
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
'"'
{-# INLINABLE dquote #-}
comma :: Builder
comma :: Builder
comma = Char -> Builder
char7 Char
','
{-# INLINABLE comma #-}
formatStandardDouble :: Double -> Builder
#if MIN_VERSION_bytestring(0,11,0)
formatStandardDouble :: Double -> Builder
formatStandardDouble = FloatFormat -> Double -> Builder
formatDouble FloatFormat
standardDefaultPrecision
#else
formatStandardDouble = string7 . printf "%f"
#endif
{-# INLINABLE formatStandardDouble #-}