1 files changed, 138 insertions, 0 deletions
diff --git a/utils/hpc/Main.hs b/utils/hpc/Main.hs
new file mode 100644
index 0000000000..da859d0345
--- /dev/null
+++ b/utils/hpc/Main.hs
@@ -0,0 +1,138 @@
+-- (c) 2007 Andy Gill
+
+-- Main driver for Hpc
+import HpcFlags
+import System.Environment
+import System.Exit
+import System.Console.GetOpt
+
+import HpcReport
+import HpcMarkup
+import HpcCombine
+import HpcShowTix
+import HpcDraft
+import HpcOverlay
+
+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 
+    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])
+		]
+
+section :: String -> [String] -> String
+section _   []   = ""
+section msg cmds = msg ++ ":\n" 
+        ++ unlines [ take 14 ("  " ++ cmd ++ repeat ' ') ++ summary hook
+	   	   | cmd <- cmds
+		   , hook <- hooks 
+		   , name hook == cmd
+		   ]
+
+dispatch :: [String] -> IO ()
+dispatch [] = do
+	     helpList
+	     exitWith ExitSuccess
+dispatch (txt:args0) = do
+     case lookup txt hooks' of
+       Just plugin -> parse plugin args0
+       _ -> parse help_plugin (txt:args0)
+  where
+     parse plugin args =
+              case getOpt Permute (options plugin []) args of
+                (_,_,errs) | not (null errs)
+                     -> do putStrLn "hpc failed:"
+                	   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
+
+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 = "[<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	    
+help_main _ (sub_txt:_) = do
+    case lookup sub_txt hooks' of
+      Nothing -> do
+	  putStrLn $ "no such hpc command : " ++ sub_txt
+	  exitFailure
+      Just plugin' -> 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"
+		   , 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 0.6"
+
+
+------------------------------------------------------------------------------