diff options
| author | andy@galois.com <unknown> | 2008-01-26 21:06:07 +0000 |
|---|---|---|
| committer | andy@galois.com <unknown> | 2008-01-26 21:06:07 +0000 |
| commit | 8b6f1dbd2d68af0652aebb8bc3253c64086305f4 (patch) | |
| tree | 6a71d65e6e2e55aba4490bdc5d46108bcf1ae9e4 /utils | |
| parent | fb236fbbea7f12293b030892c6dc866a96566200 (diff) | |
| download | haskell-8b6f1dbd2d68af0652aebb8bc3253c64086305f4.tar.gz | |
Fix #2062: foldr1 problem in hpc tool
Diffstat (limited to 'utils')
| -rw-r--r-- | utils/hpc/HpcMarkup.hs | 29 | ||||
| -rw-r--r-- | 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 3be17c8da6..a40c297d4f 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 0cf56e4ae3..76cc76e0d7 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 [] []) |