X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fhpc%2FHpc.hs;h=da859d0345990ab47a9c166f31097b96473e3351;hb=71cb36e103ce6892256c2e9c712e78ea37e7dff1;hp=f5c7240a2495f50e9ffd531f3221e83bcf9f49ac;hpb=0065868100d8e62bc2cc07fcac6c00da0810ffee;p=ghc-hetmet.git diff --git a/utils/hpc/Hpc.hs b/utils/hpc/Hpc.hs index f5c7240..da859d0 100644 --- a/utils/hpc/Hpc.hs +++ b/utils/hpc/Hpc.hs @@ -1,7 +1,6 @@ -- (c) 2007 Andy Gill -- Main driver for Hpc -import Trace.Hpc.Tix import HpcFlags import System.Environment import System.Exit @@ -28,7 +27,7 @@ helpList = help = ["help"] reporting = ["report","markup"] overlays = ["overlay","draft"] - processing = ["combine"] + processing = ["sum","combine","map"] other = [ name hook | hook <- hooks , name hook `notElem` @@ -36,7 +35,7 @@ helpList = ] section :: String -> [String] -> String -section msg [] = "" +section _ [] = "" section msg cmds = msg ++ ":\n" ++ unlines [ take 14 (" " ++ cmd ++ repeat ' ') ++ summary hook | cmd <- cmds @@ -48,10 +47,10 @@ dispatch :: [String] -> IO () dispatch [] = do helpList exitWith ExitSuccess -dispatch (txt:args) = do +dispatch (txt:args0) = do case lookup txt hooks' of - Just plugin -> parse plugin args - _ -> parse help_plugin (txt:args) + Just plugin -> parse plugin args0 + _ -> parse help_plugin (txt:args0) where parse plugin args = case getOpt Permute (options plugin []) args of @@ -68,39 +67,47 @@ dispatch (txt:args) = do $ 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." + , 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 +help_main :: Flags -> [String] -> IO () +help_main _ [] = do helpList exitWith ExitSuccess -help_main flags (sub_txt:_) = do +help_main _ (sub_txt:_) = do case lookup sub_txt hooks' of Nothing -> do putStrLn $ "no such hpc command : " ++ sub_txt @@ -109,10 +116,12 @@ help_main flags (sub_txt:_) = 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" @@ -122,7 +131,8 @@ version_plugin = Plugin { name = "version" , final_flags = default_final_flags } -version_main _ _ = putStrLn $ "hpc tools, version 0.5-dev" +version_main :: Flags -> [String] -> IO () +version_main _ _ = putStrLn $ "hpc tools, version 0.6" ------------------------------------------------------------------------------