Use `lucid2` for HTML reports

5061f562 · Georgy Lukyanov · BinderDavid · 981c700b · 5061f562 · 5061f562
Commit 5061f562 authored 1 year ago by Georgy Lukyanov Committed by BinderDavid 1 year ago
--- a/hpc-bin.cabal
+++ b/hpc-bin.cabal
@@ -60,7 +60,9 @@ executable hpc
                   filepath   >= 1   && < 1.6,
                   containers >= 0.1 && < 0.8,
                   array      >= 0.1 && < 0.6,
-                   hpc        >= 0.6.2 && < 0.8
+                   hpc        >= 0.6.2 && < 0.8,
+                   lucid2     ^>= 0.0.20240424,
+                   text       ^>= 2.0

    if flag(build-tool-depends)
      build-tool-depends: happy:happy >= 1.20.0

--- a/src/Trace/Hpc/Markup.hs
+++ b/src/Trace/Hpc/Markup.hs
@@ -5,6 +5,8 @@
 -- License            : BSD-3-Clause
 module Trace.Hpc.Markup (markupPlugin) where

+import qualified Lucid as L
+import qualified Data.Text.Lazy as T
 import Control.Monad
 import Data.Array
 import Data.List (find, sortBy)
@@ -65,22 +67,22 @@ markupMain flags (prog : modNames) = do
  -- Write "hpc_index.html"
  let (fp_name_index, html_name_index) = name_summary mods
  unless (verbosity flags < Normal) (putStrLn ("Writing: " <> fp_name_index))
-  writeFileUtf8 (dest_dir </> fp_name_index) html_name_index
+  writeFileUtf8 (dest_dir </> fp_name_index) (T.unpack . L.renderText $ html_name_index)

  -- Write "hpc_index_fun.html"
  let (fp_fun_index, html_fun_index) = fun_summary mods
  unless (verbosity flags < Normal) (putStrLn ("Writing: " <> fp_fun_index))
-  writeFileUtf8 (dest_dir </> fp_fun_index) html_fun_index
+  writeFileUtf8 (dest_dir </> fp_fun_index) (T.unpack . L.renderText $ html_fun_index)

  -- Write "hpc_index_alt.html"
  let (fp_alt_index, html_alt_index) = alt_summary mods
  unless (verbosity flags < Normal) (putStrLn ("Writing: " <> fp_alt_index))
-  writeFileUtf8 (dest_dir </> fp_alt_index) html_alt_index
+  writeFileUtf8 (dest_dir </> fp_alt_index) (T.unpack . L.renderText $ html_alt_index)

  -- Write "hpc_index_exp.html"
  let (fp_exp_index, html_exp_index) = exp_summary mods
  unless (verbosity flags < Normal) (putStrLn ("Writing: " <> fp_exp_index))
-  writeFileUtf8 (dest_dir </> fp_exp_index) html_exp_index
+  writeFileUtf8 (dest_dir </> fp_exp_index) (T.unpack . L.renderText $ html_exp_index)
 markupMain _ [] =
  hpcError markupPlugin "no .tix file or executable name specified"


--- a/src/Trace/Hpc/Markup/Summary.hs
+++ b/src/Trace/Hpc/Markup/Summary.hs
+{-# Language OverloadedStrings #-}
 -- |
 -- Module             : Trace.Hpc.Markup.Summary
 -- Description        : Generating the summary html files.
@@ -10,6 +11,7 @@ module Trace.Hpc.Markup.Summary
  )
 where

+import qualified Lucid as L
 import Data.List (sortBy)
 import Data.Semigroup as Semi
 import System.FilePath ((<.>))
@@ -71,7 +73,7 @@ showSummary ticked total =
    <> "<td width=100>"
    <> ( case percent ticked total of
           Nothing -> "&nbsp;"
-           Just w -> bar w "bar"
+           Just w -> bar w ("bar" :: String)
       )
    <> "</td>"
  where
@@ -107,8 +109,9 @@ instance Monoid ModuleSummary where
      }
  mappend = (<>)

-summaryHtml :: [(String, String, ModuleSummary)] -> String
-summaryHtml mods = "<html>" <> header <> body <> "</html>\n"
+summaryHtml :: [(String, String, ModuleSummary)] -> L.Html ()
+summaryHtml mods =
+  L.html_ ((L.toHtmlRaw header) <> (L.toHtmlRaw body))
  where
    header :: String
    header =
@@ -164,13 +167,13 @@ summaryHtml mods = "<html>" <> header <> body <> "</html>\n"
        <> "</table></body>"

 -- | Compute "hpc_index.html"
-name_summary :: [(String, String, ModuleSummary)] -> (FilePath, String)
+name_summary :: [(String, String, ModuleSummary)] -> (FilePath, L.Html ())
 name_summary mods = (index_name <.> "html", summaryHtml (sortBy cmp mods))
  where
    cmp (n1, _, _) (n2, _, _) = compare n1 n2

 -- | Compute "hpc_index_fun.html"
-fun_summary :: [(String, String, ModuleSummary)] -> (FilePath, String)
+fun_summary :: [(String, String, ModuleSummary)] -> (FilePath, L.Html ())
 fun_summary mods = (index_fun <.> "html", summaryHtml (sortBy cmp mods))
  where
    cmp (_, _, s1) (_, _, s2) = compare
@@ -178,7 +181,7 @@ fun_summary mods = (index_fun <.> "html", summaryHtml (sortBy cmp mods))
      (percent (topFunTicked s1) (topFunTotal s1))

 -- | Compute "hpc_index_alt.html"
-alt_summary :: [(String, String, ModuleSummary)] -> (FilePath, String)
+alt_summary :: [(String, String, ModuleSummary)] -> (FilePath, L.Html ())
 alt_summary mods = (index_alt <.> "html", summaryHtml (sortBy cmp mods))
  where
    cmp (_, _, s1) (_, _, s2) = compare
@@ -186,7 +189,7 @@ alt_summary mods = (index_alt <.> "html", summaryHtml (sortBy cmp mods))
      (percent (altTicked s1) (altTotal s1))

 -- | Compute "hpc_index_exp.html"
-exp_summary :: [(String, String, ModuleSummary)] -> (FilePath, String)
+exp_summary :: [(String, String, ModuleSummary)] -> (FilePath, L.Html ())
 exp_summary mods = (index_exp <.> "html", summaryHtml (sortBy cmp mods))
  where
    cmp (_, _, s1) (_, _, s2) = compare

--- a/test/Markup/gold/hpc_index.html
+++ b/test/Markup/gold/hpc_index.html
@@ -12,4 +12,4 @@ table.dashboard { border-collapse: collapse  ; border: solid 1px black }
 <tr></tr><tr style="background: #e0e0e0">
 <th align=left>&nbsp;&nbsp;Program Coverage Total</tt></th>
 <td align="right">100%</td><td>5/5</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="100%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">88%</td><td>8/9</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="88%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">96%</td><td>94/97</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="96%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
-</table></body></html>
+</table></body></html>
\ No newline at end of file