diff options
Diffstat (limited to 'utils/hpc/Main.hs')
| -rw-r--r-- | utils/hpc/Main.hs | 120 |
1 files changed, 60 insertions, 60 deletions
diff --git a/utils/hpc/Main.hs b/utils/hpc/Main.hs index cb1eec6778..3f1813f243 100644 --- a/utils/hpc/Main.hs +++ b/utils/hpc/Main.hs @@ -17,38 +17,38 @@ 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 + 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]) - ] + | hook <- hooks + , name hook `notElem` + (concat [help,reporting,processing,overlays]) + ] section :: String -> [String] -> String section _ [] = "" -section msg cmds = msg ++ ":\n" +section msg cmds = msg ++ ":\n" ++ unlines [ take 14 (" " ++ cmd ++ repeat ' ') ++ summary hook - | cmd <- cmds - , hook <- hooks - , name hook == cmd - ] + | cmd <- cmds + , hook <- hooks + , name hook == cmd + ] dispatch :: [String] -> IO () dispatch [] = do - helpList - exitWith ExitSuccess + helpList + exitWith ExitSuccess dispatch (txt:args0) = do case lookup txt hooks' of Just plugin -> parse plugin args0 @@ -58,20 +58,20 @@ dispatch (txt:args0) = do case getOpt Permute (options plugin []) args of (_,_,errs) | not (null errs) -> do putStrLn "hpc failed:" - sequence_ [ putStr (" " ++ err) - | err <- errs - ] - putStrLn $ "\n" + 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 + exitFailure + (o,ns,_) -> do + let flags = final_flags plugin + $ foldr (.) id o + $ init_flags plugin + implementation plugin flags ns main :: IO () -main = do +main = do args <- getArgs dispatch args @@ -79,15 +79,15 @@ main = do hooks :: [Plugin] hooks = [ help_plugin - , report_plugin - , markup_plugin - , sum_plugin - , combine_plugin - , map_plugin - , showtix_plugin - , overlay_plugin - , draft_plugin - , version_plugin + , report_plugin + , markup_plugin + , sum_plugin + , combine_plugin + , map_plugin + , showtix_plugin + , overlay_plugin + , draft_plugin + , version_plugin ] hooks' :: [(String, Plugin)] @@ -97,26 +97,26 @@ 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 - } + , 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 + helpList + exitWith ExitSuccess help_main _ (sub_txt:_) = do case lookup sub_txt hooks' of Nothing -> do - putStrLn $ "no such hpc command : " ++ sub_txt - exitFailure + putStrLn $ "no such hpc command : " ++ sub_txt + exitFailure Just plugin' -> do - command_usage plugin' - exitWith ExitSuccess + command_usage plugin' + exitWith ExitSuccess help_options :: FlagOptSeq help_options = id @@ -125,13 +125,13 @@ 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 - } + , 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) |