diff options
Diffstat (limited to 'libraries/base/Data/Semigroup.hs')
| -rw-r--r-- | libraries/base/Data/Semigroup.hs | 421 |
1 files changed, 127 insertions, 294 deletions
diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs index fae207ef97..fad1b206c4 100644 --- a/libraries/base/Data/Semigroup.hs +++ b/libraries/base/Data/Semigroup.hs @@ -19,15 +19,52 @@ -- Stability : provisional -- Portability : portable -- --- In mathematics, a semigroup is an algebraic structure consisting of a --- set together with an associative binary operation. A semigroup --- generalizes a monoid in that there might not exist an identity --- element. It also (originally) generalized a group (a monoid with all --- inverses) to a type where every element did not have to have an inverse, --- thus the name semigroup. +-- A type @a@ is a 'Semigroup' if it provides an associative function ('<>') +-- that lets you combine any two values of type @a@ into one. Where being +-- associative means that the following must always hold: -- --- The use of @(\<\>)@ in this module conflicts with an operator with the same --- name that is being exported by Data.Monoid. However, this package +-- >>> (a <> b) <> c == a <> (b <> c) +-- +-- ==== __Examples__ +-- +-- The 'Min' 'Semigroup' instance for 'Int' is defined to always pick the smaller +-- number: +-- >>> Min 1 <> Min 2 <> Min 3 <> Min 4 :: Min Int +-- Min {getMin = 1} +-- +-- If we need to combine multiple values we can use the 'sconcat' function +-- to do so. We need to ensure however that we have at least one value to +-- operate on, since otherwise our result would be undefined. It is for this +-- reason that 'sconcat' uses "Data.List.NonEmpty.NonEmpty" - a list that +-- can never be empty: +-- +-- >>> (1 :| []) +-- 1 :| [] -- equivalent to [1] but guaranteed to be non-empty +-- >>> (1 :| [2, 3, 4]) +-- 1 :| [2,3,4] -- equivalent to [1,2,3,4] but guaranteed to be non-empty +-- +-- Equipped with this guaranteed to be non-empty data structure, we can combine +-- values using 'sconcat' and a 'Semigroup' of our choosing. We can try the 'Min' +-- and 'Max' instances of 'Int' which pick the smallest, or largest number +-- respectively: +-- +-- >>> sconcat (1 :| [2, 3, 4]) :: Min Int +-- Min {getMin = 1} +-- >>> sconcat (1 :| [2, 3, 4]) :: Max Int +-- Max {getMax = 4} +-- +-- String concatenation is another example of a 'Semigroup' instance: +-- +-- >>> "foo" <> "bar" +-- "foobar" +-- +-- A 'Semigroup' is a generalization of a 'Monoid'. Yet unlike the 'Semigroup', the 'Monoid' +-- requires the presence of a neutral element ('mempty') in addition to the associative +-- operator. The requirement for a neutral element prevents many types from being a full Monoid, +-- like "Data.List.NonEmpty.NonEmpty". +-- +-- Note that the use of @(\<\>)@ in this module conflicts with an operator with the same +-- name that is being exported by "Data.Monoid". However, this package -- re-exports (most of) the contents of Data.Monoid, so to use semigroups -- and monoids in the same package just -- @@ -48,7 +85,6 @@ module Data.Semigroup ( , Last(..) , WrappedMonoid(..) -- * Re-exported monoids from Data.Monoid - , Monoid(..) , Dual(..) , Endo(..) , All(..) @@ -69,6 +105,10 @@ 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 @@ -77,261 +117,30 @@ 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) + deriving ( Bounded -- ^ @since 4.9.0.0 + , Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Read -- ^ @since 4.9.0.0 + , Data -- ^ @since 4.9.0.0 + , Generic -- ^ @since 4.9.0.0 + , Generic1 -- ^ @since 4.9.0.0 + ) -- | @since 4.9.0.0 instance Enum a => Enum (Min a) where @@ -353,7 +162,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 @@ -395,7 +203,15 @@ instance Num a => Num (Min a) where fromInteger = Min . fromInteger newtype Max a = Max { getMax :: a } - deriving (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1) + deriving ( Bounded -- ^ @since 4.9.0.0 + , Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Read -- ^ @since 4.9.0.0 + , Data -- ^ @since 4.9.0.0 + , Generic -- ^ @since 4.9.0.0 + , Generic1 -- ^ @since 4.9.0.0 + ) -- | @since 4.9.0.0 instance Enum a => Enum (Max a) where @@ -416,7 +232,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 @@ -460,7 +275,12 @@ instance Num a => Num (Max a) where -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be -- placed inside 'Min' and 'Max' to compute an arg min or arg max. data Arg a b = Arg a b deriving - (Show, Read, Data, Generic, Generic1) + ( Show -- ^ @since 4.9.0.0 + , Read -- ^ @since 4.9.0.0 + , Data -- ^ @since 4.9.0.0 + , Generic -- ^ @since 4.9.0.0 + , Generic1 -- ^ @since 4.9.0.0 + ) type ArgMin a b = Min (Arg a b) type ArgMax a b = Max (Arg a b) @@ -497,7 +317,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 @@ -505,8 +325,16 @@ instance Bitraversable Arg where -- | Use @'Option' ('First' a)@ to get the behavior of -- 'Data.Monoid.First' from "Data.Monoid". -newtype First a = First { getFirst :: a } deriving - (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1) +newtype First a = First { getFirst :: a } + deriving ( Bounded -- ^ @since 4.9.0.0 + , Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Read -- ^ @since 4.9.0.0 + , Data -- ^ @since 4.9.0.0 + , Generic -- ^ @since 4.9.0.0 + , Generic1 -- ^ @since 4.9.0.0 + ) -- | @since 4.9.0.0 instance Enum a => Enum (First a) where @@ -555,8 +383,16 @@ instance MonadFix First where -- | Use @'Option' ('Last' a)@ to get the behavior of -- 'Data.Monoid.Last' from "Data.Monoid" -newtype Last a = Last { getLast :: a } deriving - (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1) +newtype Last a = Last { getLast :: a } + deriving ( Bounded -- ^ @since 4.9.0.0 + , Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Read -- ^ @since 4.9.0.0 + , Data -- ^ @since 4.9.0.0 + , Generic -- ^ @since 4.9.0.0 + , Generic1 -- ^ @since 4.9.0.0 + ) -- | @since 4.9.0.0 instance Enum a => Enum (Last a) where @@ -605,8 +441,19 @@ 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) + deriving ( Bounded -- ^ @since 4.9.0.0 + , Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Read -- ^ @since 4.9.0.0 + , Data -- ^ @since 4.9.0.0 + , Generic -- ^ @since 4.9.0.0 + , Generic1 -- ^ @since 4.9.0.0 + ) -- | @since 4.9.0.0 instance Monoid m => Semigroup (WrappedMonoid m) where @@ -615,7 +462,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 @@ -646,9 +492,21 @@ mtimesDefault n x -- underlying 'Monoid'. -- -- Ideally, this type would not exist at all and we would just fix the --- 'Monoid' instance of 'Maybe' +-- 'Monoid' instance of 'Maybe'. +-- +-- In GHC 8.4 and higher, the 'Monoid' instance for 'Maybe' has been +-- corrected to lift a 'Semigroup' instance instead of a 'Monoid' +-- instance. Consequently, this type is no longer useful. It will be +-- marked deprecated in GHC 8.8 and removed in GHC 8.10. newtype Option a = Option { getOption :: Maybe a } - deriving (Eq, Ord, Show, Read, Data, Generic, Generic1) + deriving ( Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Read -- ^ @since 4.9.0.0 + , Data -- ^ @since 4.9.0.0 + , Generic -- ^ @since 4.9.0.0 + , Generic1 -- ^ @since 4.9.0.0 + ) -- | @since 4.9.0.0 instance Functor Option where @@ -699,40 +557,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 (<>) - -#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 |