X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fhpc%2FHpcShowTix.hs;h=7fd651550aee613841a919d893c4b3071d8aa108;hb=e5c3b478b3cd1707cf122833822f44b2ac09b8e9;hp=d3d415741e93ccc6b1d3c9c45fa5c285472140b1;hpb=256ab58eb8f41086b3df819db52db29750de6f00;p=ghc-hetmet.git diff --git a/utils/hpc/HpcShowTix.hs b/utils/hpc/HpcShowTix.hs index d3d4157..7fd6515 100644 --- a/utils/hpc/HpcShowTix.hs +++ b/utils/hpc/HpcShowTix.hs @@ -7,11 +7,15 @@ import HpcFlags import qualified Data.Set as Set -showtix_options = - [ excludeOpt,includeOpt,hpcDirOpt - , outputOpt - ] - +showtix_options :: FlagOptSeq +showtix_options + = excludeOpt + . includeOpt + . srcDirOpt + . hpcDirOpt + . outputOpt + +showtix_plugin :: Plugin showtix_plugin = Plugin { name = "show" , usage = "[OPTION] .. [ [ ..]]" , options = showtix_options @@ -22,8 +26,8 @@ showtix_plugin = Plugin { name = "show" } - -showtix_main flags [] = hpcError showtix_plugin $ "no .tix file or executable name specified" +showtix_main :: Flags -> [String] -> IO () +showtix_main _ [] = hpcError showtix_plugin $ "no .tix file or executable name specified" showtix_main flags (prog:modNames) = do let hpcflags1 = flags { includeMods = Set.fromList modNames @@ -34,12 +38,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 (Right tix) + return $ (tix,mix) + | tix <- tixs + , allowModule hpcflags1 (tixModuleName tix) ] let rjust n str = take (n - length str) (repeat ' ') ++ str @@ -48,11 +51,12 @@ showtix_main flags (prog:modNames) = do sequence_ [ sequence_ [ putStrLn (rjust 5 (show ix) ++ " " ++ rjust 10 (show count) ++ " " ++ ljust 20 modName ++ " " ++ rjust 20 (show pos) ++ " " ++ show lab) - | (count,ix,(pos,lab)) <- zip3 tixs [(0::Int)..] entries + | (count,ix,(pos,lab)) <- zip3 tixs' [(0::Int)..] entries ] - | ( TixModule modName hash _ tixs - , Mix _file _timestamp _hash _tab entries - ) <- zip tixs mixs + | ( TixModule modName _hash1 _ tixs' + , Mix _file _timestamp _hash2 _tab entries + ) <- tixs_mixs ] return () +