Skip to content
Snippets Groups Projects
Commit ac28e842 authored by Georgy Lukyanov's avatar Georgy Lukyanov
Browse files

Use lucid for per-module header

parent 0f890ae8
No related tags found
No related merge requests found
Pipeline #96356 passed
Stage: test
Hide whitespace changes
Inline Side-by-side
src/Trace/Hpc/Markup.hs
+ 45
− 37
View file @ ac28e842
{-# Language OverloadedStrings #-}
-- | -- |
-- Module : Trace.Hpc.Markup -- Module : Trace.Hpc.Markup
-- Description : The subcommand @hpc markup@ -- Description : The subcommand @hpc markup@
...@@ -7,6 +8,7 @@ module Trace.Hpc.Markup (markupPlugin) where ...@@ -7,6 +8,7 @@ module Trace.Hpc.Markup (markupPlugin) where
import qualified Lucid as L import qualified Lucid as L
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Data.Text as T
import Control.Monad import Control.Monad
import Data.Array import Data.Array
import Data.List (find, sortBy) import Data.List (find, sortBy)
...@@ -174,46 +176,48 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do ...@@ -174,46 +176,48 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
let addLines = unlines . zipWith addLine [1 :: Int ..] . lines let addLines = unlines . zipWith addLine [1 :: Int ..] . lines
let fileName = modName0 <.> "hs" <.> "html" let fileName = modName0 <.> "hs" <.> "html"
let headerAndBody :: L.Html ()
headerAndBody =
L.html_ [] $ do
L.head_ [] $ do
L.meta_ [L.httpEquiv_ "Content-Type", L.content_ "text/html; charset=UTF-8"]
stylesheet
L.body_ [] $ do
L.pre_ [] $ do
L.span_ [L.class_ "decl"] $ do
L.span_ [L.class_ "nottickedoff"] "never executed" <> rawStr_ "&nbsp;"
L.span_ [L.class_ "tickonlytrue"] "always true" <> rawStr_ "&nbsp;"
L.span_ [L.class_ "tickonlyfalse"] "always false"
L.pre_ [] (L.toHtmlRaw (addLines content'))
stylesheet :: L.Html ()
stylesheet = L.style_ [L.type_ "text/css"] stylecontent
stylecontent :: T.Text
stylecontent = T.unlines
[ "span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }"
, if invertOutput
then "span.nottickedoff { color: #404040; background: white; font-style: oblique }"
else "span.nottickedoff { background: " <> yellow <> "}"
, if invertOutput
then "span.istickedoff { color: black; background: #d0c0ff; font-style: normal; }"
else "span.istickedoff { background: white }"
, "span.tickonlyfalse { margin: -1px; border: 1px solid " <> red <> "; background: " <> red <> " }"
, "span.tickonlytrue { margin: -1px; border: 1px solid " <> green <> "; background: " <> green <> " }"
, "span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }"
, if invertOutput
then "span.decl { font-weight: bold; background: #d0c0ff }"
else "span.decl { font-weight: bold }"
, "span.spaces { background: white }"
]
unless (verbosity flags < Normal) $ do unless (verbosity flags < Normal) $ do
putStrLn $ "Writing: " ++ fileName putStrLn $ "Writing: " ++ fileName
writeFileUtf8 (dest_dir </> fileName) $ writeFileUtf8 (dest_dir </> fileName) . TL.unpack . L.renderText $ headerAndBody
unlines
[ "<html>",
"<head>",
"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">",
"<style type=\"text/css\">",
"span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }",
if invertOutput
then "span.nottickedoff { color: #404040; background: white; font-style: oblique }"
else "span.nottickedoff { background: " ++ yellow ++ "}",
if invertOutput
then "span.istickedoff { color: black; background: #d0c0ff; font-style: normal; }"
else "span.istickedoff { background: white }",
"span.tickonlyfalse { margin: -1px; border: 1px solid " ++ red ++ "; background: " ++ red ++ " }",
"span.tickonlytrue { margin: -1px; border: 1px solid " ++ green ++ "; background: " ++ green ++ " }",
"span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }",
if invertOutput
then "span.decl { font-weight: bold; background: #d0c0ff }"
else "span.decl { font-weight: bold }",
"span.spaces { background: white }",
"</style>",
"</head>",
"<body>",
"<pre>",
concat
[ "<span class=\"decl\">",
"<span class=\"nottickedoff\">never executed</span> ",
"<span class=\"tickonlytrue\">always true</span> ",
"<span class=\"tickonlyfalse\">always false</span></span>"
],
"</pre>",
"<pre>"
]
++ addLines content'
++ "\n</pre>\n</body>\n</html>\n"
modSummary `seq` return (modName0, fileName, modSummary) modSummary `seq` return (modName0, fileName, modSummary)
data Loc = Loc !Int !Int data Loc = Loc !Int !Int
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
...@@ -297,7 +301,7 @@ addMarkup tabStop0 (c0 : cs) loc@(Loc _ p) os ticks ...@@ -297,7 +301,7 @@ addMarkup tabStop0 (c0 : cs) loc@(Loc _ p) os ticks
| otherwise = | otherwise =
escape c0 ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks escape c0 ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks
where where
(w, cs') = span (`elem` " \t") cs (w, cs') = span (`elem` (" \t" :: String)) cs
loc' = foldl (flip incBy) loc (c0 : w) loc' = foldl (flip incBy) loc (c0 : w)
escape '>' = "&gt;" escape '>' = "&gt;"
escape '<' = "&lt;" escape '<' = "&lt;"
...@@ -372,7 +376,11 @@ allowNesting _ _ = True ...@@ -372,7 +376,11 @@ allowNesting _ _ = True
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- global color palette -- global color palette
red, green, yellow :: String red, green, yellow :: T.Text
red = "#f20913" red = "#f20913"
green = "#60de51" green = "#60de51"
yellow = "yellow" yellow = "yellow"
-- | A string literal embedded as-is, without escaping
rawStr_ :: T.Text -> L.Html ()
rawStr_ = L.toHtmlRaw
test/Markup/gold/Recip/Main.hs.html
+ 3
− 17
View file @ ac28e842
<html> <html><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"><style type="text/css">span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<style type="text/css">
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
span.nottickedoff { background: yellow} span.nottickedoff { background: yellow}
span.istickedoff { background: white } span.istickedoff { background: white }
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 } span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
...@@ -10,14 +6,7 @@ span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de5 ...@@ -10,14 +6,7 @@ span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de5
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 } span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
span.decl { font-weight: bold } span.decl { font-weight: bold }
span.spaces { background: white } span.spaces { background: white }
</style> </style></head><body><pre><span class="decl"><span class="nottickedoff">never executed</span>&nbsp;<span class="tickonlytrue">always true</span>&nbsp;<span class="tickonlyfalse">always false</span></span></pre><pre><span class="lineno"> 1 </span>module Main where
</head>
<body>
<pre>
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
</pre>
<pre>
<span class="lineno"> 1 </span>module Main where
<span class="lineno"> 2 </span> <span class="lineno"> 2 </span>
<span class="lineno"> 3 </span>reciprocal :: Int -&gt; (String, Int) <span class="lineno"> 3 </span>reciprocal :: Int -&gt; (String, Int)
<span class="lineno"> 4 </span><span class="decl"><span class="istickedoff">reciprocal n | <span class="tickonlytrue">n &gt; 1</span> = ('0' : '.' : digits, recur)</span> <span class="lineno"> 4 </span><span class="decl"><span class="istickedoff">reciprocal n | <span class="tickonlytrue">n &gt; 1</span> = ('0' : '.' : digits, recur)</span>
...@@ -50,7 +39,4 @@ span.spaces { background: white } ...@@ -50,7 +39,4 @@ span.spaces { background: white }
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="istickedoff">putStrLn (showRecip number)</span> <span class="lineno"> 31 </span><span class="spaces"> </span><span class="istickedoff">putStrLn (showRecip number)</span>
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="istickedoff">main</span></span> <span class="lineno"> 32 </span><span class="spaces"> </span><span class="istickedoff">main</span></span>
<span class="lineno"> 33 </span> <span class="lineno"> 33 </span>
</pre></body></html>
</pre> \ No newline at end of file
</body>
</html>
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