Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
b2c2e3e8
Commit
b2c2e3e8
authored
Aug 31, 2017
by
Herbert Valerio Riedel
🕺
Browse files
Add missing Semigroup instances in utils/{hpc,runghc}
This is a follow-up to
c0feee90
parent
c0feee90
Changes
2
Hide whitespace changes
Inline
Side-by-side
utils/hpc/HpcMarkup.hs
View file @
b2c2e3e8
...
...
@@ -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
=
(
<>
)
------------------------------------------------------------------------------
...
...
utils/runghc/Main.hs
View file @
b2c2e3e8
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment