[commit: ghc] master: Add missing Semigroup instances in utils/{hpc, runghc} (b2c2e3e)
git at git.haskell.org
git at git.haskell.org
Thu Aug 31 18:18:26 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/b2c2e3e818b8aa69af711cefa7efeadedc3f2e4e/ghc
>---------------------------------------------------------------
commit b2c2e3e818b8aa69af711cefa7efeadedc3f2e4e
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date: Thu Aug 31 09:49:20 2017 +0200
Add missing Semigroup instances in utils/{hpc,runghc}
This is a follow-up to c0feee90118333dac817cfad6f2dedc0a886d1bd
>---------------------------------------------------------------
b2c2e3e818b8aa69af711cefa7efeadedc3f2e4e
utils/hpc/HpcMarkup.hs | 9 +++++----
utils/runghc/Main.hs | 16 ++++++++++------
2 files changed, 15 insertions(+), 10 deletions(-)
diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs
index ca30471..a9b5ce1 100644
--- a/utils/hpc/HpcMarkup.hs
+++ b/utils/hpc/HpcMarkup.hs
@@ -17,6 +17,7 @@ import System.FilePath
import System.IO (localeEncoding)
import Data.List
import Data.Maybe(fromJust)
+import Data.Semigroup as Semi
import Data.Array
import Control.Monad
import qualified Data.Set as Set
@@ -467,6 +468,9 @@ showSummary ticked total =
percent :: (Integral a) => a -> a -> Maybe a
percent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` total)
+instance Semi.Semigroup ModuleSummary where
+ (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
@@ -477,10 +481,7 @@ instance Monoid ModuleSummary where
, 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)
-
+ mappend = (<>)
------------------------------------------------------------------------------
diff --git a/utils/runghc/Main.hs b/utils/runghc/Main.hs
index b5d4a4a..dec53ee 100644
--- a/utils/runghc/Main.hs
+++ b/utils/runghc/Main.hs
@@ -19,6 +19,7 @@
module Main (main) where
import Control.Exception
+import Data.Semigroup as Semi
import System.Directory
import System.Environment
import System.Exit
@@ -77,14 +78,17 @@ data RunGhcFlags = RunGhcFlags (Maybe FilePath) -- GHC location
| Help -- Print help text
| ShowVersion -- Print version info
+instance Semi.Semigroup RunGhcFlags where
+ Help <> _ = Help
+ _ <> Help = Help
+ ShowVersion <> _ = ShowVersion
+ _ <> ShowVersion = ShowVersion
+ RunGhcFlags _ <> right@(RunGhcFlags (Just _)) = right
+ left@(RunGhcFlags _) <> RunGhcFlags Nothing = left
+
instance Monoid RunGhcFlags where
mempty = RunGhcFlags Nothing
- Help `mappend` _ = Help
- _ `mappend` Help = Help
- ShowVersion `mappend` _ = ShowVersion
- _ `mappend` ShowVersion = ShowVersion
- RunGhcFlags _ `mappend` right@(RunGhcFlags (Just _)) = right
- left@(RunGhcFlags _) `mappend` RunGhcFlags Nothing = left
+ mappend = (<>)
parseRunGhcFlags :: [String] -> (RunGhcFlags, [String])
parseRunGhcFlags = f mempty
More information about the ghc-commits
mailing list