diff options
| author | Herbert Valerio Riedel <hvr@gnu.org> | 2017-09-05 07:29:36 +0200 |
|---|---|---|
| committer | Herbert Valerio Riedel <hvr@gnu.org> | 2017-09-07 23:43:53 +0200 |
| commit | 8ae263ceb3566a7c82336400b09cb8f381217405 (patch) | |
| tree | 535775c4f739cd23bd443557f2d8f8b939cf711e /libraries/base/GHC/Event/Internal.hs | |
| parent | 055d73c6576bed2affaf96ef6a6b89aeb2cd2e9f (diff) | |
| download | haskell-8ae263ceb3566a7c82336400b09cb8f381217405.tar.gz | |
Make Semigroup a superclass of Monoid (re #14191)
Unfortunately, this requires introducing a couple of .hs-boot files to
break up import cycles (mostly to provide class & typenames in order to
be able to write type signatures).
This does not yet re-export `(<>)` from Prelude (while the class-name
`Semigroup` is reexported); that will happen in a future commit.
Test Plan: local ./validate passed
Reviewers: ekmett, austin, bgamari, erikd, RyanGlScott
Reviewed By: ekmett, RyanGlScott
GHC Trac Issues: #14191
Differential Revision: https://phabricator.haskell.org/D3927
Diffstat (limited to 'libraries/base/GHC/Event/Internal.hs')
| -rw-r--r-- | libraries/base/GHC/Event/Internal.hs | 18 |
1 files changed, 15 insertions, 3 deletions
diff --git a/libraries/base/GHC/Event/Internal.hs b/libraries/base/GHC/Event/Internal.hs index 9b8230c032..b7befdda25 100644 --- a/libraries/base/GHC/Event/Internal.hs +++ b/libraries/base/GHC/Event/Internal.hs @@ -36,6 +36,7 @@ import GHC.Base import GHC.Word (Word64) import GHC.Num (Num(..)) import GHC.Show (Show(..)) +import Data.Semigroup.Internal (stimesMonoid) -- | An I\/O event. newtype Event = Event Int @@ -72,10 +73,14 @@ instance Show Event where where ev `so` disp | e `eventIs` ev = disp | otherwise = "" +-- | @since 4.10.0.0 +instance Semigroup Event where + (<>) = evtCombine + stimes = stimesMonoid + -- | @since 4.3.1.0 instance Monoid Event where mempty = evtNothing - mappend = evtCombine mconcat = evtConcat evtCombine :: Event -> Event -> Event @@ -100,12 +105,16 @@ elSupremum OneShot OneShot = OneShot elSupremum _ _ = MultiShot {-# INLINE elSupremum #-} +-- | @since 4.10.0.0 +instance Semigroup Lifetime where + (<>) = elSupremum + stimes = stimesMonoid + -- | @mappend@ takes the longer of two lifetimes. -- -- @since 4.8.0.0 instance Monoid Lifetime where mempty = OneShot - mappend = elSupremum -- | A pair of an event and lifetime -- @@ -114,10 +123,13 @@ instance Monoid Lifetime where newtype EventLifetime = EL Int deriving (Show, Eq) +-- | @since 4.11.0.0 +instance Semigroup EventLifetime where + EL a <> EL b = EL (a .|. b) + -- | @since 4.8.0.0 instance Monoid EventLifetime where mempty = EL 0 - EL a `mappend` EL b = EL (a .|. b) eventLifetime :: Event -> Lifetime -> EventLifetime eventLifetime (Event e) l = EL (e .|. lifetimeBit l) |