Fixing hpc to allow use of hash function to seperate source files on source path

6 files changed, 18 insertions, 16 deletions

diff --git a/utils/hpc/Hpc.hs b/utils/hpc/Hpc.hs
index f5c7240a24..e22556efa3 100644
--- a/utils/hpc/Hpc.hs
+++ b/utils/hpc/Hpc.hs
@@ -125,4 +125,4 @@ version_plugin = Plugin { name = "version"
 version_main _ _ = putStrLn $ "hpc tools, version 0.5-dev"
 
 
-------------------------------------------------------------------------------
+------------------------------------------------------------------------------
\ No newline at end of file
diff --git a/utils/hpc/HpcDraft.hs b/utils/hpc/HpcDraft.hs
index 36256fc261..cd72753ece 100644
--- a/utils/hpc/HpcDraft.hs
+++ b/utils/hpc/HpcDraft.hs
@@ -59,7 +59,7 @@ makeDraft hpcflags tix = do
       hash = tixModuleHash tix
       tixs = tixModuleTixs tix
 
-  mix@(Mix filepath timestamp hash tabstop entries) <- readMixWithFlags hpcflags mod
+  mix@(Mix filepath timestamp hash tabstop entries) <- readMixWithFlags hpcflags tix
 
   let forest = createMixEntryDom 
               [ (span,(box,v > 0))
diff --git a/utils/hpc/HpcFlags.hs b/utils/hpc/HpcFlags.hs
index 68bd861353..3147af8a48 100644
--- a/utils/hpc/HpcFlags.hs
+++ b/utils/hpc/HpcFlags.hs
@@ -110,6 +110,7 @@ postInvertOpt = noArg "post-invert" "invert output; ticked becomes unticked, unt
 							      $ \ f -> f { funTotals = True }  
 -------------------------------------------------------------------------------
 
+readMixWithFlags :: Flags -> TixModule -> IO Mix
 readMixWithFlags flags mod = readMix [ dir ++  "/" ++ hpcDir flags
                                      | dir <- srcDirs flags 
                                      ] mod
diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs
index 4b3b976f5a..9b920c600e 100644
--- a/utils/hpc/HpcMarkup.hs
+++ b/utils/hpc/HpcMarkup.hs
@@ -143,7 +143,7 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
   let theHsPath = srcDirs flags
   let modName0 = tixModuleName tix 
 
-  (Mix origFile _ mixHash tabStop mix') <- readMixWithFlags flags modName0
+  (Mix origFile _ mixHash tabStop mix') <- readMixWithFlags flags tix
 
   let arr_tix :: Array Int Integer
       arr_tix = listArray (0,length (tixModuleTixs tix) - 1)
diff --git a/utils/hpc/HpcReport.hs b/utils/hpc/HpcReport.hs
index 2950cbf253..77d66bd9cd 100644
--- a/utils/hpc/HpcReport.hs
+++ b/utils/hpc/HpcReport.hs
@@ -8,7 +8,7 @@ module HpcReport (report_plugin) where
 import System.Exit
 import Prelude hiding (exp)
 import System(getArgs)
-import List(sort,intersperse)
+import List(sort,intersperse,sortBy)
 import HpcFlags
 import Trace.Hpc.Mix
 import Trace.Hpc.Tix
@@ -150,17 +150,17 @@ single (TopLevelBox _) = True
 single (LocalBox _) = True
 single (BinBox {}) = False
 
-modInfo :: Flags -> Bool -> (String,[Integer]) -> IO ModInfo
-modInfo hpcflags qualDecList (moduleName,tickCounts) = do
-  Mix _ _ _ _ mes <- readMixWithFlags hpcflags moduleName
+modInfo :: Flags -> Bool -> TixModule -> IO ModInfo
+modInfo hpcflags qualDecList tix@(TixModule moduleName _ _ tickCounts) = do
+  Mix _ _ _ _ mes <- readMixWithFlags hpcflags tix
   return (q (accumCounts (zip (map snd mes) tickCounts) miZero))
   where
   q mi = if qualDecList then mi{decPaths = map (moduleName:) (decPaths mi)}
          else mi
 
-modReport :: Flags -> (String,[Integer]) -> IO ()
-modReport hpcflags (moduleName,tickCounts) = do
-  mi <- modInfo hpcflags False (moduleName,tickCounts)
+modReport :: Flags -> TixModule -> IO ()
+modReport hpcflags tix@(TixModule moduleName _ _ tickCounts) = do
+  mi <- modInfo hpcflags False tix
   if xmlOutput hpcflags 
     then putStrLn $ "  <module name = " ++ show moduleName  ++ ">"
     else putStrLn ("-----<module "++moduleName++">-----")
@@ -221,20 +221,21 @@ report_main hpcflags (progName:mods) = do
   case tix of
     Just (Tix tickCounts) ->
     	   makeReport hpcflags1 progName 
-	   	      [(m,tcs) 
-	   	      | TixModule m _h _ tcs <- tickCounts
+		    $ sortBy (\ mod1 mod2 -> tixModuleName mod1 `compare` tixModuleName mod2)
+	   	    $ [ tix
+	   	      | tix@(TixModule m _h _ tcs) <- tickCounts
 		      , allowModule hpcflags1 m 
 		      ]
     Nothing -> hpcError report_plugin  $ "unable to find tix file for:" ++ progName
 report_main hpcflags [] = 
         hpcError report_plugin $ "no .tix file or executable name specified" 
 
-makeReport :: Flags -> String -> [(String,[Integer])] -> IO ()
+makeReport :: Flags -> String -> [TixModule] -> IO ()
 makeReport hpcflags progName modTcs | xmlOutput hpcflags = do
   putStrLn $ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
   putStrLn $ "<coverage name=" ++ show progName ++ ">"
   if perModule hpcflags 
-    then mapM_ (modReport hpcflags) (sort modTcs)
+    then mapM_ (modReport hpcflags) modTcs
     else return ()
   mis <- mapM (modInfo hpcflags True) modTcs
   putStrLn $ "  <summary>"
@@ -243,7 +244,7 @@ makeReport hpcflags progName modTcs | xmlOutput hpcflags = do
   putStrLn $ "</coverage>"
 makeReport hpcflags _ modTcs =
   if perModule hpcflags then
-    mapM_ (modReport hpcflags) (sort modTcs)
+    mapM_ (modReport hpcflags) modTcs
   else do
     mis <- mapM (modInfo hpcflags True) modTcs
     printModInfo hpcflags (foldr miPlus miZero mis)
diff --git a/utils/hpc/HpcShowTix.hs b/utils/hpc/HpcShowTix.hs
index c353e1b278..b81f88cbff 100644
--- a/utils/hpc/HpcShowTix.hs
+++ b/utils/hpc/HpcShowTix.hs
@@ -38,7 +38,7 @@ showtix_main flags (prog:modNames) = do
     Nothing -> hpcError showtix_plugin $ "could not read .tix file : "  ++ prog
     Just (Tix tixs) -> do
        tixs_mixs <- sequence
-               [ do mix <- readMixWithFlags hpcflags1 (tixModuleName tix) 
+               [ do mix <- readMixWithFlags hpcflags1 tix
                     return $ (tix,mix)
                | tix <- tixs
 	       , allowModule hpcflags1 (tixModuleName tix)