From 4799dfb37be922c17451f8e0f7c8d765a7a7eaab Mon Sep 17 00:00:00 2001 From: "andy@galois.com" Date: Fri, 20 Jul 2007 23:57:03 +0000 Subject: [PATCH] hpc-tools: improving flag processing and help messages, small bug fixes. --- utils/hpc/Hpc.hs | 20 +++++---- utils/hpc/HpcCombine.hs | 10 ++++- utils/hpc/HpcDraft.hs | 19 +++++---- utils/hpc/HpcFlags.hs | 87 ++++++++++++++++++++++---------------- utils/hpc/HpcLexer.hs | 45 ++++++++++++++++++++ utils/hpc/HpcMarkup.hs | 37 +++++++++-------- utils/hpc/HpcOverlay.hs | 28 +++++++++++++ utils/hpc/HpcParser.y | 106 +++++++++++++++++++++++++++++++++++++++++++++++ utils/hpc/HpcReport.hs | 20 ++++++--- utils/hpc/HpcShowTix.hs | 25 ++++++----- 10 files changed, 311 insertions(+), 86 deletions(-) create mode 100644 utils/hpc/HpcLexer.hs create mode 100644 utils/hpc/HpcOverlay.hs create mode 100644 utils/hpc/HpcParser.y diff --git a/utils/hpc/Hpc.hs b/utils/hpc/Hpc.hs index 08a4285..e22556e 100644 --- a/utils/hpc/Hpc.hs +++ b/utils/hpc/Hpc.hs @@ -1,6 +1,7 @@ -- (c) 2007 Andy Gill -- Main driver for Hpc +import Trace.Hpc.Tix import HpcFlags import System.Environment import System.Exit @@ -11,6 +12,7 @@ import HpcMarkup import HpcCombine import HpcShowTix import HpcDraft +import HpcOverlay helpList :: IO () helpList = @@ -48,11 +50,11 @@ dispatch [] = do exitWith ExitSuccess dispatch (txt:args) = do case lookup txt hooks' of - Just plugin -> parse plugin - _ -> parse help_plugin + Just plugin -> parse plugin args + _ -> parse help_plugin (txt:args) where - parse plugin = - case getOpt Permute (options plugin) args of + parse plugin args = + case getOpt Permute (options plugin []) args of (_,_,errs) | not (null errs) -> do putStrLn "hpc failed:" sequence [ putStr (" " ++ err) @@ -62,7 +64,8 @@ dispatch (txt:args) = do command_usage plugin exitFailure (o,ns,_) -> do - let flags = foldr (.) (final_flags plugin) o + let flags = final_flags plugin + $ foldr (.) id o $ init_flags plugin implementation plugin flags ns main = do @@ -76,6 +79,7 @@ hooks = [ help_plugin , markup_plugin , combine_plugin , showtix_plugin + , overlay_plugin , draft_plugin , version_plugin ] @@ -105,14 +109,14 @@ help_main flags (sub_txt:_) = do command_usage plugin' exitWith ExitSuccess -help_options = [] +help_options = id ------------------------------------------------------------------------------ version_plugin = Plugin { name = "version" , usage = "" , summary = "Display version for hpc" - , options = [] + , options = id , implementation = version_main , init_flags = default_flags , final_flags = default_final_flags @@ -121,4 +125,4 @@ version_plugin = Plugin { name = "version" version_main _ _ = putStrLn $ "hpc tools, version 0.5-dev" ------------------------------------------------------------------------------- +------------------------------------------------------------------------------ \ No newline at end of file diff --git a/utils/hpc/HpcCombine.hs b/utils/hpc/HpcCombine.hs index 9788c41..ea23ab9 100644 --- a/utils/hpc/HpcCombine.hs +++ b/utils/hpc/HpcCombine.hs @@ -13,10 +13,16 @@ import HpcFlags import Control.Monad import qualified HpcSet as Set import qualified HpcMap as Map +import System.Environment ------------------------------------------------------------------------------ -combine_options = - [ excludeOpt,includeOpt,outputOpt,combineFunOpt, combineFunOptInfo, postInvertOpt ] +combine_options + = excludeOpt + . includeOpt + . outputOpt + . combineFunOpt + . combineFunOptInfo + . postInvertOpt combine_plugin = Plugin { name = "combine" , usage = "[OPTION] .. [ [ ..]]" diff --git a/utils/hpc/HpcDraft.hs b/utils/hpc/HpcDraft.hs index 4391bd0..36256fc 100644 --- a/utils/hpc/HpcDraft.hs +++ b/utils/hpc/HpcDraft.hs @@ -9,12 +9,17 @@ import HpcFlags import Control.Monad import qualified HpcSet as Set import qualified HpcMap as Map +import System.Environment import HpcUtils import Data.Tree ------------------------------------------------------------------------------ -draft_options = - [ excludeOpt,includeOpt,hpcDirOpt,hsDirOpt,outputOpt ] +draft_options + = excludeOpt + . includeOpt + . srcDirOpt + . hpcDirOpt + . outputOpt draft_plugin = Plugin { name = "draft" , usage = "[OPTION] .. " @@ -54,7 +59,7 @@ makeDraft hpcflags tix = do hash = tixModuleHash tix tixs = tixModuleTixs tix - mix@(Mix filepath timestamp hash tabstop entries) <- readMix (hpcDirs hpcflags) mod + mix@(Mix filepath timestamp hash tabstop entries) <- readMixWithFlags hpcflags mod let forest = createMixEntryDom [ (span,(box,v > 0)) @@ -66,7 +71,7 @@ makeDraft hpcflags tix = do let non_ticked = findNotTickedFromList forest - hs <- readFileFromPath filepath (hsDirs hpcflags) + hs <- readFileFromPath filepath (srcDirs hpcflags) let hsMap :: Map.Map Int String hsMap = Map.fromList (zip [1..] $ lines hs) @@ -79,10 +84,10 @@ makeDraft hpcflags tix = do let showPleaseTick :: Int -> PleaseTick -> String showPleaseTick d (TickFun str pos) = - spaces d ++ "tick function \"" ++ head str ++ "\" " + spaces d ++ "tick function \"" ++ last str ++ "\" " ++ "on line " ++ show (firstLine pos) ++ ";" showPleaseTick d (TickExp pos) = - spaces d ++ "tick expression " + spaces d ++ "tick " ++ if '\n' `elem` txt then "at position " ++ show pos ++ ";" else quoteString txt ++ " " ++ "on line " ++ show (firstLine pos) ++ ";" @@ -91,7 +96,7 @@ makeDraft hpcflags tix = do txt = grabHpcPos hsMap pos showPleaseTick d (TickInside [str] pos pleases) = - spaces d ++ "function \"" ++ str ++ "\" {\n" ++ + spaces d ++ "inside \"" ++ str ++ "\" {\n" ++ showPleaseTicks (d + 2) pleases ++ spaces d ++ "}" diff --git a/utils/hpc/HpcFlags.hs b/utils/hpc/HpcFlags.hs index 49ebb50..68bd861 100644 --- a/utils/hpc/HpcFlags.hs +++ b/utils/hpc/HpcFlags.hs @@ -3,17 +3,19 @@ module HpcFlags where import System.Console.GetOpt +import Data.Maybe ( fromMaybe ) import qualified HpcSet as Set import Data.Char import Trace.Hpc.Tix +import Trace.Hpc.Mix import System.Exit data Flags = Flags { outputFile :: String , includeMods :: Set.Set String , excludeMods :: Set.Set String - , hsDirs :: [String] - , hpcDirs :: [String] + , hpcDir :: String + , srcDirs :: [String] , destDir :: String , perModule :: Bool @@ -31,8 +33,8 @@ default_flags = Flags { outputFile = "-" , includeMods = Set.empty , excludeMods = Set.empty - , hpcDirs = [] - , hsDirs = [] + , hpcDir = ".hpc" + , srcDirs = [] , destDir = "." , perModule = False @@ -50,37 +52,45 @@ default_flags = Flags -- depends on if specific flags we used. default_final_flags flags = flags - { hpcDirs = if null (hpcDirs flags) - then [".hpc"] - else hpcDirs flags - , hsDirs = if null (hsDirs flags) + { srcDirs = if null (srcDirs flags) then ["."] - else hsDirs flags + else srcDirs flags } -noArg :: String -> String -> (Flags -> Flags) -> OptDescr (Flags -> Flags) -noArg flag detail fn = Option [] [flag] (NoArg $ fn) detail +type FlagOptSeq = [OptDescr (Flags -> Flags)] -> [OptDescr (Flags -> Flags)] -anArg :: String -> String -> String -> (String -> Flags -> Flags) -> OptDescr (Flags -> Flags) -anArg flag detail argtype fn = Option [] [flag] (ReqArg fn argtype) detail +noArg :: String -> String -> (Flags -> Flags) -> FlagOptSeq +noArg flag detail fn = (:) $ Option [] [flag] (NoArg $ fn) detail -infoArg :: String -> OptDescr (Flags -> Flags) -infoArg info = Option [] [] (NoArg $ id) info +anArg :: String -> String -> String -> (String -> Flags -> Flags) -> FlagOptSeq +anArg flag detail argtype fn = (:) $ Option [] [flag] (ReqArg fn argtype) detail -excludeOpt = anArg "exclude" "exclude MODULE and/or PACKAGE" "[PACKAGE:][MODULE]" $ \ a f -> f { excludeMods = a `Set.insert` excludeMods f } +infoArg :: String -> FlagOptSeq +infoArg info = (:) $ Option [] [] (NoArg $ id) info -includeOpt = anArg "include" "include MODULE and/or PACKAGE" "[PACKAGE:][MODULE]" $ \ a f -> f { includeMods = a `Set.insert` includeMods f } -hpcDirOpt = anArg "hpcdir" "path to .mix files (default .hpc)" "DIR" - $ \ a f -> f { hpcDirs = hpcDirs f ++ [a] } -hsDirOpt = anArg "hsdir" "path to .hs files (default .)" "DIR" - $ \ a f -> f { hsDirs = hsDirs f ++ [a] } -destDirOpt = anArg "destdir" "path to write output to" "DIR" - $ \ a f -> f { destDir = a } +excludeOpt = anArg "exclude" "exclude MODULE and/or PACKAGE" "[PACKAGE:][MODULE]" + $ \ a f -> f { excludeMods = a `Set.insert` excludeMods f } + +includeOpt = anArg "include" "include MODULE and/or PACKAGE" "[PACKAGE:][MODULE]" + $ \ a f -> f { includeMods = a `Set.insert` includeMods f } + +hpcDirOpt = anArg "hpcdir" "sub-directory that contains .mix files" "DIR" + (\ a f -> f { hpcDir = a }) + . infoArg "default .hpc [rarely used]" + +srcDirOpt = anArg "srcdir" "path to source directory of .hs files" "DIR" + (\ a f -> f { srcDirs = srcDirs f ++ [a] }) + . infoArg "multi-use of srcdir possible" + +destDirOpt = anArg "destdir" "path to write output to" "DIR" + $ \ a f -> f { destDir = a } + + outputOpt = anArg "output" "output FILE" "FILE" $ \ a f -> f { outputFile = a } -- markup perModuleOpt = noArg "per-module" "show module level detail" $ \ f -> f { perModule = True } -decListOpt = noArg "dec-list" "show unused decls" $ \ f -> f { decList = True } +decListOpt = noArg "decl-list" "show unused decls" $ \ f -> f { decList = True } xmlOutputOpt = noArg "xml-output" "show output in XML" $ \ f -> f { xmlOutput = True } funTotalsOpt = noArg "fun-entry-count" "show top-level function entry counts" $ \ f -> f { funTotals = True } @@ -100,13 +110,19 @@ postInvertOpt = noArg "post-invert" "invert output; ticked becomes unticked, unt $ \ f -> f { funTotals = True } ------------------------------------------------------------------------------- +readMixWithFlags flags mod = readMix [ dir ++ "/" ++ hpcDir flags + | dir <- srcDirs flags + ] mod + +------------------------------------------------------------------------------- + command_usage plugin = putStrLn $ "Usage: hpc " ++ (name plugin) ++ " " ++ (usage plugin) ++ - if null (options plugin) + if null (options plugin []) then "" - else usageInfo "\n\nOptions:\n" (options plugin) + else usageInfo "\n\nOptions:\n" (options plugin []) hpcError :: Plugin -> String -> IO a hpcError plugin msg = do @@ -118,7 +134,7 @@ hpcError plugin msg = do data Plugin = Plugin { name :: String , usage :: String - , options :: [OptDescr (Flags -> Flags)] + , options :: FlagOptSeq , summary :: String , implementation :: Flags -> [String] -> IO () , init_flags :: Flags @@ -135,15 +151,16 @@ data Plugin = Plugin { name :: String allowModule :: Flags -> String -> Bool allowModule flags full_mod - | full_mod `Set.member` excludeMods flags = False - | pkg_name `Set.member` excludeMods flags = False - | mod_name `Set.member` excludeMods flags = False - | Set.null (includeMods flags) = True - | full_mod `Set.member` includeMods flags = True - | pkg_name `Set.member` includeMods flags = True - | mod_name `Set.member` includeMods flags = True - | otherwise = False + | full_mod' `Set.member` excludeMods flags = False + | pkg_name `Set.member` excludeMods flags = False + | mod_name `Set.member` excludeMods flags = False + | Set.null (includeMods flags) = True + | full_mod' `Set.member` includeMods flags = True + | pkg_name `Set.member` includeMods flags = True + | mod_name `Set.member` includeMods flags = True + | otherwise = False where + full_mod' = pkg_name ++ mod_name -- pkg name always ends with '/', main (pkg_name,mod_name) = case span (/= '/') full_mod of diff --git a/utils/hpc/HpcLexer.hs b/utils/hpc/HpcLexer.hs new file mode 100644 index 0000000..74bec5d --- /dev/null +++ b/utils/hpc/HpcLexer.hs @@ -0,0 +1,45 @@ +module HpcLexer where + +import Data.Char + +data Token + = ID String + | SYM Char + | INT Int + | STR String + deriving (Eq,Show) + +initLexer :: String -> [Token] +initLexer str = [ t | (_,_,t) <- lexer str 1 0 ] + +lexer :: String -> Int -> Int -> [(Int,Int,Token)] +lexer (c:cs) line column + | c == '\n' = lexer cs (succ line) 0 + | c == '\"' = lexerSTR cs line (succ column) + | c `elem` "{};-:" + = (line,column,SYM c) : lexer cs line (succ column) + | isSpace c = lexer cs line (succ column) + | isAlpha c = lexerKW cs [c] line (succ column) + | isDigit c = lexerINT cs [c] line (succ column) + | otherwise = error "lexer failure" +lexer [] line colunm = [] + +lexerKW (c:cs) s line column + | isAlpha c = lexerKW cs (s ++ [c]) line (succ column) +lexerKW other s line column = (line,column,ID s) : lexer other line column + +lexerINT (c:cs) s line column + | isDigit c = lexerINT cs (s ++ [c]) line (succ column) +lexerINT other s line column = (line,column,INT (read s)) : lexer other line column + +-- not technically correct for the new column count, but a good approximation. +lexerSTR cs line column + = case lex ('"' : cs) of + [(str,rest)] -> (line,succ column,STR str) + : lexer rest line (length (show str) + column + 1) + _ -> error "bad string" + +test = do + t <- readFile "EXAMPLE.tc" + print (initLexer t) + diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index d4f4ee6..4b3b976 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -11,6 +11,7 @@ import Trace.Hpc.Util import HpcFlags +import System.Environment import System.Directory import Data.List import Data.Maybe(fromJust) @@ -19,13 +20,14 @@ import qualified HpcSet as Set ------------------------------------------------------------------------------ -markup_options = - [ excludeOpt,includeOpt,hpcDirOpt,hsDirOpt,funTotalsOpt - , altHighlightOpt -#if __GLASGOW_HASKELL__ >= 604 - , destDirOpt -#endif - ] +markup_options + = excludeOpt + . includeOpt + . srcDirOpt + . hpcDirOpt + . funTotalsOpt + . altHighlightOpt + . destDirOpt markup_plugin = Plugin { name = "markup" , usage = "[OPTION] .. [ [ ..]]" @@ -45,16 +47,14 @@ markup_main flags (prog:modNames) = do `Set.union` includeMods flags } let Flags - { hpcDirs = hpcDirs - , hsDirs = theHsPath - , funTotals = theFunTotals + { funTotals = theFunTotals , altHighlight = invertOutput , destDir = dest_dir } = hpcflags1 mtix <- readTix (getTixFileName prog) Tix tixs <- case mtix of - Nothing -> error $ "unable to find tix file for: " ++ prog + Nothing -> hpcError markup_plugin $ "unable to find tix file for: " ++ prog Just a -> return a #if __GLASGOW_HASKELL__ >= 604 @@ -63,7 +63,7 @@ markup_main flags (prog:modNames) = do #endif mods <- - sequence [ genHtmlFromMod dest_dir hpcDirs tix theFunTotals theHsPath invertOutput + sequence [ genHtmlFromMod dest_dir hpcflags1 tix theFunTotals invertOutput | tix <- tixs , allowModule hpcflags1 (tixModuleName tix) ] @@ -130,20 +130,20 @@ markup_main flags (prog:modNames) = do (percent (expTicked s1) (expTotal s1)) -markup_main flags [] = error $ "no .tix file or executable name specified" +markup_main flags [] = hpcError markup_plugin $ "no .tix file or executable name specified" genHtmlFromMod :: String - -> [FilePath] + -> Flags -> TixModule -> Bool - -> [String] -> Bool -> IO (String, [Char], ModuleSummary) -genHtmlFromMod dest_dir hpcDirs tix theFunTotals theHsPath invertOutput = do +genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do + let theHsPath = srcDirs flags let modName0 = tixModuleName tix - (Mix origFile _ mixHash tabStop mix') <- readMix hpcDirs modName0 + (Mix origFile _ mixHash tabStop mix') <- readMixWithFlags flags modName0 let arr_tix :: Array Int Integer arr_tix = listArray (0,length (tixModuleTixs tix) - 1) @@ -457,7 +457,8 @@ readFileFromPath filename@('/':_) _ = readFile filename readFileFromPath filename path0 = readTheFile path0 where readTheFile :: [String] -> IO String - readTheFile [] = error $ "could not find " ++ show filename + readTheFile [] = hpcError markup_plugin + $ "could not find " ++ show filename ++ " in path " ++ show path0 readTheFile (dir:dirs) = catch (do str <- readFile (dir ++ "/" ++ filename) diff --git a/utils/hpc/HpcOverlay.hs b/utils/hpc/HpcOverlay.hs new file mode 100644 index 0000000..ba229c5 --- /dev/null +++ b/utils/hpc/HpcOverlay.hs @@ -0,0 +1,28 @@ +module HpcOverlay where + +import HpcFlags +import HpcParser + +overlay_options + = srcDirOpt + . hpcDirOpt + . outputOpt + +overlay_plugin = Plugin { name = "overlay" + , usage = "[OPTION] .. [ [...]]" + , options = overlay_options + , summary = "Generate a .tix file from an overlay file" + , implementation = overlay_main + , init_flags = default_flags + , final_flags = default_final_flags + } + + +overlay_main flags [] = hpcError overlay_plugin $ "no overlay file specified" +overlay_main flags files = do + print ("HERE", files) + result <- hpcParser (head files) + print result + return () + + diff --git a/utils/hpc/HpcParser.y b/utils/hpc/HpcParser.y new file mode 100644 index 0000000..a6a095b --- /dev/null +++ b/utils/hpc/HpcParser.y @@ -0,0 +1,106 @@ +{ +module HpcParser where + +import HpcLexer +} + +%name parser +%tokentype { Token } +%error { \ e -> error $ show (take 10 e) } + +%token + MODULE { ID "module" } + TICK { ID "tick" } + EXPRESSION { ID "expression" } + ON { ID "on" } + LINE { ID "line" } + POSITION { ID "position" } + FUNCTION { ID "function" } + INSIDE { ID "inside" } + AT { ID "at" } + ':' { SYM ':' } + '-' { SYM '-' } + ';' { SYM ';' } + '{' { SYM '{' } + '}' { SYM '}' } + int { INT $$ } + string { STR $$ } + cat { STR $$ } +%% + +Spec :: { Spec } +Spec : Ticks Modules { Spec ($1 []) ($2 []) } + +Modules :: { L (ModuleName,[Tick]) } +Modules : Modules Module { $1 . ((:) $2) } + | { id } + +Module :: { (ModuleName,[Tick]) } +Module : MODULE string '{' TopTicks '}' + { ($2,$4 []) } + +TopTicks :: { L Tick } +TopTicks : TopTicks TopTick { $1 . ((:) $2) } + | { id } + +TopTick :: { Tick } +TopTick : Tick { ExprTick $1 } + | TICK FUNCTION string optQual optCat ';' + { TickFunction $3 $4 $5 } + | INSIDE string '{' TopTicks '}' + { InsideFunction $2 ($4 []) } + +Ticks :: { L ExprTick } +Ticks : Ticks Tick { $1 . ((:) $2) } + | { id } + +Tick :: { ExprTick } +Tick : TICK optString optQual optCat ';' + { TickExpression False $2 $3 $4 } + +optString :: { Maybe String } +optString : string { Just $1 } + | { Nothing } + +optQual :: { Maybe Qualifier } +optQual : ON LINE int { Just (OnLine $3) } + | AT POSITION int ':' int '-' int ':' int + { Just (AtPosition $3 $5 $7 $9) } + | { Nothing } +optCat :: { Maybe String } +optCat : cat { Just $1 } + | { Nothing } + +{ +type L a = [a] -> [a] + +type ModuleName = String + +data Spec + = Spec [ExprTick] [(ModuleName,[Tick])] + deriving (Show) + +data ExprTick + = TickExpression Bool (Maybe String) (Maybe Qualifier) (Maybe String) + deriving (Show) + +data Tick + = ExprTick ExprTick + | TickFunction String (Maybe Qualifier) (Maybe String) + | InsideFunction String [Tick] + deriving (Show) + +data Qualifier = OnLine Int + | AtPosition Int Int Int Int + deriving (Show) + + + +hpcParser :: String -> IO Spec +hpcParser filename = do + txt <- readFile filename + let tokens = initLexer txt + return $ parser tokens + + +} diff --git a/utils/hpc/HpcReport.hs b/utils/hpc/HpcReport.hs index 2fa79f6..2950cbf 100644 --- a/utils/hpc/HpcReport.hs +++ b/utils/hpc/HpcReport.hs @@ -5,7 +5,9 @@ module HpcReport (report_plugin) where +import System.Exit import Prelude hiding (exp) +import System(getArgs) import List(sort,intersperse) import HpcFlags import Trace.Hpc.Mix @@ -150,7 +152,7 @@ single (BinBox {}) = False modInfo :: Flags -> Bool -> (String,[Integer]) -> IO ModInfo modInfo hpcflags qualDecList (moduleName,tickCounts) = do - Mix _ _ _ _ mes <- readMix (hpcDirs hpcflags) moduleName + Mix _ _ _ _ mes <- readMixWithFlags hpcflags moduleName return (q (accumCounts (zip (map snd mes) tickCounts) miZero)) where q mi = if qualDecList then mi{decPaths = map (moduleName:) (decPaths mi)} @@ -223,9 +225,9 @@ report_main hpcflags (progName:mods) = do | TixModule m _h _ tcs <- tickCounts , allowModule hpcflags1 m ] - Nothing -> error $ "unable to find tix file for:" ++ progName - - + Nothing -> hpcError report_plugin $ "unable to find tix file for:" ++ progName +report_main hpcflags [] = + hpcError report_plugin $ "no .tix file or executable name specified" makeReport :: Flags -> String -> [(String,[Integer])] -> IO () makeReport hpcflags progName modTcs | xmlOutput hpcflags = do @@ -259,5 +261,13 @@ xmlBBT (BBT b tt tf bt) = [("boxes",show b),("true",show tt),("false",show tf),( ------------------------------------------------------------------------------ -report_options = [perModuleOpt,decListOpt,excludeOpt,includeOpt,hpcDirOpt,xmlOutputOpt] +report_options + = perModuleOpt + . decListOpt + . excludeOpt + . includeOpt + . srcDirOpt + . hpcDirOpt + . xmlOutputOpt + diff --git a/utils/hpc/HpcShowTix.hs b/utils/hpc/HpcShowTix.hs index 4ed07fd..c353e1b 100644 --- a/utils/hpc/HpcShowTix.hs +++ b/utils/hpc/HpcShowTix.hs @@ -2,15 +2,18 @@ module HpcShowTix (showtix_plugin) where import Trace.Hpc.Mix import Trace.Hpc.Tix +import Trace.Hpc.Util import HpcFlags import qualified HpcSet as Set -showtix_options = - [ excludeOpt,includeOpt,hpcDirOpt - , outputOpt - ] +showtix_options + = excludeOpt + . includeOpt + . srcDirOpt + . hpcDirOpt + . outputOpt showtix_plugin = Plugin { name = "show" , usage = "[OPTION] .. [ [ ..]]" @@ -34,12 +37,11 @@ showtix_main flags (prog:modNames) = do case optTixs of Nothing -> hpcError showtix_plugin $ "could not read .tix file : " ++ prog Just (Tix tixs) -> do - let modules = map tixModuleName tixs - - mixs <- sequence - [ readMix (hpcDirs hpcflags1) modName -- hard wired to .hpc for now - | modName <- modules - , allowModule hpcflags1 modName + tixs_mixs <- sequence + [ do mix <- readMixWithFlags hpcflags1 (tixModuleName tix) + return $ (tix,mix) + | tix <- tixs + , allowModule hpcflags1 (tixModuleName tix) ] let rjust n str = take (n - length str) (repeat ' ') ++ str @@ -52,7 +54,8 @@ showtix_main flags (prog:modNames) = do ] | ( TixModule modName hash _ tixs , Mix _file _timestamp _hash _tab entries - ) <- zip tixs mixs + ) <- tixs_mixs ] return () + -- 1.7.10.4