X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fhpc%2FHpc.hs;h=da859d0345990ab47a9c166f31097b96473e3351;hb=7ee35159446d22f0054fb9450f8fa20b43e10600;hp=3eb25d2506dd9a282a688371b9b268a038a29e25;hpb=3da243bf737dc3e26dfbfa943df1fda1ce7c1bab;p=ghc-hetmet.git

diff --git a/utils/hpc/Hpc.hs b/utils/hpc/Hpc.hs
index 3eb25d2..da859d0 100644
--- a/utils/hpc/Hpc.hs
+++ b/utils/hpc/Hpc.hs
@@ -11,6 +11,7 @@ import HpcMarkup
 import HpcCombine
 import HpcShowTix
 import HpcDraft
+import HpcOverlay
 
 helpList :: IO ()
 helpList =
@@ -26,7 +27,7 @@ helpList =
     help       = ["help"]
     reporting  = ["report","markup"]
     overlays   = ["overlay","draft"]
-    processing = ["combine"]
+    processing = ["sum","combine","map"]
     other     = [ name hook
     	        | hook <- hooks
 		, name hook `notElem` 
@@ -34,7 +35,7 @@ helpList =
 		]
 
 section :: String -> [String] -> String
-section msg []   = ""
+section _   []   = ""
 section msg cmds = msg ++ ":\n" 
         ++ unlines [ take 14 ("  " ++ cmd ++ repeat ' ') ++ summary hook
 	   	   | cmd <- cmds
@@ -46,13 +47,13 @@ dispatch :: [String] -> IO ()
 dispatch [] = do
 	     helpList
 	     exitWith ExitSuccess
-dispatch (txt:args) = do
+dispatch (txt:args0) = do
      case lookup txt hooks' of
-       Just plugin -> parse plugin
-       _ -> parse help_plugin
+       Just plugin -> parse plugin args0
+       _ -> parse help_plugin (txt:args0)
   where
-     parse plugin =
-              case getOpt Permute (options plugin) args of
+     parse plugin args =
+              case getOpt Permute (options plugin []) args of
                 (_,_,errs) | not (null errs)
                      -> do putStrLn "hpc failed:"
                 	   sequence [ putStr ("  " ++ err)
@@ -62,41 +63,51 @@ dispatch (txt:args) = do
                            command_usage plugin
           		   exitFailure
 	        (o,ns,_) -> do
-			 let flags = foldr (.) (final_flags plugin) o 
+			 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."
+		   , 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 [] = do
+help_main :: Flags -> [String] -> IO ()
+help_main _ [] = do
 	    helpList
 	    exitWith ExitSuccess	    
-help_main flags (sub_txt:_) = do
+help_main _ (sub_txt:_) = do
     case lookup sub_txt hooks' of
       Nothing -> do
 	  putStrLn $ "no such hpc command : " ++ sub_txt
@@ -105,20 +116,23 @@ help_main flags (sub_txt:_) = do
 	  command_usage plugin'
 	  exitWith ExitSuccess
 
-help_options   = []
+help_options :: FlagOptSeq
+help_options   = id
 
 ------------------------------------------------------------------------------
 
+version_plugin :: Plugin
 version_plugin = Plugin { name = "version"
 		   , usage = ""
 		   , summary = "Display version for hpc"
-		   , options = []
+		   , options = id
 		   , implementation = version_main
 		   , init_flags = default_flags
 		   , final_flags = default_final_flags
 		   }
 
-version_main _ _ = putStrLn $ "hpc tools, version 0.5-dev"
+version_main :: Flags -> [String] -> IO ()
+version_main _ _ = putStrLn $ "hpc tools, version 0.6"
 
 
-------------------------------------------------------------------------------
\ No newline at end of file
+------------------------------------------------------------------------------