List instance of Alternative: why (++)?

Fiddling around, I found myself wanting: coalesce :: [a] -> [a] -> [a] -- or -- :: (Foldable t) => t a -> t a -> t a coalesce a b = if null a then b else a I expected this to be (<|>) (it is for Maybe!) but instead I find no canonical implementation of it anywhere, and what seems like a useless instance Alternative []. What's the rationale?

The usual intuition behind the list Functor/Applicative/Monad instances are
that they represents non-deterministic values, which can have any of some
list of possible values. In this case, the natural interpretation of <|>
is as a non-deterministic choice of two possible computations. So the list
of possible results would include anything from either computation. Your
implementation, on the other hand, would represent a left-biased choice,
where the right alternative is only used if the left is impossible.
It's hard to look at laws, because there's apparently little agreement on
the proper laws for Alternative. It looks possible that as an Applicative
and Alternative, this would be fine; but the Alternative instance you
propose would work in odd ways with the Monad instance. That is, if f x ==
[] for any x in (non-empty) xs, then something like (xs <|> ys) >>= f would
yield an empty list, while (xs >>= f) <|> (ys >>= f) would not. But, this
isn't a law or anything, you could chalk it up as counter-intuitive, but
not disqualifying.
On Fri, May 5, 2017 at 11:12 PM, Theodore Lief Gannon
Fiddling around, I found myself wanting:
coalesce :: [a] -> [a] -> [a] -- or -- :: (Foldable t) => t a -> t a -> t a coalesce a b = if null a then b else a
I expected this to be (<|>) (it is for Maybe!) but instead I find no canonical implementation of it anywhere, and what seems like a useless instance Alternative []. What's the rationale?
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

The documentation for Alternative describes it as "a monoid over an applicative functor". That makes for the following documented laws for Alternative: x <|> (y <|> z) = (x <|> y) <|> z empty <|> x = x = x <|> empty This makes your coalesce a valid (<|>) if you take empty = [], but as Chris points out it's not as intuitive from the perspective of certain other nice-to-have properties. On 5/6/2017 2:36 AM, Chris Smith wrote:
The usual intuition behind the list Functor/Applicative/Monad instances are that they represents non-deterministic values, which can have any of some list of possible values. In this case, the natural interpretation of <|> is as a non-deterministic choice of two possible computations. So the list of possible results would include anything from either computation. Your implementation, on the other hand, would represent a left-biased choice, where the right alternative is only used if the left is impossible.
It's hard to look at laws, because there's apparently little agreement on the proper laws for Alternative. It looks possible that as an Applicative and Alternative, this would be fine; but the Alternative instance you propose would work in odd ways with the Monad instance. That is, if f x == [] for any x in (non-empty) xs, then something like (xs <|> ys) >>= f would yield an empty list, while (xs >>= f) <|> (ys
= f) would not. But, this isn't a law or anything, you could chalk it up as counter-intuitive, but not disqualifying.
On Fri, May 5, 2017 at 11:12 PM, Theodore Lief Gannon
mailto:tanuki@gmail.com> wrote: Fiddling around, I found myself wanting:
coalesce :: [a] -> [a] -> [a] -- or -- :: (Foldable t) => t a -> t a -> t a coalesce a b = if null a then b else a
I expected this to be (<|>)(it is for Maybe!) but instead I find no canonical implementation of it anywhere, and what seems like a useless instance Alternative []. What's the rationale?
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

It's hard to look at laws, because there's apparently little agreement on the proper laws for Alternative. It looks possible that as an Applicative and Alternative, this would be fine; but the Alternative instance you propose would work in odd ways with the Monad instance. That is, if f x == [] for any x in (non-empty) xs, then something like (xs <|> ys) >>= f would yield an empty list, while (xs >>= f) <|> (ys >>= f) would not. But, this
In this case `(xs >>= f) <|> (ys >>= f)` will also be empty as far as I can see... I'm also trying to make some sense out of this definition of alternative for lists. For `Maybe` we also have a left biased alternative, and despite this I find it quite useful...
isn't a law or anything, you could chalk it up as counter-intuitive, but not disqualifying.
On Fri, May 5, 2017 at 11:12 PM, Theodore Lief Gannon
wrote: Fiddling around, I found myself wanting:
coalesce :: [a] -> [a] -> [a] -- or -- :: (Foldable t) => t a -> t a -> t a coalesce a b = if null a then b else a
I expected this to be (<|>) (it is for Maybe!) but instead I find no canonical implementation of it anywhere, and what seems like a useless instance Alternative []. What's the rationale?
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

My understanding of the proposed instance was that if xs >>= f is [], then
(xs >>= f) | (ys >>= f) would be ys >>= f. That may not necessarily be
empty.
Consider:
f 42 = [42]
f _ = []
xs = [1,2,3]
ys = [42]
On Sun, May 28, 2017 at 12:24 AM, Damian Nadales
It's hard to look at laws, because there's apparently little agreement on the proper laws for Alternative. It looks possible that as an Applicative and Alternative, this would be fine; but the Alternative instance you propose would work in odd ways with the Monad instance. That is, if f x == [] for any x in (non-empty) xs, then something like (xs <|> ys) >>= f would yield an empty list, while (xs >>= f) <|> (ys >>= f) would not. But, this
In this case `(xs >>= f) <|> (ys >>= f)` will also be empty as far as I can see...
I'm also trying to make some sense out of this definition of alternative for lists. For `Maybe` we also have a left biased alternative, and despite this I find it quite useful...
isn't a law or anything, you could chalk it up as counter-intuitive, but not disqualifying.
On Fri, May 5, 2017 at 11:12 PM, Theodore Lief Gannon
wrote: Fiddling around, I found myself wanting:
coalesce :: [a] -> [a] -> [a] -- or -- :: (Foldable t) => t a -> t a -> t a coalesce a b = if null a then b else a
I expected this to be (<|>) (it is for Maybe!) but instead I find no canonical implementation of it anywhere, and what seems like a useless instance Alternative []. What's the rationale?
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

I’ve wanted this before as well. Maybe we should throw a newtype at it?
newtype LeftBiased a = LeftBiased [a]
instance Alternative (LeftBiased a) where
empty = []
[] <|> b = b
a <|> _ = a
newtype RightBiased a = RightBiased [a]
instance Alternative (RightBiased a) where
empty = []
a <|> [] = a
_ <|> b = b
This could be generalised to work on any Foldable, actually, if that’s
desirable. And of course the bikeshed could be a different colour as for
the names.
It’s unfortunate that the instance for Maybe is already biased differently;
I wonder if this instance would be useful, or if it’s already available
somewhere?
newtype Unbiased a = Unbiased (Maybe a)
instance (Monoid m) => Alternative (Unbiased m) where
empty = Nothing
Just a <|> Just b = Just (a <> b)
_ <|> Just b = Just b
Just a <|> _ = Just a
_ <|> _ = Nothing
On Fri, May 5, 2017 at 11:12 PM, Theodore Lief Gannon
Fiddling around, I found myself wanting:
coalesce :: [a] -> [a] -> [a] -- or -- :: (Foldable t) => t a -> t a -> t a coalesce a b = if null a then b else a
I expected this to be (<|>) (it is for Maybe!) but instead I find no canonical implementation of it anywhere, and what seems like a useless instance Alternative []. What's the rationale?
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

D’oh, that’s what I get for writing untested code in an email.
Neutral doesn’t seem necessary since we have “null” in Foldable. I was
thinking more along these lines:
instance (Alternative f, Foldable f) => Alternative (LeftBiased f) where
empty = LeftBiased empty
LeftBiased a <|> LeftBiased b = LeftBiased (if null a then b else a)
Under the assumption that “null empty” always holds. I think using the
Alternative constraint for just “empty” makes sense because LeftBiased and
RightBiased should only differ from the wrapped type in the implementation
of (<|>), but it still seems a little iffy somehow.
To make the wrapping slightly less painful, another good bikeshed colour
would be Pre/Post. (Dunno what you’d call “Unbiased” in that case, though.)
On a related note, I recall there was some discussion a while back about
making a Monoid instance for Map where mappend is “unionWith mappend”
instead of the left-biased “union”. These wrappers could also be used for
that sort of thing, and it’d be nice to have a single standard for them
with all the different use cases fleshed out.
On Sat, May 6, 2017 at 4:19 PM, MarLinn
On 2017-05-07 00:23, Jon Purdy wrote:
I’ve wanted this before as well. Maybe we should throw a newtype at it?
newtype LeftBiased a = LeftBiased [a] instance Alternative (LeftBiased a) where empty = [] [] <|> b = b a <|> _ = a
newtype RightBiased a = RightBiased [a] instance Alternative (RightBiased a) where empty = [] a <|> [] = a _ <|> b = b
You forgot the fun wrapping and unwrapping. But no matter. Let's generalize!
class Neutral a where neutral :: a isNeutral :: a -> Bool
instance Neutral a => Alternative (LeftBiased a) where empty = LeftBiased neutral (LeftBiased a) <|> (LeftBiased b) = LeftBiased $ if isNeutral a then b else a
instance Neutral a => Alternative (RightBiased a) where empty = RightBiased neutral (RightBiased a) <|> (RightBiased b) = RightBiased $ if isNeutral b then a else b
Why?
type AllRight e a = LeftBiased (Either e a) type AnyRight e a = RightBiased (Either e a)
instance Neutral a => Neutral (AllRight e a) where neutral = Right $ LeftBiased neutral isNeutral = fmap isRight
instance Neutral e => Neutral (AnyRight e a) where neutral = Left $ RightBiased neutral isNeutral = fmap isLeft
Is this a bit silly? Yes. My actual goal is to show that these concepts are bigger than they might appear, and how painful all those wrappers are. This is to advertise my language extension from my separate thread. And also because it's silly fun. Mostly that.
newtype Unbiased a = Unbiased (Maybe a) instance (Monoid m) => Alternative (Unbiased m) where empty = Nothing Just a <|> Just b = Just (a <> b) _ <|> Just b = Just b Just a <|> _ = Just a _ <|> _ = Nothing
Mh, that's just liftA2 (<>) a b <|> a <|> b in terms of the regular instance. Now that is easy to generalize – just don't use it for lists. Cheers, MarLinn
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

Where mappend, mplus and <|> and <> are defined, do they (and should they)
always produce the same results?
On Sun, May 7, 2017 at 5:23 PM, Jon Purdy
D’oh, that’s what I get for writing untested code in an email.
Neutral doesn’t seem necessary since we have “null” in Foldable. I was thinking more along these lines:
instance (Alternative f, Foldable f) => Alternative (LeftBiased f) where empty = LeftBiased empty LeftBiased a <|> LeftBiased b = LeftBiased (if null a then b else a)
Under the assumption that “null empty” always holds. I think using the Alternative constraint for just “empty” makes sense because LeftBiased and RightBiased should only differ from the wrapped type in the implementation of (<|>), but it still seems a little iffy somehow.
To make the wrapping slightly less painful, another good bikeshed colour would be Pre/Post. (Dunno what you’d call “Unbiased” in that case, though.)
On a related note, I recall there was some discussion a while back about making a Monoid instance for Map where mappend is “unionWith mappend” instead of the left-biased “union”. These wrappers could also be used for that sort of thing, and it’d be nice to have a single standard for them with all the different use cases fleshed out.
On Sat, May 6, 2017 at 4:19 PM, MarLinn
wrote: On 2017-05-07 00:23, Jon Purdy wrote:
I’ve wanted this before as well. Maybe we should throw a newtype at it?
newtype LeftBiased a = LeftBiased [a] instance Alternative (LeftBiased a) where empty = [] [] <|> b = b a <|> _ = a
newtype RightBiased a = RightBiased [a] instance Alternative (RightBiased a) where empty = [] a <|> [] = a _ <|> b = b
You forgot the fun wrapping and unwrapping. But no matter. Let's generalize!
class Neutral a where neutral :: a isNeutral :: a -> Bool
instance Neutral a => Alternative (LeftBiased a) where empty = LeftBiased neutral (LeftBiased a) <|> (LeftBiased b) = LeftBiased $ if isNeutral a then b else a
instance Neutral a => Alternative (RightBiased a) where empty = RightBiased neutral (RightBiased a) <|> (RightBiased b) = RightBiased $ if isNeutral b then a else b
Why?
type AllRight e a = LeftBiased (Either e a) type AnyRight e a = RightBiased (Either e a)
instance Neutral a => Neutral (AllRight e a) where neutral = Right $ LeftBiased neutral isNeutral = fmap isRight
instance Neutral e => Neutral (AnyRight e a) where neutral = Left $ RightBiased neutral isNeutral = fmap isLeft
Is this a bit silly? Yes. My actual goal is to show that these concepts are bigger than they might appear, and how painful all those wrappers are. This is to advertise my language extension from my separate thread. And also because it's silly fun. Mostly that.
newtype Unbiased a = Unbiased (Maybe a) instance (Monoid m) => Alternative (Unbiased m) where empty = Nothing Just a <|> Just b = Just (a <> b) _ <|> Just b = Just b Just a <|> _ = Just a _ <|> _ = Nothing
Mh, that's just liftA2 (<>) a b <|> a <|> b in terms of the regular instance. Now that is easy to generalize – just don't use it for lists. Cheers, MarLinn
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
participants (7)
-
Chris Smith
-
Clinton Mead
-
Damian Nadales
-
Joe Quinn
-
Jon Purdy
-
MarLinn
-
Theodore Lief Gannon