Commit c8448123 authored by basvandijk's avatar basvandijk Committed by Simon Marlow
Browse files

Write locale character encoding to hpc html report (#5006)

This allows the correct interpretation of Unicode characters by the browser.
parent cc456b0b
...@@ -13,6 +13,7 @@ import HpcFlags ...@@ -13,6 +13,7 @@ import HpcFlags
import HpcUtils import HpcUtils
import System.Directory import System.Directory
import System.IO (localeEncoding)
import Data.List import Data.List
import Data.Maybe(fromJust) import Data.Maybe(fromJust)
import Data.Array import Data.Array
...@@ -79,6 +80,8 @@ markup_main flags (prog:modNames) = do ...@@ -79,6 +80,8 @@ markup_main flags (prog:modNames) = do
writeFileUsing (dest_dir ++ "/" ++ filename ++ ".html") $ writeFileUsing (dest_dir ++ "/" ++ filename ++ ".html") $
"<html>" ++ "<html>" ++
"<head>" ++
charEncodingTag ++
"<style type=\"text/css\">" ++ "<style type=\"text/css\">" ++
"table.bar { background-color: #f25913; }\n" ++ "table.bar { background-color: #f25913; }\n" ++
"td.bar { background-color: #60de51; }\n" ++ "td.bar { background-color: #60de51; }\n" ++
...@@ -87,6 +90,8 @@ markup_main flags (prog:modNames) = do ...@@ -87,6 +90,8 @@ markup_main flags (prog:modNames) = do
".dashboard td { border: solid 1px black }\n" ++ ".dashboard td { border: solid 1px black }\n" ++
".dashboard th { border: solid 1px black }\n" ++ ".dashboard th { border: solid 1px black }\n" ++
"</style>\n" ++ "</style>\n" ++
"</head>" ++
"<body>" ++
"<table class=\"dashboard\" width=\"100%\" border=1>\n" ++ "<table class=\"dashboard\" width=\"100%\" border=1>\n" ++
"<tr>" ++ "<tr>" ++
"<th rowspan=2><a href=\"" ++ index_name ++ ".html\">module</a></th>" ++ "<th rowspan=2><a href=\"" ++ index_name ++ ".html\">module</a></th>" ++
...@@ -110,7 +115,7 @@ markup_main flags (prog:modNames) = do ...@@ -110,7 +115,7 @@ markup_main flags (prog:modNames) = do
[ modSummary [ modSummary
| (_,_,modSummary) <- mods' | (_,_,modSummary) <- mods'
]) ])
++ "</table></html>\n" ++ "</table></body></html>\n"
writeSummary index_name $ \ (n1,_,_) (n2,_,_) -> compare n1 n2 writeSummary index_name $ \ (n1,_,_) (n2,_,_) -> compare n1 n2
...@@ -130,6 +135,11 @@ markup_main flags (prog:modNames) = do ...@@ -130,6 +135,11 @@ markup_main flags (prog:modNames) = do
markup_main _ [] markup_main _ []
= hpcError markup_plugin $ "no .tix file or executable name specified" = hpcError markup_plugin $ "no .tix file or executable name specified"
charEncodingTag :: String
charEncodingTag =
"<meta http-equiv=\"Content-Type\" " ++
"content=\"text/html; " ++ "charset=" ++ show localeEncoding ++ "\">"
genHtmlFromMod genHtmlFromMod
:: String :: String
-> Flags -> Flags
...@@ -206,7 +216,10 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do ...@@ -206,7 +216,10 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
let fileName = modName0 ++ ".hs.html" let fileName = modName0 ++ ".hs.html"
putStrLn $ "Writing: " ++ fileName putStrLn $ "Writing: " ++ fileName
writeFileUsing (dest_dir ++ "/" ++ fileName) $ writeFileUsing (dest_dir ++ "/" ++ fileName) $
unlines [ "<html><style type=\"text/css\">", unlines ["<html>",
"<head>",
charEncodingTag,
"<style type=\"text/css\">",
"span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }", "span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }",
if invertOutput if invertOutput
then "span.nottickedoff { color: #404040; background: white; font-style: oblique }" then "span.nottickedoff { color: #404040; background: white; font-style: oblique }"
...@@ -222,7 +235,10 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do ...@@ -222,7 +235,10 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
else "span.decl { font-weight: bold }", else "span.decl { font-weight: bold }",
"span.spaces { background: white }", "span.spaces { background: white }",
"</style>", "</style>",
"<pre>"] ++ addLines content' ++ "\n</pre>\n</html>\n"; "</head>",
"<body>",
"<pre>"] ++ addLines content' ++ "\n</pre>\n</body>\n</html>\n";
modSummary `seq` return (modName0,fileName,modSummary) modSummary `seq` return (modName0,fileName,modSummary)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment