[Git][ghc/ghc][master] Improve documentation of Semigroup & Monoid
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Aug 2 10:06:51 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
fa4e5913 by Jade at 2023-08-02T06:06:03-04:00
Improve documentation of Semigroup & Monoid
This commit aims to improve the documentation of various symbols
exported from Data.Semigroup and Data.Monoid
- - - - -
4 changed files:
- libraries/base/Data/Monoid.hs
- libraries/base/Data/Semigroup.hs
- libraries/base/Data/Semigroup/Internal.hs
- libraries/base/GHC/Base.hs
Changes:
=====================================
libraries/base/Data/Monoid.hs
=====================================
@@ -127,14 +127,18 @@ import Data.Semigroup.Internal
-- @'First' a@ is isomorphic to @'Alt' 'Maybe' a@, but precedes it
-- historically.
--
--- >>> getFirst (First (Just "hello") <> First Nothing <> First (Just "world"))
--- Just "hello"
---
-- Beware that @Data.Monoid.@'First' is different from
-- @Data.Semigroup.@'Data.Semigroup.First'. The former returns the first non-'Nothing',
-- so @Data.Monoid.First Nothing <> x = x at . The latter simply returns the first value,
-- thus @Data.Semigroup.First Nothing <> x = Data.Semigroup.First Nothing at .
--
+-- ==== __Examples__
+--
+-- >>> First (Just "hello") <> First Nothing <> First (Just "world")
+-- First {getFirst = Just "hello"}
+--
+-- >>> First Nothing <> mempty
+-- First {getFirst = Nothing}
newtype First a = First { getFirst :: Maybe a }
deriving ( Eq -- ^ @since 2.01
, Ord -- ^ @since 2.01
@@ -162,14 +166,17 @@ instance Monoid (First a) where
-- @'Last' a@ is isomorphic to @'Dual' ('First' a)@, and thus to
-- @'Dual' ('Alt' 'Maybe' a)@
--
--- >>> getLast (Last (Just "hello") <> Last Nothing <> Last (Just "world"))
--- Just "world"
---
--- Beware that @Data.Monoid.@'Last' is different from
-- @Data.Semigroup.@'Data.Semigroup.Last'. The former returns the last non-'Nothing',
-- so @x <> Data.Monoid.Last Nothing = x at . The latter simply returns the last value,
-- thus @x <> Data.Semigroup.Last Nothing = Data.Semigroup.Last Nothing at .
--
+-- ==== __Examples__
+--
+-- >>> Last (Just "hello") <> Last Nothing <> Last (Just "world")
+-- Last {getLast = Just "world"}
+--
+-- >>> Last Nothing <> mempty
+-- Last {getLast = Nothing}
newtype Last a = Last { getLast :: Maybe a }
deriving ( Eq -- ^ @since 2.01
, Ord -- ^ @since 2.01
@@ -195,6 +202,14 @@ instance Monoid (Last a) where
-- | This data type witnesses the lifting of a 'Monoid' into an
-- 'Applicative' pointwise.
--
+-- ==== __Examples__
+--
+-- >>> Ap (Just [1, 2, 3]) <> Ap Nothing
+-- Ap {getAp = Nothing}
+--
+-- >>> Ap [Sum 10, Sum 20] <> Ap [Sum 1, Sum 2]
+-- Ap {getAp = [Sum {getSum = 11},Sum {getSum = 12},Sum {getSum = 21},Sum {getSum = 22}]}
+--
-- @since 4.12.0.0
newtype Ap f a = Ap { getAp :: f a }
deriving ( Alternative -- ^ @since 4.12.0.0
=====================================
libraries/base/Data/Semigroup.hs
=====================================
@@ -26,6 +26,7 @@
--
-- 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}
--
@@ -48,6 +49,7 @@
--
-- >>> sconcat (1 :| [2, 3, 4]) :: Min Int
-- Min {getMin = 1}
+--
-- >>> sconcat (1 :| [2, 3, 4]) :: Max Int
-- Max {getMax = 4}
--
@@ -120,28 +122,56 @@ import qualified GHC.List as List
-- | A generalization of 'Data.List.cycle' to an arbitrary 'Semigroup'.
-- May fail to terminate for some values in some semigroups.
+--
+-- ==== __Examples__
+--
+-- >>> take 10 $ cycle1 [1, 2, 3]
+-- [1,2,3,1,2,3,1,2,3,1]
+--
+-- >>> cycle1 (Right 1)
+-- Right 1
+--
+-- >>> cycle1 (Left 1)
+-- * hangs forever *
cycle1 :: Semigroup m => m -> m
cycle1 xs = xs' where xs' = xs <> xs'
-- | This lets you use a difference list of a 'Semigroup' as a 'Monoid'.
--
--- === __Example:__
--- >>> let hello = diff "Hello, "
+-- ==== __Examples__
+--
+-- > let hello = diff "Hello, "
+--
-- >>> appEndo hello "World!"
-- "Hello, World!"
+--
-- >>> appEndo (hello <> mempty) "World!"
-- "Hello, World!"
+--
-- >>> appEndo (mempty <> hello) "World!"
-- "Hello, World!"
--- >>> let world = diff "World"
--- >>> let excl = diff "!"
+--
+-- > let world = diff "World"
+-- > let excl = diff "!"
+--
-- >>> appEndo (hello <> (world <> excl)) mempty
-- "Hello, World!"
+--
-- >>> appEndo ((hello <> world) <> excl) mempty
-- "Hello, World!"
diff :: Semigroup m => m -> Endo m
diff = Endo . (<>)
+-- | The 'Min' 'Monoid' and 'Semigroup' always choose the smaller element as
+-- by the 'Ord' instance and 'min' of the contained type.
+--
+-- ==== __Examples__
+--
+-- >>> Min 42 <> Min 3
+-- Min 3
+--
+-- >>> sconcat $ Min 1 :| [ Min n | n <- [2 .. 100]]
+-- Min {getMin = 1}
newtype Min a = Min { getMin :: a }
deriving ( Bounded -- ^ @since 4.9.0.0
, Eq -- ^ @since 4.9.0.0
@@ -217,6 +247,16 @@ instance Num a => Num (Min a) where
signum (Min a) = Min (signum a)
fromInteger = Min . fromInteger
+-- | The 'Max' 'Monoid' and 'Semigroup' always choose the bigger element as
+-- by the 'Ord' instance and 'max' of the contained type.
+--
+-- ==== __Examples__
+--
+-- >>> Max 42 <> Max 3
+-- Max 42
+--
+-- >>> sconcat $ Max 1 :| [ Max n | n <- [2 .. 100]]
+-- Max {getMax = 100}
newtype Max a = Max { getMax :: a }
deriving ( Bounded -- ^ @since 4.9.0.0
, Eq -- ^ @since 4.9.0.0
@@ -294,8 +334,16 @@ 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.
--
+-- ==== __Examples__
+--
-- >>> minimum [ Arg (x * x) x | x <- [-10 .. 10] ]
-- Arg 0 0
+--
+-- >>> maximum [ Arg (-0.2*x^2 + 1.5*x + 1) x | x <- [-10 .. 10] ]
+-- Arg 3.8 4.0
+--
+-- >>> minimum [ Arg (-0.2*x^2 + 1.5*x + 1) x | x <- [-10 .. 10] ]
+-- Arg (-34.0) (-10.0)
data Arg a b = Arg
a
-- ^ The argument used for comparisons in 'Eq' and 'Ord'.
@@ -310,13 +358,23 @@ data Arg a b = Arg
)
-- |
+-- ==== __Examples__
+--
-- >>> Min (Arg 0 ()) <> Min (Arg 1 ())
-- Min {getMin = Arg 0 ()}
+--
+-- >>> minimum [ Arg (length name) name | name <- ["violencia", "lea", "pixie"]]
+-- Arg 3 "lea"
type ArgMin a b = Min (Arg a b)
-- |
+-- ==== __Examples__
+--
-- >>> Max (Arg 0 ()) <> Max (Arg 1 ())
-- Max {getMax = Arg 1 ()}
+--
+-- >>> maximum [ Arg (length name) name | name <- ["violencia", "lea", "pixie"]]
+-- Arg 9 "violencia"
type ArgMax a b = Max (Arg a b)
-- | @since 4.9.0.0
@@ -364,6 +422,13 @@ instance Bitraversable Arg where
-- The latter returns the first non-'Nothing',
-- thus @Data.Monoid.First Nothing <> x = x at .
--
+-- ==== __Examples__
+--
+-- >>> First 0 <> First 10
+-- First 0
+--
+-- >>> sconcat $ First 1 :| [ First n | n <- [2 ..] ]
+-- First 1
newtype First a = First { getFirst :: a }
deriving ( Bounded -- ^ @since 4.9.0.0
, Eq -- ^ @since 4.9.0.0
@@ -427,6 +492,13 @@ instance MonadFix First where
-- The latter returns the last non-'Nothing',
-- thus @x <> Data.Monoid.Last Nothing = x at .
--
+-- ==== __Examples__
+--
+-- >>> Last 0 <> Last 10
+-- Last {getLast = 10}
+--
+-- >>> sconcat $ Last 1 :| [ Last n | n <- [2..]]
+-- Last {getLast = * hangs forever *
newtype Last a = Last { getLast :: a }
deriving ( Bounded -- ^ @since 4.9.0.0
, Eq -- ^ @since 4.9.0.0
@@ -526,7 +598,7 @@ instance Enum a => Enum (WrappedMonoid a) where
--
-- > mtimesDefault n a = a <> a <> ... <> a -- using <> (n-1) times
--
--- In many cases, `stimes 0 a` for a `Monoid` will produce `mempty`.
+-- In many cases, @'stimes' 0 a@ for a `Monoid` will produce `mempty`.
-- However, there are situations when it cannot do so. In particular,
-- the following situation is fairly common:
--
@@ -535,6 +607,7 @@ instance Enum a => Enum (WrappedMonoid a) where
--
-- class Constraint1 a
-- class Constraint1 a => Constraint2 a
+-- @
--
-- @
-- instance Constraint1 a => 'Semigroup' (T a)
@@ -548,6 +621,14 @@ instance Enum a => Enum (WrappedMonoid a) where
-- 'Semigroup' instances, @mtimesDefault@ should be used when the
-- multiplier might be zero. It is implemented using 'stimes' when
-- the multiplier is nonzero and 'mempty' when it is zero.
+--
+-- ==== __Examples__
+--
+-- >>> mtimesDefault 0 "bark"
+-- []
+--
+-- >>> mtimesDefault 3 "meow"
+-- "meowmeowmeow"
mtimesDefault :: (Integral b, Monoid a) => b -> a -> a
mtimesDefault n x
| n == 0 = mempty
=====================================
libraries/base/Data/Semigroup/Internal.hs
=====================================
@@ -39,7 +39,7 @@ stimesIdempotent n x
-- | This is a valid definition of 'stimes' for an idempotent 'Monoid'.
--
--- When @mappend x x = x@, this definition should be preferred, because it
+-- When @x <> x = x@, this definition should be preferred, because it
-- works in \(\mathcal{O}(1)\) rather than \(\mathcal{O}(\log n)\)
stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid n x = case compare n 0 of
@@ -72,10 +72,17 @@ stimesMonoid n x0 = case compare n 0 of
half of y - 1 can be computed as y `quot` 2, optimising subtraction away.
-}
--- | The dual of a 'Monoid', obtained by swapping the arguments of 'mappend'.
+-- | The dual of a 'Monoid', obtained by swapping the arguments of '(<>)'.
+--
+-- > Dual a <> Dual b == Dual (b <> a)
+--
+-- ==== __Examples__
--
--- >>> getDual (mappend (Dual "Hello") (Dual "World"))
--- "WorldHello"
+-- >>> Dual "Hello" <> Dual "World"
+-- Dual {getDual = "WorldHello"}
+--
+-- >>> Dual (Dual "Hello") <> Dual (Dual "World")
+-- Dual {getDual = Dual {getDual = "HelloWorld"}}
newtype Dual a = Dual { getDual :: a }
deriving ( Eq -- ^ @since 2.01
, Ord -- ^ @since 2.01
@@ -110,9 +117,17 @@ instance Monad Dual where
-- | The monoid of endomorphisms under composition.
--
+-- > Endo f <> Endo g == Endo (f . g)
+--
+-- ==== __Examples__
+--
-- >>> let computation = Endo ("Hello, " ++) <> Endo (++ "!")
-- >>> appEndo computation "Haskell"
-- "Hello, Haskell!"
+--
+-- >>> let computation = Endo (*3) <> Endo (+1)
+-- >>> appEndo computation 1
+-- 6
newtype Endo a = Endo { appEndo :: a -> a }
deriving ( Generic -- ^ @since 4.7.0.0
)
@@ -126,13 +141,20 @@ instance Semigroup (Endo a) where
instance Monoid (Endo a) where
mempty = Endo id
--- | Boolean monoid under conjunction ('&&').
+-- | Boolean monoid under conjunction '(&&)'.
+--
+-- > All x <> All y = All (x && y)
+--
+-- ==== __Examples__
+--
+-- >>> All True <> mempty <> All False)
+-- All {getAll = False}
--
--- >>> getAll (All True <> mempty <> All False)
--- False
+-- >>> mconcat (map (\x -> All (even x)) [2,4,6,7,8])
+-- All {getAll = False}
--
--- >>> getAll (mconcat (map (\x -> All (even x)) [2,4,6,7,8]))
--- False
+-- >>> All True <> mempty
+-- All {getAll = True}
newtype All = All { getAll :: Bool }
deriving ( Eq -- ^ @since 2.01
, Ord -- ^ @since 2.01
@@ -151,13 +173,20 @@ instance Semigroup All where
instance Monoid All where
mempty = All True
--- | Boolean monoid under disjunction ('||').
+-- | Boolean monoid under disjunction '(||)'.
--
--- >>> getAny (Any True <> mempty <> Any False)
--- True
+-- > Any x <> Any y = Any (x || y)
--
--- >>> getAny (mconcat (map (\x -> Any (even x)) [2,4,6,7,8]))
--- True
+-- ==== __Examples__
+--
+-- >>> Any True <> mempty <> Any False
+-- Any {getAny = True}
+--
+-- >>> mconcat (map (\x -> Any (even x)) [2,4,6,7,8])
+-- Any {getAny = True}
+--
+-- >>> Any False <> mempty
+-- Any {getAny = False}
newtype Any = Any { getAny :: Bool }
deriving ( Eq -- ^ @since 2.01
, Ord -- ^ @since 2.01
@@ -178,8 +207,15 @@ instance Monoid Any where
-- | Monoid under addition.
--
--- >>> getSum (Sum 1 <> Sum 2 <> mempty)
--- 3
+-- > Sum a <> Sum b = Sum (a + b)
+--
+-- ==== __Examples__
+--
+-- >>> Sum 1 <> Sum 2 <> mempty
+-- Sum {getSum = 3}
+--
+-- >>> mconcat [ Sum n | n <- [3 .. 9]]
+-- Sum {getSum = 42}
newtype Sum a = Sum { getSum :: a }
deriving ( Eq -- ^ @since 2.01
, Ord -- ^ @since 2.01
@@ -219,8 +255,15 @@ instance Monad Sum where
-- | Monoid under multiplication.
--
--- >>> getProduct (Product 3 <> Product 4 <> mempty)
--- 12
+-- > Product x <> Product y == Product (x * y)
+--
+-- ==== __Examples__
+--
+-- >>> Product 3 <> Product 4 <> mempty
+-- Product {getProduct = 12}
+--
+-- >>> mconcat [ Product n | n <- [2 .. 10]]
+-- Product {getProduct = 3628800}
newtype Product a = Product { getProduct :: a }
deriving ( Eq -- ^ @since 2.01
, Ord -- ^ @since 2.01
@@ -262,11 +305,14 @@ instance Monad Product where
-- | Monoid under '<|>'.
--
--- >>> getAlt (Alt (Just 12) <> Alt (Just 24))
--- Just 12
+-- > Alt l <> Alt r == Alt (l <|> r)
+--
+-- ==== __Examples__
+-- >>> Alt (Just 12) <> Alt (Just 24)
+-- Alt {getAlt = Just 12}
--
--- >>> getAlt $ Alt Nothing <> Alt (Just 24)
--- Just 24
+-- >>> Alt Nothing <> Alt (Just 24)
+-- Alt {getAlt = Just 24}
--
-- @since 4.8.0.0
newtype Alt f a = Alt {getAlt :: f a}
=====================================
libraries/base/GHC/Base.hs
=====================================
@@ -278,8 +278,16 @@ infixr 6 <>
class Semigroup a where
-- | An associative operation.
--
+ -- ==== __Examples__
+ --
-- >>> [1,2,3] <> [4,5,6]
-- [1,2,3,4,5,6]
+ --
+ -- >>> Just [1, 2, 3] <> Just [4, 5, 6]
+ -- Just [1,2,3,4,5,6]
+ --
+ -- >>> putStr "Hello, " <> putStrLn "World!"
+ -- Hello, World!
(<>) :: a -> a -> a
a <> b = sconcat (a :| [ b ])
@@ -288,9 +296,20 @@ class Semigroup a where
-- The default definition should be sufficient, but this can be
-- overridden for efficiency.
--
+ -- ==== __Examples__
+ --
+ -- For the following examples, we will assume that we have:
+ --
-- >>> import Data.List.NonEmpty (NonEmpty (..))
+ --
-- >>> sconcat $ "Hello" :| [" ", "Haskell", "!"]
-- "Hello Haskell!"
+ --
+ -- >>> sconcat $ Just [1, 2, 3] :| [Nothing, Just [4, 5, 6]]
+ -- Just [1,2,3,4,5,6]
+ --
+ -- >>> sconcat $ Left 1 :| [Right 2, Left 3, Right 4]
+ -- Right 2
sconcat :: NonEmpty a -> a
sconcat (a :| as) = go a as where
go b (c:cs) = b <> go c cs
@@ -298,17 +317,25 @@ class Semigroup a where
-- | 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.
+ -- The default definition will raise an exception for a multiplier that is @<= 0 at .
+ -- This may be overridden with an implementation that is total. For monoids
+ -- it is preferred to use 'stimesMonoid'.
--
-- By making this a member of the class, idempotent semigroups
-- and monoids can upgrade this to execute in \(\mathcal{O}(1)\) by
-- picking @stimes = 'Data.Semigroup.stimesIdempotent'@ or @stimes =
- -- 'stimesIdempotentMonoid'@ respectively.
+ -- 'Data.Semigroup.stimesIdempotentMonoid'@ respectively.
+ --
+ -- ==== __Examples__
--
-- >>> stimes 4 [1]
-- [1,1,1,1]
+ --
+ -- >>> stimes 5 (putStr "hi!")
+ -- hi!hi!hi!hi!hi!
+ --
+ -- >>> stimes 3 (Right ":)")
+ -- Right ":)"
stimes :: Integral b => b -> a -> a
stimes y0 x0
| y0 <= 0 = errorWithoutStackTrace "stimes: positive multiplier expected"
@@ -358,8 +385,12 @@ class Semigroup a where
class Semigroup a => Monoid a where
-- | Identity of 'mappend'
--
+ -- ==== __Examples__
-- >>> "Hello world" <> mempty
-- "Hello world"
+ --
+ -- >>> mempty <> [1, 2, 3]
+ -- [1,2,3]
mempty :: a
mempty = mconcat []
{-# INLINE mempty #-}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa4e5913251786f2b535b31abd3fad39da8b3602
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa4e5913251786f2b535b31abd3fad39da8b3602
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230802/96c9408e/attachment-0001.html>
More information about the ghc-commits
mailing list