utils/hpc/Hpc.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
  15 helpList :: IO ()
  16 helpList =
  17      putStrLn $
  18            "Usage: hpc COMMAND ...\n\n" ++
  19            section "Commands" help ++
  20            section "Reporting Coverage" reporting ++
  21            section "Processing Coverage files" processing ++
  22            section "Coverage Overlays" overlays ++
  23            section "Others" other ++
  24            ""
  25   where
  26     help       = ["help"]
  27     reporting  = ["report","markup"]
  28     overlays   = ["overlay","draft"]
  29     processing = ["combine"]
  30     other     = [ name hook
  31                 | hook <- hooks
  32                 , name hook `notElem`
  33                      (concat [help,reporting,processing,overlays])
  34                 ]
  35
  36 section :: String -> [String] -> String
  37 section msg []   = ""
  38 section msg cmds = msg ++ ":\n"
  39         ++ unlines [ take 14 ("  " ++ cmd ++ repeat ' ') ++ summary hook
  40                    | cmd <- cmds
  41                    , hook <- hooks
  42                    , name hook == cmd
  43                    ]
  44
  45 dispatch :: [String] -> IO ()
  46 dispatch [] = do
  47              helpList
  48              exitWith ExitSuccess
  49 dispatch (txt:args) = do
  50      case lookup txt hooks' of
  51        Just plugin -> parse plugin
  52        _ -> parse help_plugin
  53   where
  54      parse plugin =
  55               case getOpt Permute (options plugin) args of
  56                 (_,_,errs) | not (null errs)
  57                      -> do putStrLn "hpc failed:"
  58                            sequence [ putStr ("  " ++ err)
  59                                     | err <- errs
  60                                     ]
  61                            putStrLn $ "\n"
  62                            command_usage plugin
  63                            exitFailure
  64                 (o,ns,_) -> do
  65                          let flags = foldr (.) (final_flags plugin) o
  66                                    $ init_flags plugin
  67                          implementation plugin flags ns
  68 main = do
  69  args <- getArgs
  70  dispatch args
  71
  72 ------------------------------------------------------------------------------
  73
  74 hooks = [ help_plugin
  75         , report_plugin
  76         , markup_plugin
  77         , combine_plugin
  78         , showtix_plugin
  79         , draft_plugin
  80         , version_plugin
  81         ]
  82
  83 hooks' = [ (name hook,hook) | hook <- hooks ]
  84
  85 ------------------------------------------------------------------------------
  86
  87 help_plugin = Plugin { name = "help"
  88                    , usage = "[<HPC_COMMAND>]"
  89                    , summary = "Display help for hpc or a single command."
  90                    , options = help_options
  91                    , implementation = help_main
  92                    , init_flags = default_flags
  93                    , final_flags = default_final_flags
  94                    }
  95
  96 help_main flags [] = do
  97             helpList
  98             exitWith ExitSuccess
  99 help_main flags (sub_txt:_) = do
 100     case lookup sub_txt hooks' of
 101       Nothing -> do
 102           putStrLn $ "no such hpc command : " ++ sub_txt
 103           exitFailure
 104       Just plugin' -> do
 105           command_usage plugin'
 106           exitWith ExitSuccess
 107
 108 help_options   = []
 109
 110 ------------------------------------------------------------------------------
 111
 112 version_plugin = Plugin { name = "version"
 113                    , usage = ""
 114                    , summary = "Display version for hpc"
 115                    , options = []
 116                    , implementation = version_main
 117                    , init_flags = default_flags
 118                    , final_flags = default_final_flags
 119                    }
 120
 121 version_main _ _ = putStrLn $ "hpc tools, version 0.5-dev"
 122
 123
 124 ------------------------------------------------------------------------------