-- (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 = "[]" , 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) ------------------------------------------------------------------------------