{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- |
-- Module:     Trace.Hpc.Codecov.Report.Emit
-- Copyright:  (c) 2023 8c6794b6
-- License:    BSD3
-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>
--
-- Emit 'CoverageEntry' to other report format.

module Trace.Hpc.Codecov.Report.Emit
  ( buildCodecov
  , buildLcov
  , buildCobertura
  ) where

-- base
import           Data.Char                         (isUpper)
import           Data.List                         (intercalate,
                                                    intersperse)
import           System.IO.Unsafe                  (unsafePerformIO)

#if !MIN_VERSION_base(4,20,0)
import           Data.List                         (foldl')
#endif

#if !MIN_VERSION_bytestring(0,11,0)
import           Text.Printf                       (printf)
#endif

-- bytestring
import           Data.ByteString.Builder           (Builder, char7, intDec,
                                                    string7, stringUtf8)
#if MIN_VERSION_bytestring(0,11,0)
import           Data.ByteString.Builder.RealFloat (formatDouble,
                                                    standardDefaultPrecision)
#endif

-- containers
import qualified Data.IntMap                       as IntMap
import qualified Data.Map                          as Map

-- filepath
import           System.FilePath                   (dropExtension,
                                                    splitDirectories,
                                                    takeDirectory)

-- time
import           Data.Time.Clock.POSIX             (getPOSIXTime)

-- Internal
import           Trace.Hpc.Codecov.Report.Entry


-- ------------------------------------------------------------------------
-- Codecov
-- ------------------------------------------------------------------------

-- | Build simple Codecov JSON report from coverage entries.
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") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
              Builder -> Builder
braced ([Builder] -> Builder
listify ((CoverageEntry -> Builder) -> [CoverageEntry] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map CoverageEntry -> Builder
report [CoverageEntry]
entries))) Builder -> Builder -> Builder
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)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder -> Builder
braced ([Builder] -> Builder
listify (((Int, Hit) -> Builder) -> [(Int, Hit)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Hit) -> Builder
hit (CoverageEntry -> [(Int, Hit)]
ce_hits CoverageEntry
ce)))
    key :: Builder -> Builder
key Builder
x = Builder -> Builder
dquote Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':'
    braced :: Builder -> Builder
braced Builder
x = Char -> Builder
char7 Char
'{' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'}'
    listify :: [Builder] -> Builder
listify [Builder]
xs = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'0'
        Partial {} -> Builder
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
dquote (String -> Builder
string7 String
"1/2")
        Full Int
i     -> Builder
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
i
      where
        k :: Builder
k = Builder -> Builder
key (Int -> Builder
intDec Int
n)


-- ------------------------------------------------------------------------
-- Lcov
-- ------------------------------------------------------------------------

-- | Build simple lcov tracefile from coverage entries.
buildLcov :: [CoverageEntry] -> Builder
buildLcov :: [CoverageEntry] -> Builder
buildLcov = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([CoverageEntry] -> [Builder]) -> [CoverageEntry] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoverageEntry -> Builder) -> [CoverageEntry] -> [Builder]
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:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  String -> Builder
string7 String
"SF:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringUtf8 (CoverageEntry -> String
ce_filename CoverageEntry
e) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Builder
fns_and_nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  String -> Builder
string7 String
"FNF:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
fnf Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  String -> Builder
string7 String
"FNH:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
fnh Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Builder
brdas_and_nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  String -> Builder
string7 String
"BRF:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
brf Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  String -> Builder
string7 String
"BRH:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
brh Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Builder
das_and_nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  String -> Builder
string7 String
"LF:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
lf Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  String -> Builder
string7 String
"LH:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
lh Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  String -> Builder
string7 String
"end_of_record" Builder -> Builder -> Builder
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) = (a -> ([Builder], [Builder], b, c) -> ([Builder], [Builder], b, c))
-> ([Builder], [Builder], b, c)
-> t a
-> ([Builder], [Builder], b, c)
forall a b. (a -> b -> b) -> b -> t a -> b
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 [Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> [Builder]
bs
          res_and_nl :: Builder
res_and_nl | [Builder] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Builder]
res = Builder
forall a. Monoid a => a
mempty
                     | Bool
otherwise = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
nl [Builder]
res) Builder -> Builder -> Builder
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) = ((Int, Int, Int, String)
 -> ([Builder], [Builder], Int, Int)
 -> ([Builder], [Builder], Int, Int))
-> [(Int, Int, Int, String)] -> (Builder, Int, Int)
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 (Int, Int, Int, String)
-> ([Builder], [Builder], Int, Int)
-> ([Builder], [Builder], Int, Int)
forall {c} {d}.
(Num c, Num d) =>
(Int, Int, Int, String)
-> ([Builder], [Builder], c, d) -> ([Builder], [Builder], c, d)
ffn (CoverageEntry -> [(Int, Int, Int, String)]
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:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
sl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
comma Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
el Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
comma Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
name' Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
fn_acc
      , String -> Builder
string7 String
"FNDA:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
comma Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
name' Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
fnda_acc
      , c
num_fns c -> c -> c
forall a. Num a => a -> a -> a
+ c
1
      , if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then d
num_hit_fns else d
num_hit_fns d -> d -> d
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) = ((Int, Int, Bool, Int)
 -> ([Builder], [Builder], Int, Int)
 -> ([Builder], [Builder], Int, Int))
-> [(Int, Int, Bool, Int)] -> (Builder, Int, Int)
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 (Int, Int, Bool, Int)
-> ([Builder], [Builder], Int, Int)
-> ([Builder], [Builder], Int, Int)
forall {c} {d} {a} {a}.
(Num c, Num d) =>
(Int, Int, Bool, Int)
-> (a, [Builder], c, d) -> ([a], [Builder], c, d)
fbr (CoverageEntry -> [(Int, Int, Bool, Int)]
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:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
sl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
comma Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Int -> Builder
intDec Int
blk Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
comma Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Char -> Builder
char7 (if Bool
bool then Char
'0' else Char
'1') Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
comma Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Int -> Builder
intDec Int
n Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
br
      , c
num_brs c -> c -> c
forall a. Num a => a -> a -> a
+ c
1
      , if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then d
num_hit_brs else d
num_hit_brs d -> d -> d
forall a. Num a => a -> a -> a
+ d
1 )

    (Builder
das_and_nl, Int
lf, Int
lh) = ((Int, Hit)
 -> ([Builder], [Builder], Int, Int)
 -> ([Builder], [Builder], Int, Int))
-> [(Int, Hit)] -> (Builder, Int, Int)
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 (Int, Hit)
-> ([Builder], [Builder], Int, Int)
-> ([Builder], [Builder], Int, Int)
forall {c} {d} {a} {a}.
(Num c, Num d) =>
(Int, Hit) -> (a, [Builder], c, d) -> ([a], [Builder], c, d)
fda (CoverageEntry -> [(Int, Hit)]
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
nBuilder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:[Builder]
da,   c
num_lines c -> c -> c
forall a. Num a => a -> a -> a
+ c
1, d
num_hits)
        Partial Int
i -> ([], Int -> Int -> Builder
dai Int
n Int
iBuilder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:[Builder]
da, c
num_lines c -> c -> c
forall a. Num a => a -> a -> a
+ c
1, d
num_hits d -> d -> d
forall a. Num a => a -> a -> a
+ d
1)
        Full Int
i    -> ([], Int -> Int -> Builder
dai Int
n Int
iBuilder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:[Builder]
da, c
num_lines c -> c -> c
forall a. Num a => a -> a -> a
+ c
1, d
num_hits d -> d -> d
forall a. Num a => a -> a -> a
+ d
1)
    da0 :: Int -> Builder
da0 Int
n = String -> Builder
string7 String
"DA:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
comma Builder -> Builder -> Builder
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:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
comma Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
i

    nl :: Builder
nl = Char -> Builder
char7 Char
'\n'


-- ------------------------------------------------------------------------
-- Cobertura
-- ------------------------------------------------------------------------

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 (c e -> Int
forall (c :: * -> *) e. HasRate c e => c e -> Int
numCovered c e
x) (c e -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
    String -> Builder
string7 String
"0.0"
  else
    Double -> Builder
formatStandardDouble (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
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 = (Acc -> e -> Acc) -> Acc -> [e] -> Acc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Acc -> e -> Acc
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 = acc_valid_lines acc + numValid (Lines e)
      , acc_covered_lines = acc_covered_lines acc + numCovered (Lines e)
      , acc_valid_branches = acc_valid_branches acc + numValid (Branches e)
      , acc_covered_branches = acc_covered_branches acc + numCovered (Branches 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 (CoberturaPackage -> Int)
-> (Lines CoberturaPackage -> CoberturaPackage)
-> Lines CoberturaPackage
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines CoberturaPackage -> CoberturaPackage
forall a. Lines a -> a
unLines
  {-# INLINE numValid #-}
  numCovered :: Lines CoberturaPackage -> Int
numCovered = CoberturaPackage -> Int
cp_lines_covered (CoberturaPackage -> Int)
-> (Lines CoberturaPackage -> CoberturaPackage)
-> Lines CoberturaPackage
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines CoberturaPackage -> CoberturaPackage
forall a. Lines a -> a
unLines
  {-# INLINE numCovered #-}

instance HasRate Branches CoberturaPackage where
  numValid :: Branches CoberturaPackage -> Int
numValid = CoberturaPackage -> Int
cp_branch_valid (CoberturaPackage -> Int)
-> (Branches CoberturaPackage -> CoberturaPackage)
-> Branches CoberturaPackage
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branches CoberturaPackage -> CoberturaPackage
forall a. Branches a -> a
unBranches
  {-# INLINE numValid #-}
  numCovered :: Branches CoberturaPackage -> Int
numCovered = CoberturaPackage -> Int
cp_branch_covered (CoberturaPackage -> Int)
-> (Branches CoberturaPackage -> CoberturaPackage)
-> Branches CoberturaPackage
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branches CoberturaPackage -> CoberturaPackage
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 (CoberturaClass -> Int)
-> (Lines CoberturaClass -> CoberturaClass)
-> Lines CoberturaClass
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines CoberturaClass -> CoberturaClass
forall a. Lines a -> a
unLines
  {-# INLINE numValid #-}
  numCovered :: Lines CoberturaClass -> Int
numCovered = CoberturaClass -> Int
cc_lines_covered (CoberturaClass -> Int)
-> (Lines CoberturaClass -> CoberturaClass)
-> Lines CoberturaClass
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines CoberturaClass -> CoberturaClass
forall a. Lines a -> a
unLines
  {-# INLINE numCovered #-}

instance HasRate Branches CoberturaClass where
  numValid :: Branches CoberturaClass -> Int
numValid = CoberturaClass -> Int
cc_branch_valid (CoberturaClass -> Int)
-> (Branches CoberturaClass -> CoberturaClass)
-> Branches CoberturaClass
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branches CoberturaClass -> CoberturaClass
forall a. Branches a -> a
unBranches
  {-# INLINE numValid #-}
  numCovered :: Branches CoberturaClass -> Int
numCovered = CoberturaClass -> Int
cc_branch_covered (CoberturaClass -> Int)
-> (Branches CoberturaClass -> CoberturaClass)
-> Branches CoberturaClass
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branches CoberturaClass -> CoberturaClass
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
  }

-- | Build simple Cobertura XML report from coverage entries.
buildCobertura :: [CoverageEntry] -> Builder
buildCobertura :: [CoverageEntry] -> Builder
buildCobertura [CoverageEntry]
es =
  String -> Builder
string7 String
"<?xml version=\"1.0\" ?>" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  String -> Builder
string7 String
"<!DOCTYPE coverage SYSTEM 'http://cobertura.sourceforge.nex/xml/coverage-0.4.dtd'>" Builder -> Builder -> Builder
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
'.')) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
   String -> Builder -> Builder
xmlTag String
"packages" ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((CoberturaPackage -> Builder) -> [CoberturaPackage] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map CoberturaPackage -> Builder
buildCoberturaPackage [CoberturaPackage]
pkgs))) Builder -> Builder -> Builder
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 (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ Integer -> Int
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 = [CoberturaPackage] -> Acc
forall e. (HasRate Lines e, HasRate Branches e) => [e] -> Acc
accLinesAndBranches [CoberturaPackage]
pkgs

-- XXX: Not sure whether this is the preferred timestamp format.
unsafeGetTimestamp :: Integer
unsafeGetTimestamp :: Integer
unsafeGetTimestamp = POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (IO POSIXTime -> POSIXTime
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"
   ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((CoberturaClass -> Builder) -> [CoberturaClass] -> [Builder]
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 (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ CoberturaPackage -> String
cp_name CoberturaPackage
cp)
      ,(String
"line-rate", Lines CoberturaPackage -> Builder
forall (c :: * -> *) e. HasRate c e => c e -> Builder
buildRateOf (CoberturaPackage -> Lines CoberturaPackage
forall a. a -> Lines a
Lines CoberturaPackage
cp))
      ,(String
"branch-rate", Branches CoberturaPackage -> Builder
forall (c :: * -> *) e. HasRate c e => c e -> Builder
buildRateOf (CoberturaPackage -> Branches CoberturaPackage
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" ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((CoberturaMethod -> Builder) -> [CoberturaMethod] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map CoberturaMethod -> Builder
method (CoberturaClass -> [CoberturaMethod]
cc_methods CoberturaClass
cc))) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
   String -> Builder -> Builder
xmlTag String
"lines" ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((CoberturaLine -> Builder) -> [CoberturaLine] -> [Builder]
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", Branches CoberturaClass -> Builder
forall (c :: * -> *) e. HasRate c e => c e -> Builder
buildRateOf (CoberturaClass -> Branches CoberturaClass
forall a. a -> Branches a
Branches CoberturaClass
cc))
      ,(String
"complexity", Char -> Builder
char7 Char
'0')
      ,(String
"filename", String -> Builder
stringUtf8 (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ CoberturaClass -> String
cc_filename CoberturaClass
cc)
      ,(String
"line-rate", Lines CoberturaClass -> Builder
forall (c :: * -> *) e. HasRate c e => c e -> Builder
buildRateOf (CoberturaClass -> Lines CoberturaClass
forall a. a -> Lines a
Lines CoberturaClass
cc))
      ,(String
"name", String -> Builder
stringUtf8 (String -> Builder) -> String -> Builder
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 (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ String -> String
xmlEscape (CoberturaMethod -> String
cm_name CoberturaMethod
cm))
          ,(String
"signature", Builder
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 (Map (Int, Bool) Int -> Bool
forall a. Map (Int, Bool) a -> Bool
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 (String -> Builder) -> String -> Builder
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)) ] [(String, Builder)] -> [(String, Builder)] -> [(String, Builder)]
forall a. Semigroup a => a -> a -> a
<>
          [(String
"condition-coverage", Map (Int, Bool) Int -> Builder
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" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (((String, Builder) -> Builder) -> [(String, Builder)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (String, Builder) -> Builder
xmlAttr [(String, Builder)]
attrs) Builder -> Builder -> Builder
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'(' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fraction Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
')'
    percentage :: Builder
percentage = Int -> Builder
intDec (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
rate)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'%'
    fraction :: Builder
fraction = Int -> Builder
intDec Int
covered Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'/' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
valid
    rate :: Double
rate = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
covered Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
valid :: Double
    (Int
covered, Int
valid) = ((Int, Int) -> Int -> (Int, Int))
-> (Int, Int) -> Map a Int -> (Int, Int)
forall b a. (b -> a -> b) -> b -> Map a a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Int) -> Int -> (Int, Int)
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
num_hits then a
c a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 else a
c, b
v b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)

toCoberturaPackages :: [CoverageEntry] -> [CoberturaPackage]
toCoberturaPackages :: [CoverageEntry] -> [CoberturaPackage]
toCoberturaPackages =
  (String
 -> [CoberturaClass] -> [CoberturaPackage] -> [CoberturaPackage])
-> [CoberturaPackage]
-> Map String [CoberturaClass]
-> [CoberturaPackage]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' String
-> [CoberturaClass] -> [CoberturaPackage] -> [CoberturaPackage]
go [] (Map String [CoberturaClass] -> [CoberturaPackage])
-> ([CoverageEntry] -> Map String [CoberturaClass])
-> [CoverageEntry]
-> [CoberturaPackage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CoberturaClass] -> [CoberturaClass] -> [CoberturaClass])
-> [(String, [CoberturaClass])] -> Map String [CoberturaClass]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [CoberturaClass] -> [CoberturaClass] -> [CoberturaClass]
forall a. Semigroup a => a -> a -> a
(<>) ([(String, [CoberturaClass])] -> Map String [CoberturaClass])
-> ([CoverageEntry] -> [(String, [CoberturaClass])])
-> [CoverageEntry]
-> Map String [CoberturaClass]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoverageEntry -> (String, [CoberturaClass]))
-> [CoverageEntry] -> [(String, [CoberturaClass])]
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 = [CoberturaClass] -> Acc
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
                           } CoberturaPackage -> [CoberturaPackage] -> [CoberturaPackage]
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 = IntMap CoberturaLine -> [CoberturaLine]
forall a. IntMap a -> [a]
IntMap.elems IntMap CoberturaLine
im1
  }
  where
    (Int
lv, Int
lc, IntMap CoberturaLine
im0) = ((Int, Int, IntMap CoberturaLine)
 -> (Int, Hit) -> (Int, Int, IntMap CoberturaLine))
-> (Int, Int, IntMap CoberturaLine)
-> [(Int, Hit)]
-> (Int, Int, IntMap CoberturaLine)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Int, IntMap CoberturaLine)
-> (Int, Hit) -> (Int, Int, IntMap CoberturaLine)
forall {a} {b}.
(Num a, Num b) =>
(a, b, IntMap CoberturaLine)
-> (Int, Hit) -> (a, b, IntMap CoberturaLine)
acc_line (Int
0, Int
0, IntMap CoberturaLine
forall a. Monoid a => a
mempty) (CoverageEntry -> [(Int, Hit)]
ce_hits CoverageEntry
ce)
    (Int
bv, Int
bc, IntMap CoberturaLine
im1) = ((Int, Int, IntMap CoberturaLine)
 -> (Int, Int, Bool, Int) -> (Int, Int, IntMap CoberturaLine))
-> (Int, Int, IntMap CoberturaLine)
-> [(Int, Int, Bool, Int)]
-> (Int, Int, IntMap CoberturaLine)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Int, IntMap CoberturaLine)
-> (Int, Int, Bool, Int) -> (Int, Int, IntMap CoberturaLine)
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 -> [(Int, Int, Bool, Int)]
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 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
lc0, Int
-> CoberturaLine -> IntMap CoberturaLine -> IntMap CoberturaLine
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 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
lc0 b -> b -> b
forall a. Num a => a -> a -> a
+ b
1, Int
-> CoberturaLine -> IntMap CoberturaLine -> IntMap CoberturaLine
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 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
lc0 b -> b -> b
forall a. Num a => a -> a -> a
+ b
1, Int
-> CoberturaLine -> IntMap CoberturaLine -> IntMap CoberturaLine
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 Map (Int, Bool) Int
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 ((Int, Bool) -> Int -> Map (Int, Bool) Int
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 = Int -> Int -> Int
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 =
        (Int -> Int -> Int)
-> Map (Int, Bool) Int
-> Map (Int, Bool) Int
-> Map (Int, Bool) Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
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' = (CoberturaLine -> CoberturaLine -> CoberturaLine)
-> Int
-> CoberturaLine
-> IntMap CoberturaLine
-> IntMap CoberturaLine
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 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, if Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then b
bc0 else b
bc0 b -> b -> b
forall a. Num a => a -> a -> a
+ b
1, IntMap CoberturaLine
im')
    methods :: [CoberturaMethod]
methods = ((Int, Int, Int, String) -> CoberturaMethod)
-> [(Int, Int, Int, String)] -> [CoberturaMethod]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int, Int, String) -> CoberturaMethod
forall {b} {c}. (Int, b, c, String) -> CoberturaMethod
to_method (CoverageEntry -> [(Int, Int, Int, String)]
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 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeDirectory

toModuleName :: FilePath -> String
toModuleName :: String -> String
toModuleName String
path = String -> [String] -> String
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
'<' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7 String
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
attrs' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'>' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Builder
body Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  String -> Builder
string7 String
"</" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7 String
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'>'
  where
    attrs' :: Builder
attrs' =
      if [(String, Builder)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Builder)]
attrs then Builder
forall a. Monoid a => a
mempty else [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (((String, Builder) -> Builder) -> [(String, Builder)] -> [Builder]
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
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7 String
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'=' Builder -> Builder -> Builder
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
"&gt;" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
go String
rest
      Char
'<' -> String
"&lt;" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
go String
rest
      Char
'"' -> String
"&quot;" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
go String
rest
      Char
'&' -> String
"&amp;" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
go String
rest
      Char
_   -> Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
go String
rest


-- ------------------------------------------------------------------------
-- Auxiliary
-- ------------------------------------------------------------------------

dquote :: Builder -> Builder
dquote :: Builder -> Builder
dquote Builder
x = Char -> Builder
char7 Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
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 #-}