
This proposal [1] was originally submitted to Trac by Conal Elliott, but it was apparently abandoned and closed after some time. I've picked it back up and written out a patch. Here is the text of the proposal (including a correction mentioned in the first comment on the ticket):
I'd like to add two instances to Data.Monoid, alongside of All/Any, Sum/Product, and First/Last.
Here's a current instance (as a style example):
-- | Boolean monoid under conjunction. newtype All = All { getAll :: Bool } deriving (Eq, Ord, Read, Show, Bounded)
instance Monoid All where mempty = All True All x `mappend` All y = All (x && y)
My proposed addition:
-- | Ordered monoid under 'max'. newtype Max a = Max { getMax :: a } deriving (Eq, Ord, Read, Show, Bounded)
instance (Ord a, Bounded a) => Monoid (Max a) where mempty = Max minBound Max a `mappend` Max b = Max (a `max` b)
-- | Ordered monoid under 'min'. newtype Min a = Min { getMin :: a } deriving (Eq, Ord, Read, Show, Bounded)
instance (Ord a, Bounded a) => Monoid (Min a) where mempty = Min maxBound Min a `mappend` Min b = Min (a `min` b)
I have a niggling uncertainty about the Ord & Bounded instances for Min a? Is there a reason flip the a ordering instead of preserving it?

On Thu, Sep 23, 2010 at 12:58 PM, Jake McArthur
I think this isn't the right link. It should be http://hackage.haskell.org/trac/ghc/ticket/1952
-- | Ordered monoid under 'max'. newtype Max a = Max { getMax :: a } deriving (Eq, Ord, Read, Show, Bounded)
instance (Ord a, Bounded a) => Monoid (Max a) where mempty = Max minBound Max a `mappend` Max b = Max (a `max` b)
Why should we prefer this monoid over
data Max a = Minimum | Max a deriving (Eq, Ord, Read, Show)
instance Ord a => Monoid (Max a) where mempty = Minimum Minimum `mappend` x = x x `mappend` Minimum = x Max a `mappend` Max b = Max (a `max` b)
Or should we have both variants? Or should we have something like
data AddBounds a = Minimum | This a | Maximum deriving (Eq, Ord, Read, Show)
instance Bounded (AddBounds a) where minBound = Minimum maxBound = Maximum
Cheers! =) -- Felipe.

Felipe Lessa
On Thu, Sep 23, 2010 at 12:58 PM, Jake McArthur
wrote: -- | Ordered monoid under 'max'. newtype Max a = Max { getMax :: a } deriving (Eq, Ord, Read, Show, Bounded)
instance (Ord a, Bounded a) => Monoid (Max a) where mempty = Max minBound Max a `mappend` Max b = Max (a `max` b)
Why should we prefer this monoid over
data Max a = Minimum | Max a deriving (Eq, Ord, Read, Show)
instance Ord a => Monoid (Max a) where mempty = Minimum Minimum `mappend` x = x x `mappend` Minimum = x Max a `mappend` Max b = Max (a `max` b)
You're right, the original wouldn't fly because there are unbounded
types (like Integer) that you'd like to be able to use with Max/Min.
Rather than your proposal I would suggest that Max/Min mirror
the existing First/Last, namely:
newtype Max a = Max { getMax :: Maybe a }
deriving (Eq, Ord, Read, Show)
instance (Ord a) => Monoid (Max a) where
mempty = Max Nothing
mappend = max
G
--
Gregory Collins

I encountered exactly this issue in my use of the Max & Min monoids in
Reactive. I wanted to allow already-bounded types to use their own minBound
for Max and maxBound for Min, and also allow unbounded types to be used.
So, rather than entangling bound addition with Max & Min, I defined
AddBounds type wrapper, which is *orthogonal* to Max & Min. If your type is
already Bounded, then use my simple Max & Min wrappers directly. If not (as
in Reactive's use), compose Max or Min with AddBounds.
I'm sorry I didn't think to mention this useful composition the Max & Min
trac ticket.
- Conal
On Thu, Sep 23, 2010 at 10:47 AM, Gregory Collins
Felipe Lessa
writes: On Thu, Sep 23, 2010 at 12:58 PM, Jake McArthur
wrote: -- | Ordered monoid under 'max'. newtype Max a = Max { getMax :: a } deriving (Eq, Ord, Read, Show, Bounded)
instance (Ord a, Bounded a) => Monoid (Max a) where mempty = Max minBound Max a `mappend` Max b = Max (a `max` b)
Why should we prefer this monoid over
data Max a = Minimum | Max a deriving (Eq, Ord, Read, Show)
instance Ord a => Monoid (Max a) where mempty = Minimum Minimum `mappend` x = x x `mappend` Minimum = x Max a `mappend` Max b = Max (a `max` b)
You're right, the original wouldn't fly because there are unbounded types (like Integer) that you'd like to be able to use with Max/Min.
Rather than your proposal I would suggest that Max/Min mirror the existing First/Last, namely:
newtype Max a = Max { getMax :: Maybe a } deriving (Eq, Ord, Read, Show)
instance (Ord a) => Monoid (Max a) where mempty = Max Nothing mappend = max
G -- Gregory Collins
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

I was trying to avoid offering up color swatches for the bikeshed, but here
are my thoughts:
The use-cases that most often arise are that you either want to:
1.) take the Min or Max of a common Bounded type. These have a nice
analogues in Sum and Product in Data.Monoid now.
2.) take the Min or Max of an unbounded Type, and therefore need to have a
unit added. These have nice analogues in First and Last in the Data.Monoid
now, and reflect the practice of using the equivalent of Maybe to transform
something that is notionally a Semigroup into a Monoid. This is common for
things like priority queues. In fact, using a fingertree as a fair priority
queue is really easy with this monoid. In Data.Monoid.Ord from the monoids
package these are "MinPriority" and "MaxPriority" for that reason. Note that
by adding just a minimum or maximum element these aren't strong enough to be
Bounded, and this is the minimum requirement to really be able to implement
a priority queue with any Ord'ered value as the priority, while handling the
empty queue case gracefully.
On the other hand, composing AddBounds introduces another element on the
other side, which serves as an annihilator when composed with Min and Max.
This is fine for some applications, but I don't believe it subsumes
MinPriority and MaxPriority.
AddBounds is a useful type, but I don't think injecting MinPriority
a/MaxPriority a into the larger Max (AddBounds a) and Min (AddBounds a) is
the right solution.
By that same 'the type is too large' token, I don't like just providing
MinPriority/MaxPriority, since Min and Max are perfectly usable and much
more efficient monoids with a smaller domain.
So in my perfect world the patch would include
Min/Max/MinPriority/MaxPriority and another proposal could find a nice place
to shoehorn AddBounds. ;)
-Edward Kmett
On Thu, Sep 23, 2010 at 2:25 PM, Conal Elliott
I encountered exactly this issue in my use of the Max & Min monoids in Reactive. I wanted to allow already-bounded types to use their own minBound for Max and maxBound for Min, and also allow unbounded types to be used. So, rather than entangling bound addition with Max & Min, I defined AddBounds type wrapper, which is *orthogonal* to Max & Min. If your type is already Bounded, then use my simple Max & Min wrappers directly. If not (as in Reactive's use), compose Max or Min with AddBounds.
I'm sorry I didn't think to mention this useful composition the Max & Min trac ticket.
- Conal
On Thu, Sep 23, 2010 at 10:47 AM, Gregory Collins
wrote:
Felipe Lessa
writes: On Thu, Sep 23, 2010 at 12:58 PM, Jake McArthur < jake.mcarthur@gmail.com> wrote:
-- | Ordered monoid under 'max'. newtype Max a = Max { getMax :: a } deriving (Eq, Ord, Read, Show, Bounded)
instance (Ord a, Bounded a) => Monoid (Max a) where mempty = Max minBound Max a `mappend` Max b = Max (a `max` b)
Why should we prefer this monoid over
data Max a = Minimum | Max a deriving (Eq, Ord, Read, Show)
instance Ord a => Monoid (Max a) where mempty = Minimum Minimum `mappend` x = x x `mappend` Minimum = x Max a `mappend` Max b = Max (a `max` b)
You're right, the original wouldn't fly because there are unbounded types (like Integer) that you'd like to be able to use with Max/Min.
Rather than your proposal I would suggest that Max/Min mirror the existing First/Last, namely:
newtype Max a = Max { getMax :: Maybe a } deriving (Eq, Ord, Read, Show)
instance (Ord a) => Monoid (Max a) where mempty = Max Nothing mappend = max
G -- Gregory Collins
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On Thu, Sep 23, 2010 at 03:08:48PM -0400, Edward Kmett wrote:
On the other hand, composing AddBounds introduces another element on the other side, which serves as an annihilator when composed with Min and Max. This is fine for some applications, but I don't believe it subsumes MinPriority and MaxPriority.
This extra element at the other end introduced by AddBounds bothers me too. So I agree with the conclusion that we need both versions that add a maximum/minimum, and ones that take it from Bounded. That leaves the question of which variant deserves to be called Max/Min.

That extra bit bothered me, too. One could split AddBound into AddMax and
AddMin. Perhaps better is to fix the problem upstream, splitting Bounded
into WithMin and WithMax.
On Thu, Sep 23, 2010 at 3:46 PM, Ross Paterson
On Thu, Sep 23, 2010 at 03:08:48PM -0400, Edward Kmett wrote:
On the other hand, composing AddBounds introduces another element on the other side, which serves as an annihilator when composed with Min and Max. This is fine for some applications, but I don't believe it subsumes MinPriority and MaxPriority.
This extra element at the other end introduced by AddBounds bothers me too. So I agree with the conclusion that we need both versions that add a maximum/minimum, and ones that take it from Bounded. That leaves the question of which variant deserves to be called Max/Min. _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

The biggest problem with splitting AddBounds is that the result is then not able to be Bounded as it only supplies one bound.
This defeats the purpose of constructing it, because now it cannot be composed with Min/Max.
-Edward
On Sep 23, 2010, at 7:20 PM, Conal Elliott
That extra bit bothered me, too. One could split AddBound into AddMax and AddMin. Perhaps better is to fix the problem upstream, splitting Bounded into WithMin and WithMax.
On Thu, Sep 23, 2010 at 3:46 PM, Ross Paterson
wrote: On Thu, Sep 23, 2010 at 03:08:48PM -0400, Edward Kmett wrote: On the other hand, composing AddBounds introduces another element on the other side, which serves as an annihilator when composed with Min and Max. This is fine for some applications, but I don't believe it subsumes MinPriority and MaxPriority.
This extra element at the other end introduced by AddBounds bothers me too. So I agree with the conclusion that we need both versions that add a maximum/minimum, and ones that take it from Bounded. That leaves the question of which variant deserves to be called Max/Min. _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On Thu, Sep 23, 2010 at 4:46 PM, Edward Kmett
The biggest problem with splitting AddBounds is that the result is then not able to be Bounded as it only supplies one bound.
Right. It would take both applications to be in Bounded.
This defeats the purpose of constructing it, because now it cannot be composed with Min/Max.
Yeah. For using in Min/Max we'd have to have Bounded, which is overkill, or a decomposition of Bounded, which probably makes more sense anyway but has the usual backward-compat issues.
-Edward
On Sep 23, 2010, at 7:20 PM, Conal Elliott
wrote: That extra bit bothered me, too. One could split AddBound into AddMax and AddMin. Perhaps better is to fix the problem upstream, splitting Bounded into WithMin and WithMax.
On Thu, Sep 23, 2010 at 3:46 PM, Ross Paterson <
ross@soi.city.ac.uk> wrote: On Thu, Sep 23, 2010 at 03:08:48PM -0400, Edward Kmett wrote:
On the other hand, composing AddBounds introduces another element on the other side, which serves as an annihilator when composed with Min and Max. This is fine for some applications, but I don't believe it subsumes MinPriority and MaxPriority.
This extra element at the other end introduced by AddBounds bothers me too. So I agree with the conclusion that we need both versions that add a maximum/minimum, and ones that take it from Bounded. That leaves the question of which variant deserves to be called Max/Min. _______________________________________________ Libraries mailing list
Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries http://www.haskell.org/mailman/listinfo/libraries _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On 9/23/10 6:46 PM, Ross Paterson wrote:
On Thu, Sep 23, 2010 at 03:08:48PM -0400, Edward Kmett wrote:
On the other hand, composing AddBounds introduces another element on the other side, which serves as an annihilator when composed with Min and Max. This is fine for some applications, but I don't believe it subsumes MinPriority and MaxPriority.
This extra element at the other end introduced by AddBounds bothers me too. So I agree with the conclusion that we need both versions that add a maximum/minimum, and ones that take it from Bounded. That leaves the question of which variant deserves to be called Max/Min.
For my part, I like the Min/Max being the Bounded Ord one, as in the monoids library. One amendment I'd like to bring up is that I think PriorityMin/PriorityMax should instead be (Priority Min)/(Priority Max), that is, make Priority --or whatever it's called-- take Min/Max as a phantom type argument. This can help to simplify things once you start adding in other ordering variants like newtype Arg Min/Max a b = Arg (Maybe (b,a)) newtype Args Min/Max a b = Args (Maybe (b,[a])) etc. I'm not suggesting that these ones be added to base, but it'd be nice to have a uniform API for handling all the different monoids of ordering. -- Live well, ~wren

If you want a more uniform factoring, then at the risk of further exploding the number of options under consideration, there is an obvious choice: class Semigroup s where sappend :: s -> s -> s -- ^ like how Functor m => Monoid m, you get the obvious 'spiritual but unenforced' Semigroup m => Monoid m newtype Min a = Min a deriving (Eq,Ord,Data,Typeable) instance Ord a => Semigroup (Min a) where Min a `sappend` Min b = Min (a `min` b) instance (Ord a, Bounded a) => Monoid (Min a) where mempty = maxBound mappend = sappend newtype Max a = Max a deriving (Eq,Ord,Data,Typeable) instance Ord a => Semigroup (Max a) where Max a `sappend` Max b = Max (a `max` b) instance (Ord a, Bounded a) => Monoid (Max a) where mempty = minBound mappend = sappend data Unital m = Unit | Semi m deriving (Eq, Data, Typeable) instance Semigroup s => Semigroup (Unital s) Unit `mappend` b = b a `mappend` Unit = a Semi a `mappend` Semi b = Semi (a `sappend` b) instance (Semigroup s) => Monoid (Unital s) where mempty = Unit mappend = sappend With that Min a, Max a, Unital (Min a), Unital (Max b) would all work, and you'd pick up a type that plays the role that the Maybe monoid purports to play, which is the trivial lifting of a semigroup into a monoid by adding an additional unit. A real proposal would probably want to flesh Unital out with a couple more combinators like -- 'maybe' unital :: a -> (m -> a) -> Unital m -> a unital z _ Unit = z unital _ f (Semi a) = f a The only real consequence other than trying to figure out where Semigroup would fit, and fighting the 'added complexity' battle: * MinPriority and MaxPriority can be smart enough to provide a correct Ord instance for the composite. The 'factored' version cannot without other chicanery. Given a blank slate, this would be my favorite option. -Edward On Fri, Sep 24, 2010 at 3:50 AM, wren ng thornton < wren@community.haskell.org> wrote:
On 9/23/10 6:46 PM, Ross Paterson wrote:
On Thu, Sep 23, 2010 at 03:08:48PM -0400, Edward Kmett wrote:
On the other hand, composing AddBounds introduces another element on the other side, which serves as an annihilator when composed with Min and Max. This is fine for some applications, but I don't believe it subsumes MinPriority and MaxPriority.
This extra element at the other end introduced by AddBounds bothers me too. So I agree with the conclusion that we need both versions that add a maximum/minimum, and ones that take it from Bounded. That leaves the question of which variant deserves to be called Max/Min.
For my part, I like the Min/Max being the Bounded Ord one, as in the monoids library.
One amendment I'd like to bring up is that I think PriorityMin/PriorityMax should instead be (Priority Min)/(Priority Max), that is, make Priority --or whatever it's called-- take Min/Max as a phantom type argument. This can help to simplify things once you start adding in other ordering variants like
newtype Arg Min/Max a b = Arg (Maybe (b,a)) newtype Args Min/Max a b = Args (Maybe (b,[a]))
etc. I'm not suggesting that these ones be added to base, but it'd be nice to have a uniform API for handling all the different monoids of ordering.
-- Live well, ~wren
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On Friday 24 September 2010 16:39:21, Edward Kmett wrote:
If you want a more uniform factoring, then at the risk of further exploding the number of options under consideration, there is an obvious choice:
class Semigroup s where sappend :: s -> s -> s
I think mappend was a bad choice of name for the monoid operation, but we're probably now stuck with it. But do we need to continue that naming pattern? Pro: it's like what we have for monoid Con: it's ugly and unintuitive (you don't append numbers if you add or multiply them) What about 'combine'?

Edward Kmett schrieb:
If you want a more uniform factoring, then at the risk of further exploding the number of options under consideration, there is an obvious choice:
class Semigroup s where sappend :: s -> s -> s
-- ^ like how Functor m => Monoid m, you get the obvious 'spiritual but unenforced' Semigroup m => Monoid m
Functor m => Monad m ?

-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 On 9/25/10 13:09 , Henning Thielemann wrote:
Edward Kmett schrieb:
-- ^ like how Functor m => Monoid m, you get the obvious 'spiritual but unenforced' Semigroup m => Monoid m
Functor m => Monad m ?
I was wondering about that. mempty = id, mappend = (.) is as close as I could get.... - -- brandon s. allbery [linux,solaris,freebsd,perl] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH -----BEGIN PGP SIGNATURE----- Version: GnuPG v2.0.10 (Darwin) Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org/ iEYEARECAAYFAkyeY6wACgkQIn7hlCsL25ULGwCgiI9bbafrY0AsV5NijM5AAJJh V8MAoNLPlC8InRoIB1TM95sBAj3IWWMU =TIyA -----END PGP SIGNATURE-----

On Saturday 25 September 2010 23:03:41, Brandon S Allbery KF8NH wrote:
On 9/25/10 13:09 , Henning Thielemann wrote:
Edward Kmett schrieb:
-- ^ like how Functor m => Monoid m, you get the obvious 'spiritual but unenforced' Semigroup m => Monoid m
Functor m => Monad m ?
I was wondering about that. mempty = id, mappend = (.) is as close as I could get....
Kind mismatch is how far I got.

Yes, typo. =) On Sat, Sep 25, 2010 at 1:09 PM, Henning Thielemann < schlepptop@henning-thielemann.de> wrote:
Edward Kmett schrieb:
If you want a more uniform factoring, then at the risk of further exploding the number of options under consideration, there is an obvious choice:
class Semigroup s where sappend :: s -> s -> s
-- ^ like how Functor m => Monoid m, you get the obvious 'spiritual but unenforced' Semigroup m => Monoid m
Functor m => Monad m ?

I supply both variants in the monoids package. They are both useful.
+1 from me for adding either or both sets.
The only real issue is the bikeshed problem of naming them.
-Edward Kmett
On Sep 23, 2010, at 12:14 PM, Felipe Lessa
On Thu, Sep 23, 2010 at 12:58 PM, Jake McArthur
wrote: I think this isn't the right link. It should be
http://hackage.haskell.org/trac/ghc/ticket/1952
-- | Ordered monoid under 'max'. newtype Max a = Max { getMax :: a } deriving (Eq, Ord, Read, Show, Bounded)
instance (Ord a, Bounded a) => Monoid (Max a) where mempty = Max minBound Max a `mappend` Max b = Max (a `max` b)
Why should we prefer this monoid over
data Max a = Minimum | Max a deriving (Eq, Ord, Read, Show)
instance Ord a => Monoid (Max a) where mempty = Minimum Minimum `mappend` x = x x `mappend` Minimum = x Max a `mappend` Max b = Max (a `max` b)
Or should we have both variants? Or should we have something like
data AddBounds a = Minimum | This a | Maximum deriving (Eq, Ord, Read, Show)
instance Bounded (AddBounds a) where minBound = Minimum maxBound = Maximum
Cheers! =)
-- Felipe. _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On 9/23/10 1:53 PM, Edward Kmett wrote:
I supply both variants in the monoids package. They are both useful.
+1 from me for adding either or both sets.
The only real issue is the bikeshed problem of naming them.
+1 from me too. I'd been meaning to make a proposal too... -- Live well, ~wren

On Thu, 2010-09-23 at 13:14 -0300, Felipe Lessa wrote:
On Thu, Sep 23, 2010 at 12:58 PM, Jake McArthur
wrote: I think this isn't the right link. It should be
http://hackage.haskell.org/trac/ghc/ticket/1952
-- | Ordered monoid under 'max'. newtype Max a = Max { getMax :: a } deriving (Eq, Ord, Read, Show, Bounded)
instance (Ord a, Bounded a) => Monoid (Max a) where mempty = Max minBound Max a `mappend` Max b = Max (a `max` b)
Why should we prefer this monoid over
data Max a = Minimum | Max a deriving (Eq, Ord, Read, Show)
instance Ord a => Monoid (Max a) where mempty = Minimum Minimum `mappend` x = x x `mappend` Minimum = x Max a `mappend` Max b = Max (a `max` b)
Or should we have both variants? Or should we have something like
data AddBounds a = Minimum | This a | Maximum deriving (Eq, Ord, Read, Show)
instance Bounded (AddBounds a) where minBound = Minimum maxBound = Maximum
Cheers! =)
-- Felipe.
The original version: - Uses newtype which would be more efficient - For many practical uses the Min/Max have concrete, 'natural' values - It is analogy to Sum and Product from Data.Monoid - It is simpler to use fromMax :: Max a -> a then fromMax :: Max a -> Maybe a - It shows that the bounded types form a monoid rather then wrappes arbitrary type into monoid Reagrds
participants (11)
-
Brandon S Allbery KF8NH
-
Conal Elliott
-
Daniel Fischer
-
Edward Kmett
-
Felipe Lessa
-
Gregory Collins
-
Henning Thielemann
-
Jake McArthur
-
Maciej Piechotka
-
Ross Paterson
-
wren ng thornton