X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fhpc%2FHpcMarkup.hs;fp=utils%2Fhpc%2FHpcMarkup.hs;h=f78a4af220cc1d4afdb601117e4e68e9bea8571d;hb=eb546347e5eace34612005c151121fcd1f32b257;hp=a40c297d4f7185bd126f9ded8cd5af51765300ed;hpb=d727d6d7216529c140c1ec69acb54a0a446065ca;p=ghc-hetmet.git diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index a40c297..f78a4af 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -12,7 +12,6 @@ import Trace.Hpc.Util import HpcFlags import HpcUtils -import System.Environment import System.Directory import Data.List import Data.Maybe(fromJust) @@ -22,6 +21,7 @@ import qualified HpcSet as Set ------------------------------------------------------------------------------ +markup_options :: FlagOptSeq markup_options = excludeOpt . includeOpt @@ -30,7 +30,8 @@ markup_options . funTotalsOpt . altHighlightOpt . destDirOpt - + +markup_plugin :: Plugin markup_plugin = Plugin { name = "markup" , usage = "[OPTION] .. [ [ ..]]" , options = markup_options @@ -75,14 +76,14 @@ markup_main flags (prog:modNames) = do index_alt = "hpc_index_alt" index_exp = "hpc_index_exp" - let writeSummary name cmp = do + let writeSummary filename cmp = do let mods' = sortBy cmp mods - putStrLn $ "Writing: " ++ (name ++ ".html") - writeFile (dest_dir ++ "/" ++ name ++ ".html") $ + putStrLn $ "Writing: " ++ (filename ++ ".html") + writeFile (dest_dir ++ "/" ++ filename ++ ".html") $ "" ++ "", "
"] ++ addLines content' ++ "\n
\n\n"; - summary `seq` return (modName0,fileName,summary) + modSummary `seq` return (modName0,fileName,modSummary) data Loc = Loc !Int !Int deriving (Eq,Ord,Show) @@ -288,8 +290,8 @@ addMarkup tabStop cs loc os ((t1,t2,tik0):ticks) | loc == t1 = where addTo (t,tik) [] = [(t,tik)] - addTo (t,tik) ((t',tik'):xs) | t <= t' = (t,tik):(t',tik'):xs - | t > t' = (t',tik):(t',tik'):xs + addTo (t,tik) ((t',tik'):xs) | t <= t' = (t,tik):(t',tik'):xs + | otherwise = (t',tik):(t',tik'):xs addMarkup tabStop0 cs loc os ((t1,_t2,_tik):ticks) | loc > t1 = -- throw away this tick, because it is from a previous place ?? @@ -392,22 +394,22 @@ data ModuleSummary = ModuleSummary showModuleSummary :: (String, String, ModuleSummary) -> String -showModuleSummary (modName,fileName,summary) = +showModuleSummary (modName,fileName,modSummary) = "\n" ++ "  module " ++ modName ++ "\n" ++ - showSummary (topFunTicked summary) (topFunTotal summary) ++ - showSummary (altTicked summary) (altTotal summary) ++ - showSummary (expTicked summary) (expTotal summary) ++ + showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++ + showSummary (altTicked modSummary) (altTotal modSummary) ++ + showSummary (expTicked modSummary) (expTotal modSummary) ++ "\n" showTotalSummary :: ModuleSummary -> String -showTotalSummary summary = +showTotalSummary modSummary = "\n" ++ "  Program Coverage Total\n" ++ - showSummary (topFunTicked summary) (topFunTotal summary) ++ - showSummary (altTicked summary) (altTotal summary) ++ - showSummary (expTicked summary) (expTotal summary) ++ + showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++ + showSummary (altTicked modSummary) (altTotal modSummary) ++ + showSummary (expTicked modSummary) (expTotal modSummary) ++ "\n" showSummary :: (Integral t) => t -> t -> String @@ -422,7 +424,7 @@ showSummary ticked total = where showP Nothing = "- " showP (Just x) = show x ++ "%" - bar 0 inner = bar 100 "invbar" + bar 0 _ = bar 100 "invbar" bar w inner = "" ++ "
" ++ "" ++