Adding draft and show to hpc
[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 import HpcShowTix
14 import HpcDraft
15
16 helpList :: IO ()
17 helpList =
18 putStrLn $
19 "Usage: hpc COMMAND ...\n\n" ++
20 section "Commands" help ++
21 section "Reporting Coverage" reporting ++
22 section "Processing Coverage files" processing ++
23 section "Coverage Overlays" overlays ++
24 section "Others" other ++
25 ""
26 where
27 help = ["help"]
28 reporting = ["report","markup"]
29 overlays = ["overlay","draft"]
30 processing = ["combine"]
31 other = [ name hook
32 | hook <- hooks
33 , name hook `notElem`
34 (concat [help,reporting,processing,overlays])
35 ]
36
37 section :: String -> [String] -> String
38 section msg [] = ""
39 section msg cmds = msg ++ ":\n"
40 ++ unlines [ take 14 (" " ++ cmd ++ repeat ' ') ++ summary hook
41 | cmd <- cmds
42 , hook <- hooks
43 , name hook == cmd
44 ]
45
46 dispatch :: [String] -> IO ()
47 dispatch [] = do
48 helpList
49 exitWith ExitSuccess
50 dispatch (txt:args) = do
51 case lookup txt hooks' of
52 Just plugin -> parse plugin
53 _ -> parse help_plugin
54 where
55 parse plugin =
56 case getOpt Permute (options plugin) args of
57 (_,_,errs) | not (null errs)
58 -> do putStrLn "hpc failed:"
59 sequence [ putStr (" " ++ err)
60 | err <- errs
61 ]
62 putStrLn $ "\n"
63 command_usage plugin
64 exitFailure
65 (o,ns,_) -> do
66 let flags = foldr (.) (final_flags plugin) o
67 $ init_flags plugin
68 implementation plugin flags ns
69 main = do
70 args <- getArgs
71 dispatch args
72
73 ------------------------------------------------------------------------------
74
75 hooks = [ help_plugin
76 , report_plugin
77 , markup_plugin
78 , combine_plugin
79 , showtix_plugin
80 , draft_plugin
81 , version_plugin
82 ]
83
84 hooks' = [ (name hook,hook) | hook <- hooks ]
85
86 ------------------------------------------------------------------------------
87
88 help_plugin = Plugin { name = "help"
89 , usage = "[<HPC_COMMAND>]"
90 , summary = "Display help for hpc or a single command."
91 , options = help_options
92 , implementation = help_main
93 , init_flags = default_flags
94 , final_flags = default_final_flags
95 }
96
97 help_main flags [] = do
98 helpList
99 exitWith ExitSuccess
100 help_main flags (sub_txt:_) = do
101 case lookup sub_txt hooks' of
102 Nothing -> do
103 putStrLn $ "no such hpc command : " ++ sub_txt
104 exitFailure
105 Just plugin' -> do
106 command_usage plugin'
107 exitWith ExitSuccess
108
109 help_options = []
110
111 ------------------------------------------------------------------------------
112
113 version_plugin = Plugin { name = "version"
114 , usage = ""
115 , summary = "Display version for hpc"
116 , options = []
117 , implementation = version_main
118 , init_flags = default_flags
119 , final_flags = default_final_flags
120 }
121
122 version_main _ _ = putStrLn $ "hpc tools, version 0.5-dev"
123
124
125 ------------------------------------------------------------------------------