Make Semigroup a superclass of Monoid (re #14191)
authorHerbert Valerio Riedel <hvr@gnu.org>
Tue, 5 Sep 2017 05:29:36 +0000 (07:29 +0200)
committerHerbert Valerio Riedel <hvr@gnu.org>
Thu, 7 Sep 2017 21:43:53 +0000 (23:43 +0200)
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

44 files changed:
compiler/prelude/PrelNames.hs
libraries/base/Data/Either.hs
libraries/base/Data/Functor/Const.hs
libraries/base/Data/Functor/Identity.hs
libraries/base/Data/Functor/Utils.hs
libraries/base/Data/Monoid.hs
libraries/base/Data/Ord.hs
libraries/base/Data/Proxy.hs
libraries/base/Data/Semigroup.hs
libraries/base/Data/Semigroup/Internal.hs [new file with mode: 0644]
libraries/base/Data/Semigroup/Internal.hs-boot [new file with mode: 0644]
libraries/base/Data/Void.hs
libraries/base/GHC/Base.hs
libraries/base/GHC/Base.hs-boot [new file with mode: 0644]
libraries/base/GHC/Event/Internal.hs
libraries/base/GHC/Real.hs-boot [new file with mode: 0644]
libraries/base/GHC/ST.hs
libraries/base/Prelude.hs
libraries/base/base.cabal
libraries/base/changelog.md
testsuite/tests/ghci/scripts/T10963.script
testsuite/tests/ghci/scripts/T4175.stdout
testsuite/tests/ghci/scripts/T7627.stdout
testsuite/tests/ghci/scripts/T8535.stdout
testsuite/tests/ghci/scripts/T9881.stdout
testsuite/tests/ghci/scripts/ghci011.stdout
testsuite/tests/ghci/scripts/ghci020.stdout
testsuite/tests/ghci/should_run/T10145.stdout
testsuite/tests/perf/compiler/all.T
testsuite/tests/perf/should_run/T4978.hs
testsuite/tests/polykinds/MonoidsFD.hs
testsuite/tests/polykinds/MonoidsTF.hs
testsuite/tests/polykinds/T7332.hs
testsuite/tests/semigroup/Makefile [deleted file]
testsuite/tests/semigroup/SemigroupWarnings.hs [deleted file]
testsuite/tests/semigroup/SemigroupWarnings.stderr [deleted file]
testsuite/tests/semigroup/all.T [deleted file]
testsuite/tests/simplCore/should_run/T13429a.hs
testsuite/tests/typecheck/should_run/T6117.hs
testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs
testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs
testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs
testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr
testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs

index 1f9f8f3..b7cfb4f 100644 (file)
@@ -471,7 +471,7 @@ gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
     gHC_CLASSES, gHC_BASE, gHC_ENUM, gHC_GHCI, gHC_CSTRING,
     gHC_SHOW, gHC_READ, gHC_NUM, gHC_INTEGER_TYPE, gHC_NATURAL, gHC_LIST,
     gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING,
-    dATA_FOLDABLE, dATA_TRAVERSABLE, dATA_MONOID, dATA_SEMIGROUP,
+    dATA_FOLDABLE, dATA_TRAVERSABLE,
     gHC_CONC, gHC_IO, gHC_IO_Exception,
     gHC_ST, gHC_ARR, gHC_STABLE, gHC_PTR, gHC_ERR, gHC_REAL,
     gHC_FLOAT, gHC_TOP_HANDLER, sYSTEM_IO, dYNAMIC,
@@ -502,8 +502,6 @@ dATA_EITHER     = mkBaseModule (fsLit "Data.Either")
 dATA_STRING     = mkBaseModule (fsLit "Data.String")
 dATA_FOLDABLE   = mkBaseModule (fsLit "Data.Foldable")
 dATA_TRAVERSABLE= mkBaseModule (fsLit "Data.Traversable")
-dATA_SEMIGROUP  = mkBaseModule (fsLit "Data.Semigroup")
-dATA_MONOID     = mkBaseModule (fsLit "Data.Monoid")
 gHC_CONC        = mkBaseModule (fsLit "GHC.Conc")
 gHC_IO          = mkBaseModule (fsLit "GHC.IO")
 gHC_IO_Exception = mkBaseModule (fsLit "GHC.IO.Exception")
@@ -1020,8 +1018,8 @@ traversableClassName  = clsQual  dATA_TRAVERSABLE    (fsLit "Traversable") trave
 
 -- Classes (Semigroup, Monoid)
 semigroupClassName, sappendName :: Name
-semigroupClassName = clsQual dATA_SEMIGROUP (fsLit "Semigroup") semigroupClassKey
-sappendName        = varQual dATA_SEMIGROUP (fsLit "<>")        sappendClassOpKey
+semigroupClassName = clsQual gHC_BASE       (fsLit "Semigroup") semigroupClassKey
+sappendName        = varQual gHC_BASE       (fsLit "<>")        sappendClassOpKey
 monoidClassName, memptyName, mappendName, mconcatName :: Name
 monoidClassName    = clsQual gHC_BASE       (fsLit "Monoid")    monoidClassKey
 memptyName         = varQual gHC_BASE       (fsLit "mempty")    memptyClassOpKey
index 2469e78..58a8020 100644 (file)
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -131,6 +132,17 @@ instance Functor (Either a) where
     fmap _ (Left x) = Left x
     fmap f (Right y) = Right (f y)
 
+-- | @since 4.9.0.0
+instance Semigroup (Either a b) where
+    Left _ <> b = b
+    a      <> _ = a
+#if !defined(__HADDOCK_VERSION__)
+    -- workaround https://github.com/haskell/haddock/issues/680
+    stimes n x
+      | n <= 0 = errorWithoutStackTrace "stimes: positive multiplier expected"
+      | otherwise = x
+#endif
+
 -- | @since 3.0
 instance Applicative (Either e) where
     pure          = Right
index 9199b7c..8a33e58 100644 (file)
@@ -38,8 +38,8 @@ import GHC.Show (Show(showsPrec), showParen, showString)
 -- | The 'Const' functor.
 newtype Const a b = Const { getConst :: a }
     deriving ( Bits, Bounded, Enum, Eq, FiniteBits, Floating, Fractional
-             , Generic, Generic1, Integral, Ix, Monoid, Num, Ord, Real
-             , RealFrac, RealFloat , Storable)
+             , Generic, Generic1, Integral, Ix, Semigroup, Monoid, Num, Ord
+             , Real, RealFrac, RealFloat, Storable)
 
 -- | This instance would be equivalent to the derived instances of the
 -- 'Const' newtype if the 'runConst' field were removed
index 1fe127f..41c32d0 100644 (file)
@@ -43,7 +43,7 @@ import Data.Functor.Utils ((#.))
 import Foreign.Storable (Storable)
 import GHC.Arr (Ix)
 import GHC.Base ( Applicative(..), Eq(..), Functor(..), Monad(..)
-                , Monoid, Ord(..), ($), (.) )
+                , Semigroup, Monoid, Ord(..), ($), (.) )
 import GHC.Enum (Bounded, Enum)
 import GHC.Float (Floating, RealFloat)
 import GHC.Generics (Generic, Generic1)
@@ -58,7 +58,7 @@ import GHC.Types (Bool(..))
 -- @since 4.8.0.0
 newtype Identity a = Identity { runIdentity :: a }
     deriving ( Bits, Bounded, Enum, Eq, FiniteBits, Floating, Fractional
-             , Generic, Generic1, Integral, Ix, Monoid, Num, Ord
+             , Generic, Generic1, Integral, Ix, Semigroup, Monoid, Num, Ord
              , Real, RealFrac, RealFloat, Storable)
 
 -- | This instance would be equivalent to the derived instances of the
index 1bd729b..c6c2758 100644 (file)
@@ -11,7 +11,7 @@ module Data.Functor.Utils where
 
 import Data.Coerce (Coercible, coerce)
 import GHC.Base ( Applicative(..), Functor(..), Maybe(..), Monoid(..), Ord(..)
-                , ($), otherwise )
+                , Semigroup(..), ($), otherwise )
 
 -- We don't expose Max and Min because, as Edward Kmett pointed out to me,
 -- there are two reasonable ways to define them. One way is to use Maybe, as we
@@ -22,27 +22,31 @@ import GHC.Base ( Applicative(..), Functor(..), Maybe(..), Monoid(..), Ord(..)
 newtype Max a = Max {getMax :: Maybe a}
 newtype Min a = Min {getMin :: Maybe a}
 
+-- | @since 4.11.0.0
+instance Ord a => Semigroup (Max a) where
+    {-# INLINE (<>) #-}
+    m <> Max Nothing = m
+    Max Nothing <> n = n
+    (Max m@(Just x)) <> (Max n@(Just y))
+      | x >= y    = Max m
+      | otherwise = Max n
+
 -- | @since 4.8.0.0
 instance Ord a => Monoid (Max a) where
-  mempty = Max Nothing
+    mempty = Max Nothing
 
-  {-# INLINE mappend #-}
-  m `mappend` Max Nothing = m
-  Max Nothing `mappend` n = n
-  (Max m@(Just x)) `mappend` (Max n@(Just y))
-    | x >= y    = Max m
-    | otherwise = Max n
+-- | @since 4.11.0.0
+instance Ord a => Semigroup (Min a) where
+    {-# INLINE (<>) #-}
+    m <> Min Nothing = m
+    Min Nothing <> n = n
+    (Min m@(Just x)) <> (Min n@(Just y))
+      | x <= y    = Min m
+      | otherwise = Min n
 
 -- | @since 4.8.0.0
 instance Ord a => Monoid (Min a) where
-  mempty = Min Nothing
-
-  {-# INLINE mappend #-}
-  m `mappend` Min Nothing = m
-  Min Nothing `mappend` n = n
-  (Min m@(Just x)) `mappend` (Min n@(Just y))
-    | x <= y    = Min m
-    | otherwise = Min n
+    mempty = Min Nothing
 
 -- left-to-right state transformer
 newtype StateL s a = StateL { runStateL :: s -> (s, a) }
index 2e81784..1284a07 100644 (file)
@@ -43,148 +43,11 @@ module Data.Monoid (
 
 -- Push down the module in the dependency hierarchy.
 import GHC.Base hiding (Any)
-import GHC.Enum
-import GHC.Num
 import GHC.Read
 import GHC.Show
 import GHC.Generics
 
-{-
--- just for testing
-import Data.Maybe
-import Test.QuickCheck
--- -}
-
-infixr 6 <>
-
--- | An infix synonym for 'mappend'.
---
--- @since 4.5.0.0
-(<>) :: Monoid m => m -> m -> m
-(<>) = mappend
-{-# INLINE (<>) #-}
-
--- Monoid instances.
-
--- | The dual of a 'Monoid', obtained by swapping the arguments of 'mappend'.
---
--- >>> getDual (mappend (Dual "Hello") (Dual "World"))
--- "WorldHello"
-newtype Dual a = Dual { getDual :: a }
-        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1)
-
--- | @since 2.01
-instance Monoid a => Monoid (Dual a) where
-        mempty = Dual mempty
-        Dual x `mappend` Dual y = Dual (y `mappend` x)
-
--- | @since 4.8.0.0
-instance Functor Dual where
-    fmap     = coerce
-
--- | @since 4.8.0.0
-instance Applicative Dual where
-    pure     = Dual
-    (<*>)    = coerce
-
--- | @since 4.8.0.0
-instance Monad Dual where
-    m >>= k  = k (getDual m)
-
--- | The monoid of endomorphisms under composition.
---
--- >>> let computation = Endo ("Hello, " ++) <> Endo (++ "!")
--- >>> appEndo computation "Haskell"
--- "Hello, Haskell!"
-newtype Endo a = Endo { appEndo :: a -> a }
-               deriving (Generic)
-
--- | @since 2.01
-instance Monoid (Endo a) where
-        mempty = Endo id
-        Endo f `mappend` Endo g = Endo (f . g)
-
--- | Boolean monoid under conjunction ('&&').
---
--- >>> getAll (All True <> mempty <> All False)
--- False
---
--- >>> getAll (mconcat (map (\x -> All (even x)) [2,4,6,7,8]))
--- False
-newtype All = All { getAll :: Bool }
-        deriving (Eq, Ord, Read, Show, Bounded, Generic)
-
--- | @since 2.01
-instance Monoid All where
-        mempty = All True
-        All x `mappend` All y = All (x && y)
-
--- | Boolean monoid under disjunction ('||').
---
--- >>> getAny (Any True <> mempty <> Any False)
--- True
---
--- >>> getAny (mconcat (map (\x -> Any (even x)) [2,4,6,7,8]))
--- True
-newtype Any = Any { getAny :: Bool }
-        deriving (Eq, Ord, Read, Show, Bounded, Generic)
-
--- | @since 2.01
-instance Monoid Any where
-        mempty = Any False
-        Any x `mappend` Any y = Any (x || y)
-
--- | Monoid under addition.
---
--- >>> getSum (Sum 1 <> Sum 2 <> mempty)
--- 3
-newtype Sum a = Sum { getSum :: a }
-        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
-
--- | @since 2.01
-instance Num a => Monoid (Sum a) where
-        mempty = Sum 0
-        mappend = coerce ((+) :: a -> a -> a)
---        Sum x `mappend` Sum y = Sum (x + y)
-
--- | @since 4.8.0.0
-instance Functor Sum where
-    fmap     = coerce
-
--- | @since 4.8.0.0
-instance Applicative Sum where
-    pure     = Sum
-    (<*>)    = coerce
-
--- | @since 4.8.0.0
-instance Monad Sum where
-    m >>= k  = k (getSum m)
-
--- | Monoid under multiplication.
---
--- >>> getProduct (Product 3 <> Product 4 <> mempty)
--- 12
-newtype Product a = Product { getProduct :: a }
-        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
-
--- | @since 2.01
-instance Num a => Monoid (Product a) where
-        mempty = Product 1
-        mappend = coerce ((*) :: a -> a -> a)
---        Product x `mappend` Product y = Product (x * y)
-
--- | @since 4.8.0.0
-instance Functor Product where
-    fmap     = coerce
-
--- | @since 4.8.0.0
-instance Applicative Product where
-    pure     = Product
-    (<*>)    = coerce
-
--- | @since 4.8.0.0
-instance Monad Product where
-    m >>= k  = k (getProduct m)
+import Data.Semigroup.Internal
 
 -- $MaybeExamples
 -- To implement @find@ or @findLast@ on any 'Foldable':
@@ -229,11 +92,15 @@ newtype First a = First { getFirst :: Maybe a }
         deriving (Eq, Ord, Read, Show, Generic, Generic1,
                   Functor, Applicative, Monad)
 
+-- | @since 4.9.0.0
+instance Semigroup (First a) where
+        First Nothing <> b = b
+        a             <> _ = a
+        stimes = stimesIdempotentMonoid
+
 -- | @since 2.01
 instance Monoid (First a) where
         mempty = First Nothing
-        First Nothing `mappend` r = r
-        l `mappend` _             = l
 
 -- | Maybe monoid returning the rightmost non-Nothing value.
 --
@@ -246,23 +113,17 @@ newtype Last a = Last { getLast :: Maybe a }
         deriving (Eq, Ord, Read, Show, Generic, Generic1,
                   Functor, Applicative, Monad)
 
+-- | @since 4.9.0.0
+instance Semigroup (Last a) where
+        a <> Last Nothing = a
+        _ <> b                   = b
+        stimes = stimesIdempotentMonoid
+
 -- | @since 2.01
 instance Monoid (Last a) where
         mempty = Last Nothing
-        l `mappend` Last Nothing = l
-        _ `mappend` r            = r
 
--- | Monoid under '<|>'.
---
--- @since 4.8.0.0
-newtype Alt f a = Alt {getAlt :: f a}
-  deriving (Generic, Generic1, Read, Show, Eq, Ord, Num, Enum,
-            Monad, MonadPlus, Applicative, Alternative, Functor)
 
--- | @since 4.8.0.0
-instance Alternative f => Monoid (Alt f a) where
-        mempty = Alt empty
-        mappend = coerce ((<|>) :: f a -> f a -> f a)
 
 {-
 {--------------------------------------------------------------------
index 11d6967..2f5798c 100644 (file)
@@ -52,6 +52,7 @@ newtype Down a = Down a
       , Show -- ^ @since 4.7.0.0
       , Read -- ^ @since 4.7.0.0
       , Num -- ^ @since 4.11.0.0
+      , Semigroup -- ^ @since 4.11.0.0
       , Monoid -- ^ @since 4.11.0.0
       )
 
index 2ebb4ab..4f824d0 100644 (file)
@@ -98,10 +98,15 @@ instance Ix (Proxy s) where
     unsafeIndex _ _   = 0
     unsafeRangeSize _ = 1
 
+-- | @since 4.9.0.0
+instance Semigroup (Proxy s) where
+    _ <> _ = Proxy
+    sconcat _ = Proxy
+    stimes _ _ = Proxy
+
 -- | @since 4.7.0.0
 instance Monoid (Proxy s) where
     mempty = Proxy
-    mappend _ _ = Proxy
     mconcat _ = Proxy
 
 -- | @since 4.7.0.0
index 8631b11..4d06a40 100644 (file)
@@ -48,7 +48,6 @@ module Data.Semigroup (
   , Last(..)
   , WrappedMonoid(..)
   -- * Re-exported monoids from Data.Monoid
-  , Monoid(..)
   , Dual(..)
   , Endo(..)
   , All(..)
@@ -69,267 +68,31 @@ module Data.Semigroup (
 
 import           Prelude             hiding (foldr1)
 
+import GHC.Base (Semigroup(..))
+
+import           Data.Semigroup.Internal
+
 import           Control.Applicative
 import           Control.Monad
 import           Control.Monad.Fix
-import           Control.Monad.ST(ST)
 import           Data.Bifoldable
 import           Data.Bifunctor
 import           Data.Bitraversable
 import           Data.Coerce
 import           Data.Data
-import           Data.Functor.Identity
-import           Data.List.NonEmpty
 import           Data.Monoid         (All (..), Any (..), Dual (..), Endo (..),
                                       Product (..), Sum (..))
-import           Data.Monoid         (Alt (..))
-import qualified Data.Monoid         as Monoid
-import           Data.Ord            (Down(..))
-import           Data.Void
-#if !defined(mingw32_HOST_OS)
-import           GHC.Event           (Event, Lifetime)
-#endif
+-- import qualified Data.Monoid         as Monoid
 import           GHC.Generics
 
-infixr 6 <>
-
--- | The class of semigroups (types with an associative binary operation).
---
--- @since 4.9.0.0
-class Semigroup a where
-  -- | An associative operation.
-  --
-  -- @
-  -- (a '<>' b) '<>' c = a '<>' (b '<>' c)
-  -- @
-  --
-  -- If @a@ is also a 'Monoid' we further require
-  --
-  -- @
-  -- ('<>') = 'mappend'
-  -- @
-  (<>) :: a -> a -> a
-
-  default (<>) :: Monoid a => a -> a -> a
-  (<>) = mappend
-
-  -- | Reduce a non-empty list with @\<\>@
-  --
-  -- The default definition should be sufficient, but this can be
-  -- overridden for efficiency.
-  --
-  sconcat :: NonEmpty a -> a
-  sconcat (a :| as) = go a as where
-    go b (c:cs) = b <> go c cs
-    go b []     = b
-
-  -- | Repeat a value @n@ times.
-  --
-  -- Given that this works on a 'Semigroup' it is allowed to fail if
-  -- you request 0 or fewer repetitions, and the default definition
-  -- will do so.
-  --
-  -- By making this a member of the class, idempotent semigroups and monoids can
-  -- upgrade this to execute in /O(1)/ by picking
-  -- @stimes = stimesIdempotent@ or @stimes = stimesIdempotentMonoid@
-  -- respectively.
-  stimes :: Integral b => b -> a -> a
-  stimes y0 x0
-    | y0 <= 0   = errorWithoutStackTrace "stimes: positive multiplier expected"
-    | otherwise = f x0 y0
-    where
-      f x y
-        | even y = f (x <> x) (y `quot` 2)
-        | y == 1 = x
-        | otherwise = g (x <> x) (pred y  `quot` 2) x
-      g x y z
-        | even y = g (x <> x) (y `quot` 2) z
-        | y == 1 = x <> z
-        | otherwise = g (x <> x) (pred y `quot` 2) (x <> z)
-
 -- | A generalization of 'Data.List.cycle' to an arbitrary 'Semigroup'.
 -- May fail to terminate for some values in some semigroups.
 cycle1 :: Semigroup m => m -> m
 cycle1 xs = xs' where xs' = xs <> xs'
 
--- | @since 4.9.0.0
-instance Semigroup () where
-  _ <> _ = ()
-  sconcat _ = ()
-  stimes _ _ = ()
-
--- | @since 4.9.0.0
-instance Semigroup b => Semigroup (a -> b) where
-  f <> g = \a -> f a <> g a
-  stimes n f e = stimes n (f e)
-
--- | @since 4.9.0.0
-instance Semigroup [a] where
-  (<>) = (++)
-  stimes n x
-    | n < 0 = errorWithoutStackTrace "stimes: [], negative multiplier"
-    | otherwise = rep n
-    where
-      rep 0 = []
-      rep i = x ++ rep (i - 1)
-
--- | @since 4.9.0.0
-instance Semigroup a => Semigroup (Maybe a) where
-  Nothing <> b       = b
-  a       <> Nothing = a
-  Just a  <> Just b  = Just (a <> b)
-  stimes _ Nothing  = Nothing
-  stimes n (Just a) = case compare n 0 of
-    LT -> errorWithoutStackTrace "stimes: Maybe, negative multiplier"
-    EQ -> Nothing
-    GT -> Just (stimes n a)
-
--- | @since 4.9.0.0
-instance Semigroup (Either a b) where
-  Left _ <> b = b
-  a      <> _ = a
-  stimes = stimesIdempotent
-
--- | @since 4.9.0.0
-instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
-  (a,b) <> (a',b') = (a<>a',b<>b')
-  stimes n (a,b) = (stimes n a, stimes n b)
-
--- | @since 4.9.0.0
-instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where
-  (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c')
-  stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c)
-
--- | @since 4.9.0.0
-instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d)
-         => Semigroup (a, b, c, d) where
-  (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d')
-  stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d)
-
--- | @since 4.9.0.0
-instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e)
-         => Semigroup (a, b, c, d, e) where
-  (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')
-  stimes n (a,b,c,d,e) =
-      (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e)
-
--- | @since 4.9.0.0
-instance Semigroup Ordering where
-  LT <> _ = LT
-  EQ <> y = y
-  GT <> _ = GT
-  stimes = stimesIdempotentMonoid
-
--- | @since 4.9.0.0
-instance Semigroup a => Semigroup (Dual a) where
-  Dual a <> Dual b = Dual (b <> a)
-  stimes n (Dual a) = Dual (stimes n a)
-
--- | @since 4.9.0.0
-instance Semigroup (Endo a) where
-  (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a))
-  stimes = stimesMonoid
-
--- | @since 4.9.0.0
-instance Semigroup All where
-  (<>) = coerce (&&)
-  stimes = stimesIdempotentMonoid
-
--- | @since 4.9.0.0
-instance Semigroup Any where
-  (<>) = coerce (||)
-  stimes = stimesIdempotentMonoid
-
--- | @since 4.11.0.0
-instance Semigroup a => Semigroup (Down a) where
-  Down a <> Down b = Down (a <> b)
-  stimes n (Down a) = Down (stimes n a)
-
-
--- | @since 4.9.0.0
-instance Num a => Semigroup (Sum a) where
-  (<>) = coerce ((+) :: a -> a -> a)
-  stimes n (Sum a) = Sum (fromIntegral n * a)
-
--- | @since 4.9.0.0
-instance Num a => Semigroup (Product a) where
-  (<>) = coerce ((*) :: a -> a -> a)
-  stimes n (Product a) = Product (a ^ n)
-
--- | This is a valid definition of 'stimes' for a 'Monoid'.
---
--- Unlike the default definition of 'stimes', it is defined for 0
--- and so it should be preferred where possible.
-stimesMonoid :: (Integral b, Monoid a) => b -> a -> a
-stimesMonoid n x0 = case compare n 0 of
-  LT -> errorWithoutStackTrace "stimesMonoid: negative multiplier"
-  EQ -> mempty
-  GT -> f x0 n
-    where
-      f x y
-        | even y = f (x `mappend` x) (y `quot` 2)
-        | y == 1 = x
-        | otherwise = g (x `mappend` x) (pred y  `quot` 2) x
-      g x y z
-        | even y = g (x `mappend` x) (y `quot` 2) z
-        | y == 1 = x `mappend` z
-        | otherwise = g (x `mappend` x) (pred y `quot` 2) (x `mappend` z)
-
--- | This is a valid definition of 'stimes' for an idempotent 'Monoid'.
---
--- When @mappend x x = x@, this definition should be preferred, because it
--- works in /O(1)/ rather than /O(log n)/
-stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a
-stimesIdempotentMonoid n x = case compare n 0 of
-  LT -> errorWithoutStackTrace "stimesIdempotentMonoid: negative multiplier"
-  EQ -> mempty
-  GT -> x
-
--- | This is a valid definition of 'stimes' for an idempotent 'Semigroup'.
---
--- When @x <> x = x@, this definition should be preferred, because it
--- works in /O(1)/ rather than /O(log n)/.
-stimesIdempotent :: Integral b => b -> a -> a
-stimesIdempotent n x
-  | n <= 0 = errorWithoutStackTrace "stimesIdempotent: positive multiplier expected"
-  | otherwise = x
-
--- | @since 4.9.0.0
-instance Semigroup a => Semigroup (Identity a) where
-  (<>) = coerce ((<>) :: a -> a -> a)
-  stimes n (Identity a) = Identity (stimes n a)
-
--- | @since 4.9.0.0
-instance Semigroup a => Semigroup (Const a b) where
-  (<>) = coerce ((<>) :: a -> a -> a)
-  stimes n (Const a) = Const (stimes n a)
-
--- | @since 4.9.0.0
-instance Semigroup (Monoid.First a) where
-  Monoid.First Nothing <> b = b
-  a                    <> _ = a
-  stimes = stimesIdempotentMonoid
-
--- | @since 4.9.0.0
-instance Semigroup (Monoid.Last a) where
-  a <> Monoid.Last Nothing = a
-  _ <> b                   = b
-  stimes = stimesIdempotentMonoid
-
--- | @since 4.9.0.0
-instance Alternative f => Semigroup (Alt f a) where
-  (<>) = coerce ((<|>) :: f a -> f a -> f a)
-  stimes = stimesMonoid
-
--- | @since 4.9.0.0
-instance Semigroup Void where
-  a <> _ = a
-  stimes = stimesIdempotent
-
--- | @since 4.9.0.0
-instance Semigroup (NonEmpty a) where
-  (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs)
-
+-- | This lets you use a difference list of a 'Semigroup' as a 'Monoid'.
+diff :: Semigroup m => m -> Endo m
+diff = Endo . (<>)
 
 newtype Min a = Min { getMin :: a }
   deriving (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1)
@@ -354,7 +117,6 @@ instance Ord a => Semigroup (Min a) where
 -- | @since 4.9.0.0
 instance (Ord a, Bounded a) => Monoid (Min a) where
   mempty = maxBound
-  mappend = (<>)
 
 -- | @since 4.9.0.0
 instance Functor Min where
@@ -417,7 +179,6 @@ instance Ord a => Semigroup (Max a) where
 -- | @since 4.9.0.0
 instance (Ord a, Bounded a) => Monoid (Max a) where
   mempty = minBound
-  mappend = (<>)
 
 -- | @since 4.9.0.0
 instance Functor Max where
@@ -498,7 +259,7 @@ instance Bifunctor Arg where
 
 -- | @since 4.10.0.0
 instance Bifoldable Arg where
-  bifoldMap f g (Arg a b) = f a `mappend` g b
+  bifoldMap f g (Arg a b) = f a <> g b
 
 -- | @since 4.10.0.0
 instance Bitraversable Arg where
@@ -606,6 +367,9 @@ instance MonadFix Last where
   mfix f = fix (f . getLast)
 
 -- | Provide a Semigroup for an arbitrary Monoid.
+--
+-- __NOTE__: This is not needed anymore since 'Semigroup' became a superclass of
+-- 'Monoid' in /base-4.11/ and this newtype be deprecated at some point in the future.
 newtype WrappedMonoid m = WrapMonoid { unwrapMonoid :: m }
   deriving (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1)
 
@@ -616,7 +380,6 @@ instance Monoid m => Semigroup (WrappedMonoid m) where
 -- | @since 4.9.0.0
 instance Monoid m => Monoid (WrappedMonoid m) where
   mempty = WrapMonoid mempty
-  mappend = (<>)
 
 -- | @since 4.9.0.0
 instance Enum a => Enum (WrappedMonoid a) where
@@ -700,44 +463,15 @@ option n j (Option m) = maybe n j m
 -- | @since 4.9.0.0
 instance Semigroup a => Semigroup (Option a) where
   (<>) = coerce ((<>) :: Maybe a -> Maybe a -> Maybe a)
-
+#if !defined(__HADDOCK_VERSION__)
+    -- workaround https://github.com/haskell/haddock/issues/680
   stimes _ (Option Nothing) = Option Nothing
   stimes n (Option (Just a)) = case compare n 0 of
     LT -> errorWithoutStackTrace "stimes: Option, negative multiplier"
     EQ -> Option Nothing
     GT -> Option (Just (stimes n a))
+#endif
 
 -- | @since 4.9.0.0
 instance Semigroup a => Monoid (Option a) where
   mempty = Option Nothing
-  mappend = (<>)
-
--- | This lets you use a difference list of a 'Semigroup' as a 'Monoid'.
-diff :: Semigroup m => m -> Endo m
-diff = Endo . (<>)
-
--- | @since 4.9.0.0
-instance Semigroup (Proxy s) where
-  _ <> _ = Proxy
-  sconcat _ = Proxy
-  stimes _ _ = Proxy
-
--- | @since 4.10.0.0
-instance Semigroup a => Semigroup (IO a) where
-    (<>) = liftA2 (<>)
-
--- | @since 4.11.0.0
-instance Semigroup a => Semigroup (ST s a) where
-    (<>) = liftA2 (<>)
-
-#if !defined(mingw32_HOST_OS)
--- | @since 4.10.0.0
-instance Semigroup Event where
-    (<>) = mappend
-    stimes = stimesMonoid
-
--- | @since 4.10.0.0
-instance Semigroup Lifetime where
-    (<>) = mappend
-    stimes = stimesMonoid
-#endif
diff --git a/libraries/base/Data/Semigroup/Internal.hs b/libraries/base/Data/Semigroup/Internal.hs
new file mode 100644 (file)
index 0000000..3cdf54b
--- /dev/null
@@ -0,0 +1,258 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Auxilary definitions for 'Semigroup'
+--
+-- This module provides some @newtype@ wrappers and helpers which are
+-- reexported from the "Data.Semigroup" module or imported directly
+-- by some other modules.
+--
+-- This module also provides internal definitions related to the
+-- 'Semigroup' class some.
+--
+-- This module exists mostly to simplify or workaround import-graph
+-- issues; there is also a .hs-boot file to allow "GHC.Base" and other
+-- modules to import method default implementations for 'stimes'
+--
+-- @since 4.11.0.0
+module Data.Semigroup.Internal where
+
+import GHC.Base hiding (Any)
+import GHC.Enum
+import GHC.Num
+import GHC.Read
+import GHC.Show
+import GHC.Generics
+import GHC.Real
+
+-- | This is a valid definition of 'stimes' for an idempotent 'Semigroup'.
+--
+-- When @x <> x = x@, this definition should be preferred, because it
+-- works in /O(1)/ rather than /O(log n)/.
+stimesIdempotent :: Integral b => b -> a -> a
+stimesIdempotent n x
+  | n <= 0 = errorWithoutStackTrace "stimesIdempotent: positive multiplier expected"
+  | otherwise = x
+
+-- | This is a valid definition of 'stimes' for an idempotent 'Monoid'.
+--
+-- When @mappend x x = x@, this definition should be preferred, because it
+-- works in /O(1)/ rather than /O(log n)/
+stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a
+stimesIdempotentMonoid n x = case compare n 0 of
+  LT -> errorWithoutStackTrace "stimesIdempotentMonoid: negative multiplier"
+  EQ -> mempty
+  GT -> x
+
+-- | This is a valid definition of 'stimes' for a 'Monoid'.
+--
+-- Unlike the default definition of 'stimes', it is defined for 0
+-- and so it should be preferred where possible.
+stimesMonoid :: (Integral b, Monoid a) => b -> a -> a
+stimesMonoid n x0 = case compare n 0 of
+  LT -> errorWithoutStackTrace "stimesMonoid: negative multiplier"
+  EQ -> mempty
+  GT -> f x0 n
+    where
+      f x y
+        | even y = f (x `mappend` x) (y `quot` 2)
+        | y == 1 = x
+        | otherwise = g (x `mappend` x) (pred y  `quot` 2) x
+      g x y z
+        | even y = g (x `mappend` x) (y `quot` 2) z
+        | y == 1 = x `mappend` z
+        | otherwise = g (x `mappend` x) (pred y `quot` 2) (x `mappend` z)
+
+-- this is used by the class definitionin GHC.Base;
+-- it lives here to avoid cycles
+stimesDefault :: (Integral b, Semigroup a) => b -> a -> a
+stimesDefault y0 x0
+  | y0 <= 0   = errorWithoutStackTrace "stimes: positive multiplier expected"
+  | otherwise = f x0 y0
+  where
+    f x y
+      | even y = f (x <> x) (y `quot` 2)
+      | y == 1 = x
+      | otherwise = g (x <> x) (pred y  `quot` 2) x
+    g x y z
+      | even y = g (x <> x) (y `quot` 2) z
+      | y == 1 = x <> z
+      | otherwise = g (x <> x) (pred y `quot` 2) (x <> z)
+
+stimesMaybe :: (Integral b, Semigroup a) => b -> Maybe a -> Maybe a
+stimesMaybe _ Nothing = Nothing
+stimesMaybe n (Just a) = case compare n 0 of
+    LT -> errorWithoutStackTrace "stimes: Maybe, negative multiplier"
+    EQ -> Nothing
+    GT -> Just (stimes n a)
+
+stimesList  :: Integral b => b -> [a] -> [a]
+stimesList n x
+  | n < 0 = errorWithoutStackTrace "stimes: [], negative multiplier"
+  | otherwise = rep n
+  where
+    rep 0 = []
+    rep i = x ++ rep (i - 1)
+
+-- | The dual of a 'Monoid', obtained by swapping the arguments of 'mappend'.
+--
+-- >>> getDual (mappend (Dual "Hello") (Dual "World"))
+-- "WorldHello"
+newtype Dual a = Dual { getDual :: a }
+        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1)
+
+-- | @since 4.9.0.0
+instance Semigroup a => Semigroup (Dual a) where
+        Dual a <> Dual b = Dual (b <> a)
+        stimes n (Dual a) = Dual (stimes n a)
+
+-- | @since 2.01
+instance Monoid a => Monoid (Dual a) where
+        mempty = Dual mempty
+
+-- | @since 4.8.0.0
+instance Functor Dual where
+    fmap     = coerce
+
+-- | @since 4.8.0.0
+instance Applicative Dual where
+    pure     = Dual
+    (<*>)    = coerce
+
+-- | @since 4.8.0.0
+instance Monad Dual where
+    m >>= k  = k (getDual m)
+
+-- | The monoid of endomorphisms under composition.
+--
+-- >>> let computation = Endo ("Hello, " ++) <> Endo (++ "!")
+-- >>> appEndo computation "Haskell"
+-- "Hello, Haskell!"
+newtype Endo a = Endo { appEndo :: a -> a }
+               deriving (Generic)
+
+-- | @since 4.9.0.0
+instance Semigroup (Endo a) where
+        (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a))
+        stimes = stimesMonoid
+
+-- | @since 2.01
+instance Monoid (Endo a) where
+        mempty = Endo id
+
+-- | Boolean monoid under conjunction ('&&').
+--
+-- >>> getAll (All True <> mempty <> All False)
+-- False
+--
+-- >>> getAll (mconcat (map (\x -> All (even x)) [2,4,6,7,8]))
+-- False
+newtype All = All { getAll :: Bool }
+        deriving (Eq, Ord, Read, Show, Bounded, Generic)
+
+-- | @since 4.9.0.0
+instance Semigroup All where
+        (<>) = coerce (&&)
+        stimes = stimesIdempotentMonoid
+
+-- | @since 2.01
+instance Monoid All where
+        mempty = All True
+
+-- | Boolean monoid under disjunction ('||').
+--
+-- >>> getAny (Any True <> mempty <> Any False)
+-- True
+--
+-- >>> getAny (mconcat (map (\x -> Any (even x)) [2,4,6,7,8]))
+-- True
+newtype Any = Any { getAny :: Bool }
+        deriving (Eq, Ord, Read, Show, Bounded, Generic)
+
+-- | @since 4.9.0.0
+instance Semigroup Any where
+        (<>) = coerce (||)
+        stimes = stimesIdempotentMonoid
+
+-- | @since 2.01
+instance Monoid Any where
+        mempty = Any False
+
+-- | Monoid under addition.
+--
+-- >>> getSum (Sum 1 <> Sum 2 <> mempty)
+-- 3
+newtype Sum a = Sum { getSum :: a }
+        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
+
+-- | @since 4.9.0.0
+instance Num a => Semigroup (Sum a) where
+        (<>) = coerce ((+) :: a -> a -> a)
+        stimes n (Sum a) = Sum (fromIntegral n * a)
+
+-- | @since 2.01
+instance Num a => Monoid (Sum a) where
+        mempty = Sum 0
+
+-- | @since 4.8.0.0
+instance Functor Sum where
+    fmap     = coerce
+
+-- | @since 4.8.0.0
+instance Applicative Sum where
+    pure     = Sum
+    (<*>)    = coerce
+
+-- | @since 4.8.0.0
+instance Monad Sum where
+    m >>= k  = k (getSum m)
+
+-- | Monoid under multiplication.
+--
+-- >>> getProduct (Product 3 <> Product 4 <> mempty)
+-- 12
+newtype Product a = Product { getProduct :: a }
+        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
+
+-- | @since 4.9.0.0
+instance Num a => Semigroup (Product a) where
+        (<>) = coerce ((*) :: a -> a -> a)
+        stimes n (Product a) = Product (a ^ n)
+
+
+-- | @since 2.01
+instance Num a => Monoid (Product a) where
+        mempty = Product 1
+
+-- | @since 4.8.0.0
+instance Functor Product where
+    fmap     = coerce
+
+-- | @since 4.8.0.0
+instance Applicative Product where
+    pure     = Product
+    (<*>)    = coerce
+
+-- | @since 4.8.0.0
+instance Monad Product where
+    m >>= k  = k (getProduct m)
+
+
+-- | Monoid under '<|>'.
+--
+-- @since 4.8.0.0
+newtype Alt f a = Alt {getAlt :: f a}
+  deriving (Generic, Generic1, Read, Show, Eq, Ord, Num, Enum,
+            Monad, MonadPlus, Applicative, Alternative, Functor)
+
+-- | @since 4.9.0.0
+instance Alternative f => Semigroup (Alt f a) where
+    (<>) = coerce ((<|>) :: f a -> f a -> f a)
+    stimes = stimesMonoid
+
+-- | @since 4.8.0.0
+instance Alternative f => Monoid (Alt f a) where
+    mempty = Alt empty
diff --git a/libraries/base/Data/Semigroup/Internal.hs-boot b/libraries/base/Data/Semigroup/Internal.hs-boot
new file mode 100644 (file)
index 0000000..645a088
--- /dev/null
@@ -0,0 +1,12 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Data.Semigroup.Internal where
+
+import {-# SOURCE #-} GHC.Real (Integral)
+import {-# SOURCE #-} GHC.Base (Semigroup,Monoid,Maybe)
+
+stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a
+
+stimesDefault :: (Integral b, Semigroup a) => b -> a -> a
+stimesMaybe :: (Integral b, Semigroup a) => b -> Maybe a -> Maybe a
+stimesList :: Integral b => b -> [a] -> [a]
index d7fa179..ed3cfbc 100644 (file)
@@ -28,6 +28,7 @@ import Control.Exception
 import Data.Data
 import Data.Ix
 import GHC.Generics
+import Data.Semigroup (Semigroup(..), stimesIdempotent)
 
 -- | Uninhabited data type
 --
@@ -64,6 +65,11 @@ instance Ix Void where
 -- | @since 4.8.0.0
 instance Exception Void
 
+-- | @since 4.9.0.0
+instance Semigroup Void where
+    a <> _ = a
+    stimes = stimesIdempotent
+
 -- | Since 'Void' values logically don't exist, this witnesses the
 -- logical reasoning tool of \"ex falso quodlibet\".
 --
index 96f2d64..82b99a8 100644 (file)
@@ -129,6 +129,14 @@ import {-# SOURCE #-} GHC.IO (failIO,mplusIO)
 import GHC.Tuple ()     -- Note [Depend on GHC.Tuple]
 import GHC.Integer ()   -- Note [Depend on GHC.Integer]
 
+-- for 'class Semigroup'
+import {-# SOURCE #-} GHC.Real (Integral)
+import {-# SOURCE #-} Data.Semigroup.Internal ( stimesDefault
+                                              , stimesMaybe
+                                              , stimesList
+                                              , stimesIdempotentMonoid
+                                              )
+
 infixr 9  .
 infixr 5  ++
 infixl 4  <$
@@ -204,16 +212,53 @@ foldr = errorWithoutStackTrace "urk"
 data  Maybe a  =  Nothing | Just a
   deriving (Eq, Ord)
 
+infixr 6 <>
+
+-- | The class of semigroups (types with an associative binary operation).
+--
+-- Instances should satisfy the associativity law:
+--
+--  * @x '<>' (y '<>' z) = (x '<>' y) '<>' z@
+--
+-- @since 4.9.0.0
+class Semigroup a where
+        -- | An associative operation.
+        (<>) :: a -> a -> a
+
+        -- | Reduce a non-empty list with @\<\>@
+        --
+        -- The default definition should be sufficient, but this can be
+        -- overridden for efficiency.
+        --
+        sconcat :: NonEmpty a -> a
+        sconcat (a :| as) = go a as where
+          go b (c:cs) = b <> go c cs
+          go b []     = b
+
+        -- | Repeat a value @n@ times.
+        --
+        -- Given that this works on a 'Semigroup' it is allowed to fail if
+        -- you request 0 or fewer repetitions, and the default definition
+        -- will do so.
+        --
+        -- By making this a member of the class, idempotent semigroups
+        -- and monoids can upgrade this to execute in /O(1)/ by
+        -- picking @stimes = 'stimesIdempotent'@ or @stimes =
+        -- 'stimesIdempotentMonoid'@ respectively.
+        stimes :: Integral b => b -> a -> a
+        stimes = stimesDefault
+
+
 -- | The class of monoids (types with an associative binary operation that
 -- has an identity).  Instances should satisfy the following laws:
 --
---  * @'mappend' 'mempty' x = x@
+--  * @x '<>' 'mempty' = x@
 --
---  * @'mappend' x 'mempty' = x@
+--  * @'mempty' '<>' x = x@
 --
---  * @'mappend' x ('mappend' y z) = 'mappend' ('mappend' x y) z@
+--  * @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ ('Semigroup' law)
 --
---  * @'mconcat' = 'foldr' 'mappend' 'mempty'@
+--  * @'mconcat' = 'foldr' '(<>)' 'mempty'@
 --
 -- The method names refer to the monoid of lists under concatenation,
 -- but there are many other instances.
@@ -222,27 +267,39 @@ data  Maybe a  =  Nothing | Just a
 -- e.g. both addition and multiplication on numbers.
 -- In such cases we often define @newtype@s and make those instances
 -- of 'Monoid', e.g. 'Sum' and 'Product'.
-
-class Monoid a where
+--
+-- __NOTE__: 'Semigroup' is a superclass of 'Monoid' since /base-4.11.0.0/.
+class Semigroup a => Monoid a where
+        -- | Identity of 'mappend'
         mempty  :: a
-        -- ^ Identity of 'mappend'
+
+        -- | An associative operation
+        --
+        -- __NOTE__: This method is redundant and has the default
+        -- implementation @'mappend' = '(<>)'@ since /base-4.11.0.0/.
         mappend :: a -> a -> a
-        -- ^ An associative operation
-        mconcat :: [a] -> a
+        mappend = (<>)
+        {-# INLINE mappend #-}
 
-        -- ^ Fold a list using the monoid.
+        -- | Fold a list using the monoid.
+        --
         -- For most types, the default definition for 'mconcat' will be
         -- used, but the function is included in the class definition so
         -- that an optimized version can be provided for specific types.
-
+        mconcat :: [a] -> a
         mconcat = foldr mappend mempty
 
+-- | @since 4.9.0.0
+instance Semigroup [a] where
+        (<>) = (++)
+        {-# INLINE (<>) #-}
+
+        stimes = stimesList
+
 -- | @since 2.01
 instance Monoid [a] where
         {-# INLINE mempty #-}
         mempty  = []
-        {-# INLINE mappend #-}
-        mappend = (++)
         {-# INLINE mconcat #-}
         mconcat xss = [x | xs <- xss, x <- xs]
 -- See Note: [List comprehensions and inlining]
@@ -266,52 +323,92 @@ needed to make foldr/build forms efficient are turned off, we'll get reasonably
 efficient translations anyway.
 -}
 
+-- | @since 4.9.0.0
+instance Semigroup (NonEmpty a) where
+        (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs)
+
+-- | @since 4.9.0.0
+instance Semigroup b => Semigroup (a -> b) where
+        f <> g = \x -> f x <> g x
+        stimes n f e = stimes n (f e)
+
 -- | @since 2.01
 instance Monoid b => Monoid (a -> b) where
         mempty _ = mempty
-        mappend f g x = f x `mappend` g x
+
+-- | @since 4.9.0.0
+instance Semigroup () where
+        _ <> _      = ()
+        sconcat _   = ()
+        stimes  _ _ = ()
 
 -- | @since 2.01
 instance Monoid () where
         -- Should it be strict?
         mempty        = ()
-        _ `mappend` _ = ()
         mconcat _     = ()
 
+-- | @since 4.9.0.0
+instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
+        (a,b) <> (a',b') = (a<>a',b<>b')
+        stimes n (a,b) = (stimes n a, stimes n b)
+
 -- | @since 2.01
 instance (Monoid a, Monoid b) => Monoid (a,b) where
         mempty = (mempty, mempty)
-        (a1,b1) `mappend` (a2,b2) =
-                (a1 `mappend` a2, b1 `mappend` b2)
+
+-- | @since 4.9.0.0
+instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where
+        (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c')
+        stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c)
 
 -- | @since 2.01
 instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where
         mempty = (mempty, mempty, mempty)
-        (a1,b1,c1) `mappend` (a2,b2,c2) =
-                (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)
+
+-- | @since 4.9.0.0
+instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d)
+         => Semigroup (a, b, c, d) where
+        (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d')
+        stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d)
 
 -- | @since 2.01
 instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where
         mempty = (mempty, mempty, mempty, mempty)
-        (a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) =
-                (a1 `mappend` a2, b1 `mappend` b2,
-                 c1 `mappend` c2, d1 `mappend` d2)
+
+-- | @since 4.9.0.0
+instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e)
+         => Semigroup (a, b, c, d, e) where
+        (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')
+        stimes n (a,b,c,d,e) =
+            (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e)
 
 -- | @since 2.01
 instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>
                 Monoid (a,b,c,d,e) where
         mempty = (mempty, mempty, mempty, mempty, mempty)
-        (a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) =
-                (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2,
-                 d1 `mappend` d2, e1 `mappend` e2)
+
+
+-- | @since 4.9.0.0
+instance Semigroup Ordering where
+    LT <> _ = LT
+    EQ <> y = y
+    GT <> _ = GT
+
+    stimes = stimesIdempotentMonoid
 
 -- lexicographical ordering
 -- | @since 2.01
 instance Monoid Ordering where
-        mempty         = EQ
-        LT `mappend` _ = LT
-        EQ `mappend` y = y
-        GT `mappend` _ = GT
+    mempty             = EQ
+
+-- | @since 4.9.0.0
+instance Semigroup a => Semigroup (Maybe a) where
+    Nothing <> b       = b
+    a       <> Nothing = a
+    Just a  <> Just b  = Just (a <> b)
+
+    stimes = stimesMaybe
 
 -- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to
 -- <http://en.wikipedia.org/wiki/Monoid>: \"Any semigroup @S@ may be
@@ -322,10 +419,7 @@ instance Monoid Ordering where
 --
 -- @since 2.01
 instance Monoid a => Monoid (Maybe a) where
-  mempty = Nothing
-  Nothing `mappend` m = m
-  m `mappend` Nothing = m
-  Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)
+    mempty = Nothing
 
 -- | For tuples, the 'Monoid' constraint on @a@ determines
 -- how the first values merge.
@@ -337,17 +431,20 @@ instance Monoid a => Monoid (Maybe a) where
 -- @since 2.01
 instance Monoid a => Applicative ((,) a) where
     pure x = (mempty, x)
-    (u, f) <*> (v, x) = (u `mappend` v, f x)
-    liftA2 f (u, x) (v, y) = (u `mappend` v, f x y)
+    (u, f) <*> (v, x) = (u <> v, f x)
+    liftA2 f (u, x) (v, y) = (u <> v, f x y)
 
 -- | @since 4.9.0.0
 instance Monoid a => Monad ((,) a) where
-    (u, a) >>= k = case k a of (v, b) -> (u `mappend` v, b)
+    (u, a) >>= k = case k a of (v, b) -> (u <> v, b)
+
+-- | @since 4.10.0.0
+instance Semigroup a => Semigroup (IO a) where
+    (<>) = liftA2 (<>)
 
 -- | @since 4.9.0.0
 instance Monoid a => Monoid (IO a) where
     mempty = pure mempty
-    mappend = liftA2 mappend
 
 {- | The 'Functor' class is used for types that can be mapped over.
 Instances of 'Functor' should satisfy the following laws:
diff --git a/libraries/base/GHC/Base.hs-boot b/libraries/base/GHC/Base.hs-boot
new file mode 100644 (file)
index 0000000..ca85b49
--- /dev/null
@@ -0,0 +1,10 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.Base where
+
+import GHC.Types ()
+
+class Semigroup a
+class Monoid a
+
+data Maybe a = Nothing | Just a
index 9b8230c..b7befdd 100644 (file)
@@ -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)
diff --git a/libraries/base/GHC/Real.hs-boot b/libraries/base/GHC/Real.hs-boot
new file mode 100644 (file)
index 0000000..b462c1c
--- /dev/null
@@ -0,0 +1,7 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.Real where
+
+import GHC.Types ()
+
+class Integral a
index a245b9f..9f8bb64 100644 (file)
@@ -78,9 +78,12 @@ instance Monad (ST s) where
         (k2 new_s) }})
 
 -- | @since 4.11.0.0
+instance Semigroup a => Semigroup (ST s a) where
+    (<>) = liftA2 (<>)
+
+-- | @since 4.11.0.0
 instance Monoid a => Monoid (ST s a) where
     mempty = pure mempty
-    mappend = liftA2 mappend
 
 data STret s a = STret (State# s) a
 
index 158cc0a..75a0d53 100644 (file)
@@ -66,7 +66,8 @@ module Prelude (
     subtract, even, odd, gcd, lcm, (^), (^^),
     fromIntegral, realToFrac,
 
-    -- ** Monoids
+    -- ** Semigroups and Monoids
+    Semigroup, -- TODO: export (<>)
     Monoid(mempty, mappend, mconcat),
 
     -- ** Monads and functors
index 4bbe2f2..df5efa8 100644 (file)
@@ -317,6 +317,7 @@ Library
         Control.Monad.ST.Lazy.Imp
         Data.Functor.Utils
         Data.OldList
+        Data.Semigroup.Internal
         Data.Typeable.Internal
         Foreign.ForeignPtr.Imp
         GHC.StaticPtr.Internal
index a8915cb..b9b1756 100644 (file)
@@ -8,6 +8,12 @@
   * Add instances `Num`, `Functor`, `Applicative`, `Monad`, `Semigroup`
     and `Monoid` for `Data.Ord.Down` (#13097).
 
+  * Add `Semigroup` instance for `EventLifetime`.
+
+  * Make `Semigroup` a superclass of `Monoid`;
+    export `Semigroup` from `Prelude`; remove `Monoid` reexport
+    from `Data.Semigroup` (#14191).
+
   * Add `infixl 9 !!` declaration for `Data.List.NonEmpty.!!`
 
   * Add `<&>` operator to `Data.Functor` (#14029)
index 357d125..2bba5b3 100644 (file)
@@ -3,5 +3,7 @@
 :t +d length
 let foo :: (Num a, Monoid a) => a -> a; foo = undefined
 :t +d foo
-instance Monoid Double where mempty = 0; mappend = (+)
+import Data.Semigroup
+instance Semigroup Double where (<>) = (+)
+instance Monoid Double where mempty = 0
 :t +d foo
index 6f56a5f..7b630f1 100644 (file)
@@ -21,6 +21,7 @@ instance C () -- Defined at T4175.hs:21:10
 instance Eq () -- Defined in ‘GHC.Classes’
 instance Monoid () -- Defined in ‘GHC.Base’
 instance Ord () -- Defined in ‘GHC.Classes’
+instance Semigroup () -- Defined in ‘GHC.Base’
 instance Show () -- Defined in ‘GHC.Show’
 instance Read () -- Defined in ‘GHC.Read’
 instance Enum () -- Defined in ‘GHC.Enum’
@@ -35,6 +36,8 @@ instance Functor Maybe -- Defined in ‘GHC.Base’
 instance Monad Maybe -- Defined in ‘GHC.Base’
 instance Monoid a => Monoid (Maybe a) -- Defined in ‘GHC.Base’
 instance Ord a => Ord (Maybe a) -- Defined in ‘GHC.Base’
+instance Semigroup a => Semigroup (Maybe a)
+  -- Defined in ‘GHC.Base’
 instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
 instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’
 instance Foldable Maybe -- Defined in ‘Data.Foldable’
index c13a3f3..ff4e670 100644 (file)
@@ -2,6 +2,7 @@ data () = ()    -- Defined in ‘GHC.Tuple’
 instance Eq () -- Defined in ‘GHC.Classes’
 instance Monoid () -- Defined in ‘GHC.Base’
 instance Ord () -- Defined in ‘GHC.Classes’
+instance Semigroup () -- Defined in ‘GHC.Base’
 instance Show () -- Defined in ‘GHC.Show’
 instance Read () -- Defined in ‘GHC.Read’
 instance Enum () -- Defined in ‘GHC.Enum’
@@ -19,6 +20,8 @@ instance Monoid a => Monad ((,) a) -- Defined in ‘GHC.Base’
 instance (Monoid a, Monoid b) => Monoid (a, b)
   -- Defined in ‘GHC.Base’
 instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’
+instance (Semigroup a, Semigroup b) => Semigroup (a, b)
+  -- Defined in ‘GHC.Base’
 instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’
 instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’
 instance Foldable ((,) a) -- Defined in ‘Data.Foldable’
index 3995bc0..873b992 100644 (file)
@@ -4,3 +4,4 @@ instance Applicative ((->) a) -- Defined in ‘GHC.Base’
 instance Functor ((->) r) -- Defined in ‘GHC.Base’
 instance Monad ((->) r) -- Defined in ‘GHC.Base’
 instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’
+instance Semigroup b => Semigroup (a -> b) -- Defined in ‘GHC.Base’
index 18fa4d5..68acea7 100644 (file)
@@ -9,6 +9,8 @@ instance Monoid Data.ByteString.Lazy.ByteString
   -- Defined in ‘Data.ByteString.Lazy.Internal’
 instance Ord Data.ByteString.Lazy.ByteString
   -- Defined in ‘Data.ByteString.Lazy.Internal’
+instance Semigroup Data.ByteString.Lazy.ByteString
+  -- Defined in ‘Data.ByteString.Lazy.Internal’
 instance Show Data.ByteString.Lazy.ByteString
   -- Defined in ‘Data.ByteString.Lazy.Internal’
 instance Read Data.ByteString.Lazy.ByteString
@@ -26,6 +28,8 @@ instance Monoid Data.ByteString.ByteString
   -- Defined in ‘Data.ByteString.Internal’
 instance Ord Data.ByteString.ByteString
   -- Defined in ‘Data.ByteString.Internal’
+instance Semigroup Data.ByteString.ByteString
+  -- Defined in ‘Data.ByteString.Internal’
 instance Show Data.ByteString.ByteString
   -- Defined in ‘Data.ByteString.Internal’
 instance Read Data.ByteString.ByteString
index 372930d..7bd58dc 100644 (file)
@@ -5,6 +5,7 @@ instance Functor [] -- Defined in ‘GHC.Base’
 instance Monad [] -- Defined in ‘GHC.Base’
 instance Monoid [a] -- Defined in ‘GHC.Base’
 instance Ord a => Ord [a] -- Defined in ‘GHC.Classes’
+instance Semigroup [a] -- Defined in ‘GHC.Base’
 instance Show a => Show [a] -- Defined in ‘GHC.Show’
 instance Read a => Read [a] -- Defined in ‘GHC.Read’
 instance Foldable [] -- Defined in ‘Data.Foldable’
@@ -13,6 +14,7 @@ data () = ()  -- Defined in ‘GHC.Tuple’
 instance Eq () -- Defined in ‘GHC.Classes’
 instance Monoid () -- Defined in ‘GHC.Base’
 instance Ord () -- Defined in ‘GHC.Classes’
+instance Semigroup () -- Defined in ‘GHC.Base’
 instance Show () -- Defined in ‘GHC.Show’
 instance Read () -- Defined in ‘GHC.Read’
 instance Enum () -- Defined in ‘GHC.Enum’
@@ -25,6 +27,8 @@ instance Monoid a => Monad ((,) a) -- Defined in ‘GHC.Base’
 instance (Monoid a, Monoid b) => Monoid (a, b)
   -- Defined in ‘GHC.Base’
 instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’
+instance (Semigroup a, Semigroup b) => Semigroup (a, b)
+  -- Defined in ‘GHC.Base’
 instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’
 instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’
 instance Foldable ((,) a) -- Defined in ‘Data.Foldable’
index 3995bc0..873b992 100644 (file)
@@ -4,3 +4,4 @@ instance Applicative ((->) a) -- Defined in ‘GHC.Base’
 instance Functor ((->) r) -- Defined in ‘GHC.Base’
 instance Monad ((->) r) -- Defined in ‘GHC.Base’
 instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’
+instance Semigroup b => Semigroup (a -> b) -- Defined in ‘GHC.Base’
index 3995bc0..873b992 100644 (file)
@@ -4,3 +4,4 @@ instance Applicative ((->) a) -- Defined in ‘GHC.Base’
 instance Functor ((->) r) -- Defined in ‘GHC.Base’
 instance Monad ((->) r) -- Defined in ‘GHC.Base’
 instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’
+instance Semigroup b => Semigroup (a -> b) -- Defined in ‘GHC.Base’
index d309f6c..7227ebf 100644 (file)
@@ -1040,13 +1040,14 @@ test('T12234',
           # initial:      83032768
           # 2017-02-19    89180624 (x64/Windows) - Unknown
           # 2017-02-25    79889200 (x64/Windows) - Early inline patch
-           (wordsize(64), 80245640, 5),
+           (wordsize(64), 81696664, 5),
           # initial:      72958288
           # 2016-01-17:   76848856  (x86-64, Linux. drift?)
           # 2017-02-01:   80882208  (Use superclass instances when solving)
           # 2017-02-05:   74374440  (Probably OccAnal fixes)
           # 2017-02-17:   86525344  (Type-indexed Typeable)
           # 2017-02-25:   83032768  (Early inline patch)
+          # 2017-09-07:   81696664  (Semigroup=>Monoid patch, D3927)
           ]),
      ],
      compile,
index b661edc..9324b72 100644 (file)
@@ -4,6 +4,7 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 import Data.ByteString.Internal (inlinePerformIO)
 import qualified Data.ByteString.Internal as S
+import Data.Semigroup
 import Data.Monoid
 import Foreign
 import System.IO.Unsafe
@@ -12,11 +13,13 @@ newtype Builder = Builder {
         runBuilder :: (Buffer -> [S.ByteString]) -> Buffer -> [S.ByteString]
     }
 
+instance Semigroup Builder where
+    (<>) = append
+    {-# INLINE (<>) #-}
+
 instance Monoid Builder where
     mempty  = empty
     {-# INLINE mempty #-}
-    mappend = append
-    {-# INLINE mappend #-}
     mconcat = foldr mappend mempty
     {-# INLINE mconcat #-}
 
index f093d77..67be60d 100644 (file)
@@ -15,6 +15,7 @@
 module Main where
 import Control.Monad (Monad(..), join, ap)
 import Data.Monoid (Monoid(..))
+import Data.Semigroup (Semigroup(..))
 
 -- First we define the type class Monoidy:
 
@@ -81,9 +82,11 @@ test2 = print (Sum 1 <+> Sum 2 <+> Sum 4)  -- Sum 7
 -- rather cumbersome in actual use. So, we can give traditional Monad and
 -- Monoid instances for instances of Monoidy:
 
+instance Monoidy (→) (,) () m ⇒ Semigroup m where
+  (<>) = curry mjoin
+
 instance Monoidy (→) (,) () m ⇒ Monoid m where
   mempty = munit ()
-  mappend = curry mjoin
 
 instance Applicative Wrapper where
   pure  = return
index 9097e53..365c376 100644 (file)
@@ -14,6 +14,7 @@
 module Main where
 import Control.Monad (Monad(..), join, ap, liftM)
 import Data.Monoid (Monoid(..))
+import Data.Semigroup (Semigroup(..))
 
 -- First we define the type class Monoidy:
 
@@ -91,10 +92,13 @@ test2 = print (Sum 1 <+> Sum 2 <+> Sum 4)  -- Sum 7
 -- rather cumbersome in actual use. So, we can give traditional Monad and
 -- Monoid instances for instances of Monoidy:
 
-instance (MId (→) m ~ (), MComp (→) m ~ (,), Monoidy (→) m) 
+instance (MId (→) m ~ (), MComp (→) m ~ (,), Monoidy (→) m)
+       ⇒ Semigroup m where
+  (<>) = curry mjoin
+
+instance (MId (→) m ~ (), MComp (→) m ~ (,), Monoidy (→) m)
        ⇒ Monoid m where
   mempty = munit ()
-  mappend = curry mjoin
 
 instance Applicative Wrapper where
   pure  = return
index 0d3e7e5..75a6cbc 100644 (file)
@@ -9,9 +9,10 @@ module T7332 where
 
 import GHC.Exts( IsString(..) )
 import Data.Monoid
+import Data.Semigroup
 
 newtype DC d = DC d
-    deriving (Show, Monoid)
+    deriving (Show, Semigroup, Monoid)
 
 instance IsString (DC String) where
     fromString = DC
diff --git a/testsuite/tests/semigroup/Makefile b/testsuite/tests/semigroup/Makefile
deleted file mode 100644 (file)
index 9a36a1c..0000000
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/semigroup/SemigroupWarnings.hs b/testsuite/tests/semigroup/SemigroupWarnings.hs
deleted file mode 100644 (file)
index 83ae2cf..0000000
+++ /dev/null
@@ -1,34 +0,0 @@
--- Test purpose:
--- Ensure that missing semigroup warnings are issued
--- correctly if the warning flag is enabled
-
-{-# OPTIONS_GHC -fwarn-semigroup #-}
-
-module SemigroupWarnings where
-
-
-
-import Data.Semigroup
-
-
-
--- Bad instance, should complain about missing Semigroup parent
-data LacksSemigroup
-instance Monoid LacksSemigroup where
-    mempty = undefined
-    mappend = undefined
-
-
-
--- Correct instance, should not warn
-data HasSemigroup
-instance Semigroup HasSemigroup where
-    (<>) = undefined
-instance Monoid HasSemigroup where
-    mempty = undefined
-    mappend = undefined
-
-
-
--- Should issue a Prelude clash warning
-(<>) = undefined
diff --git a/testsuite/tests/semigroup/SemigroupWarnings.stderr b/testsuite/tests/semigroup/SemigroupWarnings.stderr
deleted file mode 100644 (file)
index 277fea6..0000000
+++ /dev/null
@@ -1,8 +0,0 @@
-
-SemigroupWarnings.hs:17:10: warning: [-Wsemigroup (in -Wcompat)]
-    ‘LacksSemigroup’ is an instance of Monoid but not Semigroup.
-    This will become an error in a future release.
-
-SemigroupWarnings.hs:34:1: warning: [-Wsemigroup (in -Wcompat)]
-    Local definition of ‘<>’ clashes with a future Prelude name.
-    This will become an error in a future release.
diff --git a/testsuite/tests/semigroup/all.T b/testsuite/tests/semigroup/all.T
deleted file mode 100644 (file)
index 0b1c3b9..0000000
+++ /dev/null
@@ -1 +0,0 @@
-test('SemigroupWarnings', normal, compile, [''])
index 6a838cb..718f265 100644 (file)
@@ -5,6 +5,8 @@
 {-# LANGUAGE UndecidableInstances #-}
 module T13429a where -- Orignally FingerTree.hs from the ticket
 
+import Data.Semigroup (Semigroup(..))
+
 class (Monoid v) => Measured v a | a -> v where
     measure :: a -> v
 
@@ -32,9 +34,11 @@ instance Foldable (FingerTree v) where
     foldMap f (Deep _ pr m sf) =
         foldMap f pr `mappend` foldMap (foldMap f) m `mappend` foldMap f sf
 
+instance Measured v a => Semigroup (FingerTree v a) where
+    (<>) = (><)
+
 instance Measured v a => Monoid (FingerTree v a) where
     mempty = empty
-    mappend = (><)
 
 empty :: Measured v a => FingerTree v a
 empty = Empty
index 2fe9f29..33e81c7 100644 (file)
@@ -1,5 +1,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 
+import Prelude hiding (Semigroup(..))
+
 {-
 [Summary of the program] Ring is defined as a subclass of Semigroup,
 inheriting multiplication.  Additive is a wrapper that extracts the additive
index 64a19e5..707e153 100644 (file)
@@ -21,6 +21,6 @@ newtype S = S Int
 instance Semi.Semigroup S where
   (<>) = mappend
 
-instance Semi.Monoid S where
+instance Monoid S where
   S a `mappend` S b = S (a+b)
   mempty = S 0
index 6ed25f1..777c11c 100644 (file)
@@ -21,6 +21,6 @@ newtype S = S Int
 instance Semi.Semigroup S where
   (<>) = mappend
 
-instance Semi.Monoid S where
+instance Monoid S where
   S a `mappend` S b = S (a+b)
   mempty = S 0
index c155f37..6d67ed0 100644 (file)
@@ -21,6 +21,6 @@ newtype S = S Int
 instance Semi.Semigroup S where
   (<>) = mappend
 
-instance Semi.Monoid S where
+instance Monoid S where
   S a `mappend` S b = S (a+b)
   mempty = S 0
index 571a241..c62780f 100644 (file)
@@ -26,7 +26,7 @@ WCompatWarningsOn.hs:16:1: warning: [-Wsemigroup (in -Wcompat)]
 
 WCompatWarningsOn.hs:22:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)]
     Noncanonical ‘(<>) = mappend’ definition detected
-    in the instance declaration for ‘Semi.Semigroup S’.
+    in the instance declaration for ‘Semigroup S’.
     Move definition from ‘mappend’ to ‘(<>)’
 
 WCompatWarningsOn.hs:25:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)]
index 44f554e..e6a4aa3 100644 (file)
@@ -21,6 +21,6 @@ newtype S = S Int
 instance Semi.Semigroup S where
   (<>) = mappend
 
-instance Semi.Monoid S where
+instance Monoid S where
   S a `mappend` S b = S (a+b)
   mempty = S 0