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