[commit: ghc] master: Add configurable verbosity level to hpc (1b82619)
git at git.haskell.org
git at git.haskell.org
Wed Feb 18 15:48:05 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/1b82619bc2ff36341d916c56b0cd67a378a9c222/ghc
>---------------------------------------------------------------
commit 1b82619bc2ff36341d916c56b0cd67a378a9c222
Author: Yuras Shumovich <shumovichy at gmail.com>
Date: Tue Feb 17 08:39:54 2015 -0600
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
>---------------------------------------------------------------
1b82619bc2ff36341d916c56b0cd67a378a9c222
utils/hpc/HpcCombine.hs | 3 +++
utils/hpc/HpcDraft.hs | 1 +
utils/hpc/HpcFlags.hs | 21 ++++++++++++++++++++-
utils/hpc/HpcMarkup.hs | 7 +++++--
utils/hpc/HpcOverlay.hs | 1 +
utils/hpc/HpcReport.hs | 1 +
utils/hpc/HpcShowTix.hs | 1 +
7 files changed, 32 insertions(+), 3 deletions(-)
diff --git a/utils/hpc/HpcCombine.hs b/utils/hpc/HpcCombine.hs
index b57112f..db6ae9c 100644
--- a/utils/hpc/HpcCombine.hs
+++ b/utils/hpc/HpcCombine.hs
@@ -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"
diff --git a/utils/hpc/HpcDraft.hs b/utils/hpc/HpcDraft.hs
index b804d56..975dbf4 100644
--- a/utils/hpc/HpcDraft.hs
+++ b/utils/hpc/HpcDraft.hs
@@ -20,6 +20,7 @@ draft_options
. hpcDirOpt
. resetHpcDirsOpt
. outputOpt
+ . verbosityOpt
draft_plugin :: Plugin
draft_plugin = Plugin { name = "draft"
diff --git a/utils/hpc/HpcFlags.hs b/utils/hpc/HpcFlags.hs
index 3bb3163..0170309 100644
--- a/utils/hpc/HpcFlags.hs
+++ b/utils/hpc/HpcFlags.hs
@@ -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 }
diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs
index c294b6a..1373bfb 100644
--- a/utils/hpc/HpcMarkup.hs
+++ b/utils/hpc/HpcMarkup.hs
@@ -32,6 +32,7 @@ markup_options
. funTotalsOpt
. altHighlightOpt
. destDirOpt
+ . verbosityOpt
markup_plugin :: Plugin
markup_plugin = Plugin { name = "markup"
@@ -76,7 +77,8 @@ markup_main flags (prog:modNames) = do
let writeSummary filename cmp = do
let mods' = sortBy cmp mods
- putStrLn $ "Writing: " ++ (filename ++ ".html")
+ unless (verbosity flags < Normal) $
+ putStrLn $ "Writing: " ++ (filename ++ ".html")
writeFileUsing (dest_dir ++ "/" ++ filename ++ ".html") $
"<html>" ++
@@ -223,7 +225,8 @@ 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"
- putStrLn $ "Writing: " ++ fileName
+ unless (verbosity flags < Normal) $
+ putStrLn $ "Writing: " ++ fileName
writeFileUsing (dest_dir ++ "/" ++ fileName) $
unlines ["<html>",
"<head>",
diff --git a/utils/hpc/HpcOverlay.hs b/utils/hpc/HpcOverlay.hs
index 531018c..c4f8e96 100644
--- a/utils/hpc/HpcOverlay.hs
+++ b/utils/hpc/HpcOverlay.hs
@@ -15,6 +15,7 @@ overlay_options
. hpcDirOpt
. resetHpcDirsOpt
. outputOpt
+ . verbosityOpt
overlay_plugin :: Plugin
overlay_plugin = Plugin { name = "overlay"
diff --git a/utils/hpc/HpcReport.hs b/utils/hpc/HpcReport.hs
index a97d6b0..4c975be 100644
--- a/utils/hpc/HpcReport.hs
+++ b/utils/hpc/HpcReport.hs
@@ -274,5 +274,6 @@ report_options
. hpcDirOpt
. resetHpcDirsOpt
. xmlOutputOpt
+ . verbosityOpt
diff --git a/utils/hpc/HpcShowTix.hs b/utils/hpc/HpcShowTix.hs
index 13a2875..f0c628e 100644
--- a/utils/hpc/HpcShowTix.hs
+++ b/utils/hpc/HpcShowTix.hs
@@ -15,6 +15,7 @@ showtix_options
. hpcDirOpt
. resetHpcDirsOpt
. outputOpt
+ . verbosityOpt
showtix_plugin :: Plugin
showtix_plugin = Plugin { name = "show"
More information about the ghc-commits
mailing list