Add support for FreeBSD arm
[ghc.git] / utils / hpc / HpcShowTix.hs
1 module HpcShowTix (showtix_plugin) where
2
3 import Trace.Hpc.Mix
4 import Trace.Hpc.Tix
5
6 import HpcFlags
7
8 import qualified Data.Set as Set
9
10 showtix_options :: FlagOptSeq
11 showtix_options
12 = excludeOpt
13 . includeOpt
14 . srcDirOpt
15 . hpcDirOpt
16 . resetHpcDirsOpt
17 . outputOpt
18 . verbosityOpt
19
20 showtix_plugin :: Plugin
21 showtix_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
31 showtix_main :: Flags -> [String] -> IO ()
32 showtix_main _ [] = hpcError showtix_plugin $ "no .tix file or executable name specified"
33 showtix_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