X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fhpc%2FHpcShowTix.hs;h=7fd651550aee613841a919d893c4b3071d8aa108;hb=8e4e15d8e837b90190b6b8e7645822772cab2053;hp=79c9fa342847aecb80ebcb16cf6363234502ef6e;hpb=a966047ca5c407f336a633d716d3d7b5ed29d231;p=ghc-hetmet.git diff --git a/utils/hpc/HpcShowTix.hs b/utils/hpc/HpcShowTix.hs index 79c9fa3..7fd6515 100644 --- a/utils/hpc/HpcShowTix.hs +++ b/utils/hpc/HpcShowTix.hs @@ -2,17 +2,20 @@ module HpcShowTix (showtix_plugin) where import Trace.Hpc.Mix import Trace.Hpc.Tix -import Trace.Hpc.Util 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 @@ -23,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 @@ -35,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 @@ -49,12 +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 () - \ No newline at end of file +