Commit b2c2e3e8 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺
Browse files

Add missing Semigroup instances in utils/{hpc,runghc}

This is a follow-up to c0feee90
parent c0feee90
......@@ -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 = (<>)
------------------------------------------------------------------------------
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment