Commit 1b82619b authored by Yuras's avatar Yuras Committed by Austin Seipp
Browse files

Add configurable verbosity level to hpc

Summary:
All commands now have `--verbosity` flag, so one can configure
cabal package with `--hpc-options="--verbosity=0"`.

Right now it is used only in `hpc markup` to supress unnecessary
output.

Reviewers: austin

Reviewed By: austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D660

GHC Trac Issues: #10091
parent 08102b3d
......@@ -21,6 +21,7 @@ sum_options
. includeOpt
. outputOpt
. unionModuleOpt
. verbosityOpt
sum_plugin :: Plugin
sum_plugin = Plugin { name = "sum"
......@@ -40,6 +41,7 @@ combine_options
. combineFunOpt
. combineFunOptInfo
. unionModuleOpt
. verbosityOpt
combine_plugin :: Plugin
combine_plugin = Plugin { name = "combine"
......@@ -59,6 +61,7 @@ map_options
. mapFunOpt
. mapFunOptInfo
. unionModuleOpt
. verbosityOpt
map_plugin :: Plugin
map_plugin = Plugin { name = "map"
......
......@@ -20,6 +20,7 @@ draft_options
. hpcDirOpt
. resetHpcDirsOpt
. outputOpt
. verbosityOpt
draft_plugin :: Plugin
draft_plugin = Plugin { name = "draft"
......
......@@ -27,6 +27,8 @@ data Flags = Flags
, combineFun :: CombineFun -- tick-wise combine
, postFun :: PostFun --
, mergeModule :: MergeFun -- module-wise merge
, verbosity :: Verbosity
}
default_flags :: Flags
......@@ -48,9 +50,21 @@ default_flags = Flags
, combineFun = ADD
, postFun = ID
, mergeModule = INTERSECTION
, verbosity = Normal
}
data Verbosity = Silent | Normal | Verbose
deriving (Eq, Ord)
verbosityFromString :: String -> Verbosity
verbosityFromString "0" = Silent
verbosityFromString "1" = Normal
verbosityFromString "2" = Verbose
verbosityFromString v = error $ "unknown verbosity: " ++ v
-- We do this after reading flags, because the defaults
-- depends on if specific flags we used.
......@@ -73,7 +87,7 @@ infoArg :: String -> FlagOptSeq
infoArg info = (:) $ Option [] [] (NoArg $ id) info
excludeOpt, includeOpt, hpcDirOpt, resetHpcDirsOpt, srcDirOpt,
destDirOpt, outputOpt,
destDirOpt, outputOpt, verbosityOpt,
perModuleOpt, decListOpt, xmlOutputOpt, funTotalsOpt,
altHighlightOpt, combineFunOpt, combineFunOptInfo, mapFunOpt,
mapFunOptInfo, unionModuleOpt :: FlagOptSeq
......@@ -100,6 +114,11 @@ destDirOpt = anArg "destdir" "path to write output to" "DIR"
outputOpt = anArg "output" "output FILE" "FILE" $ \ a f -> f { outputFile = a }
verbosityOpt = anArg "verbosity" "verbosity level, 0-2" "[0-2]"
(\ a f -> f { verbosity = verbosityFromString a })
. infoArg "default 1"
-- markup
perModuleOpt = noArg "per-module" "show module level detail" $ \ f -> f { perModule = True }
......
......@@ -32,6 +32,7 @@ markup_options
. funTotalsOpt
. altHighlightOpt
. destDirOpt
. verbosityOpt
markup_plugin :: Plugin
markup_plugin = Plugin { name = "markup"
......@@ -76,6 +77,7 @@ markup_main flags (prog:modNames) = do
let writeSummary filename cmp = do
let mods' = sortBy cmp mods
unless (verbosity flags < Normal) $
putStrLn $ "Writing: " ++ (filename ++ ".html")
writeFileUsing (dest_dir ++ "/" ++ filename ++ ".html") $
......@@ -223,6 +225,7 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
let addLine n xs = "<span class=\"lineno\">" ++ padLeft 5 ' ' (show n) ++ " </span>" ++ xs
let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines
let fileName = modName0 ++ ".hs.html"
unless (verbosity flags < Normal) $
putStrLn $ "Writing: " ++ fileName
writeFileUsing (dest_dir ++ "/" ++ fileName) $
unlines ["<html>",
......
......@@ -15,6 +15,7 @@ overlay_options
. hpcDirOpt
. resetHpcDirsOpt
. outputOpt
. verbosityOpt
overlay_plugin :: Plugin
overlay_plugin = Plugin { name = "overlay"
......
......@@ -274,5 +274,6 @@ report_options
. hpcDirOpt
. resetHpcDirsOpt
. xmlOutputOpt
. verbosityOpt
......@@ -15,6 +15,7 @@ showtix_options
. hpcDirOpt
. resetHpcDirsOpt
. outputOpt
. verbosityOpt
showtix_plugin :: Plugin
showtix_plugin = Plugin { name = "show"
......
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