X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fhpc%2FHpcMarkup.hs;h=a40c297d4f7185bd126f9ded8cd5af51765300ed;hb=1d47f08d196252b4ee5f4d5b5af2fb4945720762;hp=9b920c600ea34669f9b3440c2489ae92baeeeb5a;hpb=5f4e77a5a2ea03286b795da4051272ac7c774bd7;p=ghc-hetmet.git

diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs
index 9b920c6..a40c297 100644
--- a/utils/hpc/HpcMarkup.hs
+++ b/utils/hpc/HpcMarkup.hs
@@ -10,12 +10,14 @@ import Trace.Hpc.Tix
 import Trace.Hpc.Util
 
 import HpcFlags
+import HpcUtils
 
 import System.Environment
 import System.Directory
 import Data.List
 import Data.Maybe(fromJust)
 import Data.Array
+import Data.Monoid
 import qualified HpcSet as Set
 
 ------------------------------------------------------------------------------
@@ -109,7 +111,7 @@ markup_main flags (prog:modNames) = do
 	    	   | (modName,fileName,summary) <- mods'
 	           ] ++
 	    "<tr></tr>" ++
-   	    showTotalSummary (foldr1 combineSummary 
+   	    showTotalSummary (mconcat
 	    		     	 [ summary 
 				 | (_,_,summary) <- mods'
 				 ])
@@ -143,7 +145,7 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
   let theHsPath = srcDirs flags
   let modName0 = tixModuleName tix 
 
-  (Mix origFile _ mixHash tabStop mix') <- readMixWithFlags flags tix
+  (Mix origFile _ mixHash tabStop mix') <- readMixWithFlags flags (Right tix)
 
   let arr_tix :: Array Int Integer
       arr_tix = listArray (0,length (tixModuleTixs tix) - 1)
@@ -196,17 +198,10 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
              , let ticked = if isTicked gid
 	       	   	    then succ
 			    else id
-             ] $ ModuleSummary 
-	          { expTicked = 0
-	          , expTotal  = 0
-                  , topFunTicked = 0
-                  , topFunTotal  = 0
-                  , altTicked = 0
-                  , altTotal  = 0
-                  }
+             ] $ mempty
 
   -- add prefix to modName argument
-  content <- readFileFromPath origFile theHsPath
+  content <- readFileFromPath (hpcError markup_plugin) origFile theHsPath
 
   let content' = markup tabStop info content
   let show' = reverse . take 5 . (++ "       ") . reverse . show
@@ -437,10 +432,19 @@ percent :: (Integral a) => a -> a -> Maybe a
 percent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` total)
 
 
-combineSummary :: ModuleSummary -> ModuleSummary -> ModuleSummary
-combineSummary (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1)
-	       (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2)
-  = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2)
+instance Monoid ModuleSummary where
+  mempty = ModuleSummary
+	          { expTicked = 0
+	          , expTotal  = 0
+                  , topFunTicked = 0
+                  , topFunTotal  = 0
+                  , altTicked = 0
+                  , altTotal  = 0
+                  }
+  mappend (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1)
+	  (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2)
+     = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2)
+
 
 ------------------------------------------------------------------------------
 -- global color pallete
@@ -450,17 +454,3 @@ red    = "#f20913"
 green  = "#60de51"
 yellow = "yellow"
 
-------------------------------------------------------------------------------
-
-readFileFromPath :: String -> [String] -> IO String
-readFileFromPath filename@('/':_) _ = readFile filename
-readFileFromPath filename path0 = readTheFile path0
-  where
-	readTheFile :: [String] -> IO String
-	readTheFile [] = hpcError markup_plugin
-	                     $ "could not find " ++ show filename 
-			         ++ " in path " ++ show path0
-	readTheFile (dir:dirs) = 
-		catch (do str <- readFile (dir ++ "/" ++ filename) 
-			  return str) 
-		      (\ _ -> readTheFile dirs)