From 8b6f1dbd2d68af0652aebb8bc3253c64086305f4 Mon Sep 17 00:00:00 2001
From: "andy@galois.com" <unknown>
Date: Sat, 26 Jan 2008 21:06:07 +0000
Subject: [PATCH] Fix #2062: foldr1 problem in hpc tool

---
 utils/hpc/HpcMarkup.hs  |   29 ++++++++++++++++-------------
 utils/hpc/HpcOverlay.hs |    7 ++++---
 2 files changed, 20 insertions(+), 16 deletions(-)

diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs
index 3be17c8..a40c297 100644
--- a/utils/hpc/HpcMarkup.hs
+++ b/utils/hpc/HpcMarkup.hs
@@ -17,6 +17,7 @@ import System.Directory
 import Data.List
 import Data.Maybe(fromJust)
 import Data.Array
+import Data.Monoid
 import qualified HpcSet as Set
 
 ------------------------------------------------------------------------------
@@ -110,7 +111,7 @@ markup_main flags (prog:modNames) = do
 	    	   | (modName,fileName,summary) <- mods'
 	           ] ++
 	    "<tr></tr>" ++
-   	    showTotalSummary (foldr1 combineSummary 
+   	    showTotalSummary (mconcat
 	    		     	 [ summary 
 				 | (_,_,summary) <- mods'
 				 ])
@@ -197,14 +198,7 @@ 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 (hpcError markup_plugin) origFile theHsPath
@@ -438,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
diff --git a/utils/hpc/HpcOverlay.hs b/utils/hpc/HpcOverlay.hs
index 0cf56e4..76cc76e 100644
--- a/utils/hpc/HpcOverlay.hs
+++ b/utils/hpc/HpcOverlay.hs
@@ -138,9 +138,10 @@ qualifier pos (Just (AtPosition l1' c1' l2' c2'))
 	  = (l1', c1', l2', c2') == fromHpcPos pos
 
 concatSpec :: [Spec] -> Spec
-concatSpec = foldl1 $ 
-	       \ (Spec pre1 body1) (Spec pre2 body2) 
-		     -> Spec (pre1 ++ pre2) (body1 ++ body2)
+concatSpec = foldr 
+	       (\ (Spec pre1 body1) (Spec pre2 body2) 
+		     -> Spec (pre1 ++ pre2) (body1 ++ body2))
+		(Spec [] [])
 
 
 
-- 
1.7.10.4