{-# 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                         (foldl', intercalate,
                                                    intersperse)
import           System.IO.Unsafe                  (unsafePerformIO)

#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") 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)


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

-- | Build simple lcov tracefile from coverage entries.
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'


-- ------------------------------------------------------------------------
-- 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 (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
  }

-- | 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\" ?>" 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

-- XXX: Not sure whether this is the preferred timestamp format.
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
"&gt;" forall a. Semigroup a => a -> a -> a
<> String -> String
go String
rest
      Char
'<' -> String
"&lt;" forall a. Semigroup a => a -> a -> a
<> String -> String
go String
rest
      Char
'"' -> String
"&quot;" forall a. Semigroup a => a -> a -> a
<> String -> String
go String
rest
      Char
'&' -> String
"&amp;" forall a. Semigroup a => a -> a -> a
<> String -> String
go String
rest
      Char
_   -> Char
cforall a. a -> [a] -> [a]
:String -> String
go String
rest


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

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 #-}