Re: proposal #4095: add Applicative instance for Either

Ashley Yakeley
I currently have my own implementations for these:
instance Foldable Identity instance Traversable Identity instance Applicative Identity
The transformers package has such instances (but currently for a different Identity type).
instance Foldable (Either p) instance Traversable (Either p) instance Applicative (Either p)
instance Foldable ((,) p) instance Traversable ((,) p)
The Applicative one is proposed here. The others should also be added.

Hello,
Are there any uses of this instance that are not related to error
handing? If not, I would propose that we avoid prolonging the
confusing use of "Either" for error handling and define a separate
type with properly labelled constructors, to be used as "Maybe" but
with multiple reasons for failure.
-Iavor
On Wed, May 26, 2010 at 4:44 AM, Ross Paterson
Ashley Yakeley
writes: I currently have my own implementations for these:
instance Foldable Identity instance Traversable Identity instance Applicative Identity
The transformers package has such instances (but currently for a different Identity type).
instance Foldable (Either p) instance Traversable (Either p) instance Applicative (Either p)
instance Foldable ((,) p) instance Traversable ((,) p)
The Applicative one is proposed here. The others should also be added. _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On Mon, May 31, 2010 at 10:18:11AM -0700, Iavor Diatchki wrote:
Are there any uses of this instance that are not related to error handing? If not, I would propose that we avoid prolonging the confusing use of "Either" for error handling and define a separate type with properly labelled constructors, to be used as "Maybe" but with multiple reasons for failure.
We could do that, but Either would still be there, and the question of what instances it should have would remain. Would it really help to withold the obvious instances?

Oh, I think that Either has its uses. For example, a convenient
function that I use every now and then is:
mapEither :: (a -> Either b c) -> [a] -> ([b],[c])
It is kind of like "mapMaybe" and also like "partition".
The benefit of omitting some instances is that when programmers find
them lacking, they might consider an alternative way to achieve their
goal. In the case of Monad and Either, my feeling is that an
alternative would almost always lead to code which is easier to
understand. Yitzchak's example illustrates just that.
daysInMonth :: Int -> Int -> Int
daysInMonth month year
| month == 2 = if isLeap year then 29 else 28
| month `elem` [4,6,9,11] = 30
| otherwise = 31
-Iavor
On Tue, Jun 1, 2010 at 8:06 AM, Ross Paterson
On Mon, May 31, 2010 at 10:18:11AM -0700, Iavor Diatchki wrote:
Are there any uses of this instance that are not related to error handing? If not, I would propose that we avoid prolonging the confusing use of "Either" for error handling and define a separate type with properly labelled constructors, to be used as "Maybe" but with multiple reasons for failure.
We could do that, but Either would still be there, and the question of what instances it should have would remain. Would it really help to withold the obvious instances? _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

Iavor Diatchki wrote:
Are there any uses of this instance that are not related to error handing?
Yes, in fact, exception handling is a minor corner case. The Either Monad/Applicative provides multi-level exit from nested complex computations. That effect is provided in a much more complicated way by callCC in CPS, but the straightforward way is with Either. Unfortunately, Either is not commonly used in that general way in Haskell because it was hijacked early on by the very unfortunate orphan instance in Control.Monad.Error which imposes a gratuitous superclass condition. Regards, Yitz

On Tue, Jun 1, 2010 at 8:14 AM, Yitzchak Gale
Iavor Diatchki wrote:
Are there any uses of this instance that are not related to error handing?
Yes, in fact, exception handling is a minor corner case.
The Either Monad/Applicative provides multi-level exit from nested complex computations. That effect is provided in a much more complicated way by callCC in CPS, but the straightforward way is with Either.
Can you give a specific example? I'm trying to think of how this is different from the normal exceptional escape mechanism. I use Either as a Maybe + info all the time, but I think you're talking about something more sophisticated here.

I wrote:
The Either Monad/Applicative provides multi-level exit from nested complex computations.
Evan Laforge wrote:
Can you give a specific example? I'm trying to think of how this is different from the normal exceptional escape mechanism. I use Either as a Maybe + info all the time, but I think you're talking about something more sophisticated here.
No something very simple. Here's a contrived example that computes the number of days in a month: daysInMonth :: Int -> Int -> Int daysInMonth month year = either id id $ do when (month `elem` [4,6,9,11]) $ Left 30 when (month == 2) $ do when (year `mod` 4 /= 0) $ Left 28 when (year `mod` 400 == 0) $ Left 29 when (year `mod` 100 == 0) $ Left 28 Left 29 return 31 If the answer becomes known somewhere in the middle of the calculation, Left causes the calculation to exit at that point and return the given answer. If the calculation makes it all the way to the end without exiting, the answer is 31. This is exactly the same way that Either works for exception handling - except we don't require an Error instance for the Left type. Regards, Yitz

Evan Laforge wrote:
Can you give a specific example? I'm trying to think of how this is different from the normal exceptional escape mechanism. I use Either as a Maybe + info all the time, but I think you're talking about something more sophisticated here.
No something very simple.
Here's a contrived example that computes the number of days in a month:
Oh, right, good point. Yeah, that error superclass requirement is grody, you'd have to make an Error Int instance with a bogus noMsg value. Error is there only for Control.Monad.fail, which everyone agrees lives up to it's name, right? I've had to define a number of 'noMsg's, and every time I've picked some random bogus value because there was no appropriate definition, and never actually seen that bogus value pop out, but was always sort of nervous it would come bite me someday. I know this is getting off subject some, but are there are official proposals up to either remove pattern matches on the left side of <-, or treat them like failures in 'let' and throw an error? I've found refutable matches in listcomps very useful, but I've never had a use for them in any other monad, and anyway listcomps are no longer considered just another syntax for monads so they don't need to follow the same rules. I'd be comfortable with refutable matches being a special feature of listcomps and in all other contexts be an error if it let us get rid of 'fail' and 'Error'.
participants (4)
-
Evan Laforge
-
Iavor Diatchki
-
Ross Paterson
-
Yitzchak Gale