d567a0fad949b3e15d5c934f7b3b45d7303f332c
[ghc.git] / utils / hpc / Hpc.hs
1 -- (c) 2007 Andy Gill
2
3 -- Main driver for Hpc
4 import Trace.Hpc.Tix
5 import HpcFlags
6 import System.Environment
7 import System.Exit
8 import System.Console.GetOpt
9
10 import HpcReport
11 import HpcMarkup
12 import HpcCombine
13
14 helpList :: IO ()
15 helpList =
16 putStrLn $
17 "Usage: hpc COMMAND ...\n\n" ++
18 section "Commands" help ++
19 section "Reporting Coverage" reporting ++
20 section "Processing Coverage files" processing ++
21 section "Others" other ++
22 ""
23 where
24 help = ["help"]
25 reporting = ["report","markup"]
26 processing = ["combine"]
27 other = [ name hook
28 | hook <- hooks
29 , name hook `notElem`
30 (concat [help,reporting,processing])
31 ]
32
33 section :: String -> [String] -> String
34 section msg [] = ""
35 section msg cmds = msg ++ ":\n"
36 ++ unlines [ take 14 (" " ++ cmd ++ repeat ' ') ++ summary hook
37 | cmd <- cmds
38 , hook <- hooks
39 , name hook == cmd
40 ]
41
42 dispatch :: [String] -> IO ()
43 dispatch [] = do
44 helpList
45 exitWith ExitSuccess
46 dispatch (txt:args) = do
47 case lookup txt hooks' of
48 Just plugin -> parse plugin
49 _ -> parse help_plugin
50 where
51 parse plugin =
52 case getOpt Permute (options plugin) args of
53 (_,_,errs) | not (null errs)
54 -> do putStrLn "hpc failed:"
55 sequence [ putStr (" " ++ err)
56 | err <- errs
57 ]
58 putStrLn $ "\n"
59 command_usage plugin
60 exitFailure
61 (o,ns,_) -> do
62 let flags = foldr (.) (final_flags plugin) o
63 $ init_flags plugin
64 implementation plugin flags ns
65 main = do
66 args <- getArgs
67 dispatch args
68
69 ------------------------------------------------------------------------------
70
71 hooks = [ help_plugin
72 , report_plugin
73 , markup_plugin
74 , combine_plugin
75 , version_plugin
76 ]
77
78 hooks' = [ (name hook,hook) | hook <- hooks ]
79
80 ------------------------------------------------------------------------------
81
82 help_plugin = Plugin { name = "help"
83 , usage = "[<HPC_COMMAND>]"
84 , summary = "Display help for hpc or a single command."
85 , options = help_options
86 , implementation = help_main
87 , init_flags = default_flags
88 , final_flags = default_final_flags
89 }
90
91 help_main flags [] = do
92 helpList
93 exitWith ExitSuccess
94 help_main flags (sub_txt:_) = do
95 case lookup sub_txt hooks' of
96 Nothing -> do
97 putStrLn $ "no such hpc command : " ++ sub_txt
98 exitFailure
99 Just plugin' -> do
100 command_usage plugin'
101 exitWith ExitSuccess
102
103 help_options = []
104
105 ------------------------------------------------------------------------------
106
107 version_plugin = Plugin { name = "version"
108 , usage = ""
109 , summary = "Display version for hpc"
110 , options = []
111 , implementation = version_main
112 , init_flags = default_flags
113 , final_flags = default_final_flags
114 }
115
116 version_main _ _ = putStrLn $ "hpc tools, version 0.5-dev"
117
118
119 ------------------------------------------------------------------------------