Re: Proposal: Add First and Last wrappers around Maybe to Data.Monoid

On 3/4/07, David Menendez
Jeffrey Yasskin writes:
I've created http://hackage.haskell.org/trac/ghc/ticket/1189 to suggest adding two Monoid instances around Maybe that, instead of accumulating things like most monoids, just pick the first or last piece of data they see.
Rather than have two wrappers, I say make the a Monoid instance for Maybe using a left-biased choice (like the MonadPlus instance).
Then we would get right-biased choice for free with the Dual wrapper.
That's a reasonable idea, but I chose against it in the proposal because it arbitrarily picks one of the two sensible monoids for Maybe, which I'm worried will confuse users, especially since Haddock doesn't currently provide documentation for instances. Also, (getDual . foldMap (Dual . f)) is less readable than (getLast . foldMap (Last . f)). On the other hand, maybe the usual case is to just want any result, rather than specifically the left-most or right-most one, in which case providing the instance for Maybe directly saves typing. Thanks for the comment, Jeffrey

On Mon, Mar 05, 2007 at 02:11:58PM -0800, Jeffrey Yasskin wrote:
On 3/4/07, David Menendez
wrote: Rather than have two wrappers, I say make the a Monoid instance for Maybe using a left-biased choice (like the MonadPlus instance).
Then we would get right-biased choice for free with the Dual wrapper.
That's a reasonable idea, but I chose against it in the proposal because it arbitrarily picks one of the two sensible monoids for Maybe, which I'm worried will confuse users, especially since Haddock doesn't currently provide documentation for instances.
There is another, combining two Justs using a Monoid instance on the argument. It could be argued that this is an even better candidate for the "obvious" instance on Maybe.

On 06/03/07, Ross Paterson
There is another, combining two Justs using a Monoid instance on the argument. It could be argued that this is an even better candidate for the "obvious" instance on Maybe.
Like this? instance Monoid a => Monoid (Maybe a) where mempty = Nothing Just xs `mappend` Just ys = Just (xs `mappend` ys) _ `mappend` _ = Nothing I was under the impression that such an instance was already in the libraries, but looking at the Haddocks it appears I'm wrong. Indeed, one could write a generic instance: instance (Functor f, FunctorZero f, Monoid a) => Monoid (f a) where mempty = fzero mappend = fmap mappend Assuming a: class FunctorZero f where fzero :: f a -- -David House, dmhouse@gmail.com

On Tue, Mar 06, 2007 at 06:08:02PM +0000, Ross Paterson wrote:
On Mon, Mar 05, 2007 at 02:11:58PM -0800, Jeffrey Yasskin wrote:
On 3/4/07, David Menendez
wrote: Rather than have two wrappers, I say make the a Monoid instance for Maybe using a left-biased choice (like the MonadPlus instance).
Then we would get right-biased choice for free with the Dual wrapper.
That's a reasonable idea, but I chose against it in the proposal because it arbitrarily picks one of the two sensible monoids for Maybe, which I'm worried will confuse users, especially since Haddock doesn't currently provide documentation for instances.
There is another, combining two Justs using a Monoid instance on the argument. It could be argued that this is an even better candidate for the "obvious" instance on Maybe.
This is (by Wikipedia standards) a very important instance - it corresponds to the process of creating a monoid from a semigroup by adjoining an element and defining it to be the identity. Stefan

On 3/6/07, Ross Paterson
There is another, combining two Justs using a Monoid instance on the argument. It could be argued that this is an even better candidate for the "obvious" instance on Maybe.
Good point. I see two instances that satisfy the monoid laws here too: -- | Lift a 'Monoid' into 'Maybe' 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) instance Monoid a => Monoid (Maybe a) where mempty = Just mempty Just m1 `mappend` Just m2 = Just (m1 `mappend` m2) _ `mappend` _ = Nothing David, your instance doesn't satisfy (mempty `mappend` r == r) I think the first instance is more useful. If the list agrees, I'm happy to add it into my patch. Jeffrey

On Mar 6, 2007, at 1:08 PM, Ross Paterson wrote:
On Mon, Mar 05, 2007 at 02:11:58PM -0800, Jeffrey Yasskin wrote:
On 3/4/07, David Menendez
wrote: Rather than have two wrappers, I say make the a Monoid instance for Maybe using a left-biased choice (like the MonadPlus instance).
Then we would get right-biased choice for free with the Dual wrapper.
That's a reasonable idea, but I chose against it in the proposal because it arbitrarily picks one of the two sensible monoids for Maybe, which I'm worried will confuse users, especially since Haddock doesn't currently provide documentation for instances.
There is another, combining two Justs using a Monoid instance on the argument. It could be argued that this is an even better candidate for the "obvious" instance on Maybe.
This counts as my most used function on Maybe not provided by the libraries, ranking up with generalized list merge in my rogue's gallery of frequently-resurrected functions. I use the "imposed identity" version (cf other discussion on this thread), where a single Just argument is carried to the result. The "imposed zero" version is just liftM2 on Maybe (which I pretty much never need; why *do* people find this so useful?). -Jan-Willem Maessen
participants (5)
-
David House
-
Jan-Willem Maessen
-
Jeffrey Yasskin
-
Ross Paterson
-
Stefan O'Rear