X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fhpc%2FHpcFlags.hs;h=38abe6315e1ef079e74efbe3fd01485b77350451;hb=3c23b14c467a436d7fd95a80a4aceae8ea8913c7;hp=cb561a6a0029018431db38dab880356b071b0b86;hpb=11d36d9f0256a3a3ef2934a776924f7c90afb6de;p=ghc-hetmet.git

diff --git a/utils/hpc/HpcFlags.hs b/utils/hpc/HpcFlags.hs
index cb561a6..38abe63 100644
--- a/utils/hpc/HpcFlags.hs
+++ b/utils/hpc/HpcFlags.hs
@@ -4,9 +4,10 @@ module HpcFlags where
 
 import System.Console.GetOpt
 import Data.Maybe ( fromMaybe )
-import qualified Data.Set as Set
+import qualified HpcSet as Set
 import Data.Char
 import Trace.Hpc.Tix
+import System.Exit
 
 data Flags = Flags 
   { outputFile		:: String
@@ -67,9 +68,9 @@ anArg flag detail argtype fn = Option [] [flag] (ReqArg fn argtype) detail
 infoArg :: String -> OptDescr (Flags -> Flags)
 infoArg info = Option [] [] (NoArg $ id) info
 
-excludeOpt    = anArg "exclude"    "exclude MODULE" "MODULE"  $ \ a f -> f { excludeMods = a `Set.insert` excludeMods f }
+excludeOpt    = anArg "exclude"    "exclude MODULE and/or PACKAGE" "[PACKAGE:][MODULE]"  $ \ a f -> f { excludeMods = a `Set.insert` excludeMods f }
 
-includeOpt    = anArg "include"    "include MODULE" "MODULE"  $ \ a f -> f { includeMods = a `Set.insert` includeMods f }
+includeOpt    = anArg "include"    "include MODULE and/or PACKAGE" "[PACKAGE:][MODULE]"  $ \ a f -> f { includeMods = a `Set.insert` includeMods f }
 hpcDirOpt     = anArg "hpcdir"     "path to .mix files (default .hpc)" "DIR"
 	      	      		   	 		      $ \ a f -> f { hpcDirs = hpcDirs f ++ [a] }
 hsDirOpt      = anArg "hsdir"     "path to .hs files (default .)" "DIR"
@@ -108,6 +109,12 @@ command_usage plugin =
 				        then ""
   	                                else usageInfo "\n\nOptions:\n" (options plugin)
 
+hpcError :: Plugin -> String -> IO a
+hpcError plugin msg = do
+   putStrLn $ "Error: " ++ msg
+   command_usage plugin
+   exitFailure
+ 
 -------------------------------------------------------------------------------
 
 data Plugin = Plugin { name           :: String
@@ -128,11 +135,22 @@ data Plugin = Plugin { name           :: String
 --  * otherwise, accepts just the included modules.
 
 allowModule :: Flags -> String -> Bool
-allowModule flags mod 
-      | mod `Set.member` excludeMods flags = False
-      | Set.null (includeMods flags)       = True
-      | mod `Set.member` includeMods flags = True
-      | otherwise	 	     	   = False
+allowModule flags full_mod 
+      | full_mod `Set.member` excludeMods flags = False
+      | pkg_name `Set.member` excludeMods flags = False
+      | mod_name `Set.member` excludeMods flags = False
+      | Set.null (includeMods flags)            = True
+      | full_mod `Set.member` includeMods flags = True
+      | pkg_name `Set.member` includeMods flags = True
+      | mod_name `Set.member` includeMods flags = True
+      | otherwise	 	       	        = False
+  where
+      -- pkg name always ends with '/', main 
+	  (pkg_name,mod_name) = 
+			case span (/= ':') full_mod of
+		     (p,':':m) -> (p ++ ":",m)
+		     (m,[])    -> (":",m)
+		     _         -> error "impossible case in allowModule" 
 
 filterTix :: Flags -> Tix -> Tix
 filterTix flags (Tix tixs) =