utils/hpc/Main.hs

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