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