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