diff options
author | Herbert Valerio Riedel <hvr@gnu.org> | 2017-08-31 09:49:20 +0200 |
---|---|---|
committer | Herbert Valerio Riedel <hvr@gnu.org> | 2017-08-31 09:49:20 +0200 |
commit | b2c2e3e818b8aa69af711cefa7efeadedc3f2e4e (patch) | |
tree | c58b69f6c8e14a7604be28d30473c1a4bdfbd5e8 /utils | |
parent | c0feee90118333dac817cfad6f2dedc0a886d1bd (diff) | |
download | haskell-b2c2e3e818b8aa69af711cefa7efeadedc3f2e4e.tar.gz |
Add missing Semigroup instances in utils/{hpc,runghc}
This is a follow-up to c0feee90118333dac817cfad6f2dedc0a886d1bd
Diffstat (limited to 'utils')
-rw-r--r-- | utils/hpc/HpcMarkup.hs | 9 | ||||
-rw-r--r-- | 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 ca30471ac4..a9b5ce1722 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 b5d4a4a9ca..dec53eefb0 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 |