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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
-- (c) 2007 Andy Gill
-- Main driver for Hpc
import Data.Version
import System.Environment
import System.Exit
import System.Console.GetOpt
import HpcFlags
import HpcReport
import HpcMarkup
import HpcCombine
import HpcShowTix
import HpcDraft
import HpcOverlay
import Paths_hpc_bin
helpList :: IO ()
helpList =
putStrLn $
"Usage: hpc COMMAND ...\n\n" ++
section "Commands" help ++
section "Reporting Coverage" reporting ++
section "Processing Coverage files" processing ++
section "Coverage Overlays" overlays ++
section "Others" other ++
""
where
help = ["help"]
reporting = ["report","markup"]
overlays = ["overlay","draft"]
processing = ["sum","combine","map"]
other = [ name hook
| hook <- hooks
, name hook `notElem`
(concat [help,reporting,processing,overlays])
]
section :: String -> [String] -> String
section _ [] = ""
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:args0) = do
case lookup txt hooks' of
Just plugin -> parse plugin args0
_ -> parse help_plugin (txt:args0)
where
parse plugin args =
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 = final_flags plugin
$ foldr (.) id o
$ init_flags plugin
implementation plugin flags ns
main :: IO ()
main = do
args <- getArgs
dispatch args
------------------------------------------------------------------------------
hooks :: [Plugin]
hooks = [ help_plugin
, report_plugin
, markup_plugin
, sum_plugin
, combine_plugin
, map_plugin
, showtix_plugin
, overlay_plugin
, draft_plugin
, version_plugin
]
hooks' :: [(String, Plugin)]
hooks' = [ (name hook,hook) | hook <- hooks ]
------------------------------------------------------------------------------
help_plugin :: Plugin
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 -> [String] -> IO ()
help_main _ [] = do
helpList
exitWith ExitSuccess
help_main _ (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 :: FlagOptSeq
help_options = id
------------------------------------------------------------------------------
version_plugin :: Plugin
version_plugin = Plugin { name = "version"
, usage = ""
, summary = "Display version for hpc"
, options = id
, implementation = version_main
, init_flags = default_flags
, final_flags = default_final_flags
}
version_main :: Flags -> [String] -> IO ()
version_main _ _ = putStrLn ("hpc tools, version " ++ showVersion version)
------------------------------------------------------------------------------
|
