hpc-tools: improving flag processing and help messages, small bug fixes.
[ghc-hetmet.git] / utils / hpc / HpcShowTix.hs
1 module HpcShowTix (showtix_plugin) where
2
3 import Trace.Hpc.Mix
4 import Trace.Hpc.Tix
5 import Trace.Hpc.Util
6
7 import HpcFlags
8
9 import qualified HpcSet as Set
10
11 showtix_options 
12         = excludeOpt
13         . includeOpt
14         . srcDirOpt
15         . hpcDirOpt
16         . outputOpt
17
18 showtix_plugin = Plugin { name = "show"
19                        , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]" 
20                        , options = showtix_options 
21                        , summary = "Show .tix file in readable, verbose format"
22                        , implementation = showtix_main
23                        , init_flags = default_flags
24                        , final_flags = default_final_flags
25                        }
26
27
28
29 showtix_main flags [] = hpcError showtix_plugin $ "no .tix file or executable name specified" 
30 showtix_main flags (prog:modNames) = do
31   let hpcflags1 = flags 
32                 { includeMods = Set.fromList modNames
33                                    `Set.union` 
34                                 includeMods flags }
35
36   optTixs <- readTix (getTixFileName prog)
37   case optTixs of
38     Nothing -> hpcError showtix_plugin $ "could not read .tix file : "  ++ prog
39     Just (Tix tixs) -> do
40        tixs_mixs <- sequence
41                [ do mix <- readMixWithFlags hpcflags1 (tixModuleName tix) 
42                     return $ (tix,mix)
43                | tix <- tixs
44                , allowModule hpcflags1 (tixModuleName tix)
45                ]
46      
47        let rjust n str = take (n - length str) (repeat ' ') ++ str 
48        let ljust n str = str ++ take (n - length str) (repeat ' ') 
49      
50        sequence_ [ sequence_ [ putStrLn (rjust 5 (show ix) ++ " " ++
51                                          rjust 10 (show count) ++ " " ++
52                                          ljust 20  modName ++ " " ++ rjust 20 (show pos) ++ " " ++ show lab)
53                              | (count,ix,(pos,lab)) <- zip3 tixs [(0::Int)..] entries
54                              ]
55                  | ( TixModule modName hash _ tixs
56                    , Mix _file _timestamp _hash _tab entries
57                    ) <- tixs_mixs
58                  ]
59        
60        return ()
61