utils/hpc/Hpc.hs

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