[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