The following is independent of whether MonadPlus is moved to the library
or not. Therefore I dare to raise a new issue that is related to monads ...
As I understand it, class Monad now contains fail and the IO monad is no
longer a subclass of Monad. Wouldn't it be nice, then, to add a predicate
At 01:58 -0800 1998/11/09, Simon Peyton-Jones wrote:
>Following many protests, the right thing to do seems
>to be to move MonadPlus to the Monad library. Specifically:
>
> class Monad m => MonadPlus m where
> mzero :: m a
> mplus :: m a -> m a -> m a
It seems me that the
Following many protests, the right thing to do seems
to be to move MonadPlus to the Monad library. Specifically:
class Monad m => MonadPlus m where
mzero :: m a
mplus :: m a -> m a -> m a
filterM :: MonadZero m => (a -> m Bool) -> [a] ->
till there for arbitrary monads, and is now even simpler
because (zero) has been moved from MonadZero to Monad. This is really the
only thing that is hardwired in the language and that you cannot change
yourself. From this point you design your own idealized prelude on top of
what is given by hiding,
>Phil's proposal:
> delete class MonadZero, MonadPlus
> delete filterM, guard, mfilter, concatM
>
>This is ok by me. Does anyone object?
No, not at all. The prelude should be as small as possible.
Erik
> > Yes, nuke MonadPlus. For Haskell 2 we can put these things in a
> > wonderful Monad library.
>
> I had thought that too many functions depend on MonadZero/Plus,
> but actually, it's the following:
>
> filterM :: MonadZero m => (a -> m Bool) -> [a]
> This is ok by me. Does anyone object?
I don't understand why MonadZero/MonadPlus should go away.
Isn't the idea that when in doubt Haskell 98 should do
what Haskell 1.4 did? What's the compelling reason for
removing these classes? I've used several of the functions
| Does this mean that code which relies on ++ and do notation with Maybe
| will stop working?
++ is specialized to lists, I'm afraid.
Ralf
Simon Peyton-Jones wrote:
> Phil's proposal:
> delete class MonadZero, MonadPlus
> delete filterM, guard, mfilter, concatM
>
> This is ok by me. Does anyone object?
>
> Simon
If you're going to do this, are you going to change the Maybe l
| class Monad m => MonadPlus m where
| mzero :: m a
| mplus :: m a -> m a -> m a
|
| Why is this here? It doesn't need to be in the prelude. Just
| leave it for the user to define (and then the user may pick
| better names, like Ringad, zero, and <+>). -- P
Yes, nuke Mon
Philip Wadler wrote:
> class Monad m => MonadPlus m where
> mzero :: m a
> mplus :: m a -> m a -> m a
>
> Why is this here? It doesn't need to be in the prelude. Just
> leave it for the user to define (and then the user may pick
> better names, like Ringad, zero, an
On Fri, 6 Nov 1998, Ralf Hinze wrote:
> | Does this mean that code which relies on ++ and do notation with Maybe
> | will stop working?
> ++ is specialized to lists, I'm afraid.
Ok, then I am officially complaining about the elimination of ++ and
MonadPlus. It is a much more radical change than
> wonderful Monad library.
>
> I had thought that too many functions depend on MonadZero/Plus,
> but actually, it's the following:
>
> filterM :: MonadZero m => (a -> m Bool) -> [a] -> m [a]
> guard :: MonadZero m => Bool -> m ()
> mfilter
class Monad m where
return :: m a
(>>=) :: m a -> (a -> m b) -> m b
(>>) :: m a -> m b -> m b
fail :: String -> m a
fail s = error s
IO.fail becomes IO.ioError
Looks good.
class Monad m => MonadPlus m where
like Ringad, zero, and <+>). -- P
>
> Yes, nuke MonadPlus. For Haskell 2 we can put these things in a
> wonderful Monad library.
I had thought that too many functions depend on MonadZero/Plus,
but actually, it's the following:
filterM :: MonadZero m => (a -> m Bool) -
OK, I think we have enough agreement to decide:
class Monad m where
return :: m a
(>>=) :: m a -> (a -> m b) -> m b
(>>) :: m a -> m b -> m b
fail :: String -> m a
fail s = error s
(I'm still a bit nervous about capturing 'fail' but
>> The names `mzero' and `mfail' are horrible. I like Ralph's suggestion
>> to change `fail' to `raise' in the IO monad, and use `fail' for
>> `mfail'. If that doesn't work, try something else, but please
>> pick names that have a simple meaning in English (as with `return')
>> not monsters like
Hi, it seems to be much too late after all the discussion but among
the alternatives was
> 3. Make tuples special, so that g would be in Monad, but
> if we had a user-defined single-constructor type instead
> then it would be in MonadZero
about which
On 04-Nov-1998, Erik Meijer <[EMAIL PROTECTED]> wrote:
> Let me try to sketch a design methodology for introducing type classes
[...]
> It is good style to define non-overloaded versions of class methods outside
> of the class instead of inlining them in the instance declaration. For
> example the
Simon Peyton-Jones wrote about Phil Wadler's idea:
| Good idea! So your suggestion is:
|
| class Monad m where
| ...return, >>=, >> as before...
|
| mfail :: String -> m a
|
| class MonadPlus m where
| mplus :: m a -> m a -> m a
| mzero :: m
; 2. I havn't been able to think of anything better than these monsters.
um, monadZero, monadFail? People who can't type can always add their
own renamings.
--
Jon Fairbairn [EMAIL PROTECTED]
> Option 1: Monad( .., mfail, mzero ), MonadPlus( mplus )
> Option 2: Monad( .., mfail), MonadPlus( mzero, mplus )
> Option 3: Monad( .., mfail), MonadPlus( mplus ), MonadZero( mzero )
I prefer 3 (with 2 as a close second) since it is most like status quo.
-- Lennart
Option 1: Monad( .., mfail, mzero ), MonadPlus( mplus )
Option 2: Monad( .., mfail), MonadPlus( mzero, mplus )
Option 3: Monad( .., mfail), MonadPlus( mplus ), MonadZero( mzero )
Following Erik's note, I suggest:
Option 4: Monad( (>>=), return, mfail)
The user
; m a
mzero :: m a
I certainly don't object to that, and it has the merit you mention,
namely that people who don't want zero or plus don't need to fuss with
it. Should it still be called MonadPlus? (yes, say I... it's a
Monad plus some extra stuff :)
A thi
Hi fellow debaters,
>I hope you've had fun with all the MonadZero mail.
I surely did.
>My conclusion: we should combine Monad and MonadZero.
>Sorry Erik, but you are now the lone voice in the wilderness.
Don't worry, I am used to that :-)
>Here's a concrete propos
There is no need to have both `mzero' and `mfail' in every monad.
Just have `mfail'. Leave `zero' and `plus' to MonadPlus. This should
make Eric partially happy. It also means one can simply write
instance Monad [] where
...return, >>=, >> as before...
mfail s = [
I'm with the Option 2 Zap MonadZero Today lobby.
I dislike ~ patterns for all sorts of reasons (won't drag up all *that*
again now!) but that the introduction or elimination of a ~ can alter
the *type* of an expression is particularly horrible.
The attempt to introduce notions of
id, some of the proposed type weakenings (unoverloading
> list-comprehensions, junking MonadZero) are partly motived by the fact that
> the type checker gives bad error messages. Well, I rather have bad error
> messages from the type checker than good error messages at run-time! Perl,
>
for it. Clearly, we
should fix that. The treatment of do notation should be handled
as a separate issue.
| As Koen said, some of the proposed type weakenings (unoverloading
| list-comprehensions, junking MonadZero) are partly motived by the fact that
| the type checker gives bad error messages.
ign occurs when
all the links are approximately the same strength.
>[...]
>So the question is, with the rest of Haskell as it is, what choice for
>MonadZero most closely matches the rest of the language?
>
>I am more convinced than ever: nuke MonadZero.
I agree with your your premisses,
| I agree that this is an error that you would like the system to catch.
| I disagree strongly with the suggestion that this is an error that you
| should expect the *type system* to catch.
|
| Suppose that the original version of your nuclear reactor driver also
| contained a definition:
|
|
| I want to make a different plea: keep the language design consistent!
| Yes, the difference between f, g, h is a wart, but let's have one wart
| repeated, rather than two different warts.
I am not convinced. This argument could be reverted to support
alternative 2. Haskell uses patterns in many
| > b) if you add an extra constructor to a single-constructor type
| >then pattern matches on the original constructor suddenly become
| >failable
|
| That is great. I'd rather have this as a static error that getting an
| unexpected pattern match failure in my nuclear reactor device driver:
s renaming of the overloaded monad
operators, MonadZero, etc.) are proposed because they often bite
naive programmers.
A much-heard argument against this is: "make the error messages better".
In the case of MonadZero, I fully agree. If the compiler said:
Type Error:
In functio
' appears (as in all your examples
where MonadZero had to appear in the scope). And you message looks
odd, since the problem is that mzero is undefined. But these are
implementation issues.
I see the attraction of adding `mzero' to Monad. The chief
disadvantage is that it makes the class h
| > 1.Fix up the current version.
| > use MonadZero for do expressions with *irrefutable* patterns
| > (instead of *unfailable* patterns as now)
| > 2.Nuke MonadZero altogether.
| > add mfail :: m a to Monad instead
I opt for 2. It's certainly true that the
Ralf says,
Why should we introduce
concepts (irrefutable, unfailable) only for monad expressions?
`Unfailable' was introduced explicitly for monad expressions, and I
(and many others) agree it should not be introduced just for `do'.
`Irrefutable' is already part of the language, see the Hask
Hi,
>Erik Meijer also spoke up vigorously in defence of MonadZero.
The reason for this is that I want the type-checker to catch as many errors
as possible.
>But the Haskell 1.4 story is unattractive becuase
> a) we have to introduce the (new) concept of unfailable
Compared to m
Simon says,
> Sorry, I don't understand option 2, can you please explain?
* Eliminate MonadZero
* Add 'mfail :: m a' to Monad, with a suitable default decl
* Every do expression has a type in Monad
I must be dense this morning, as I'm still in
| > 1.Fix up the current version.
| > use MonadZero for do expressions with *irrefutable* patterns
| > (instead of *unfailable* patterns as now)
| > 2.Nuke MonadZero altogether.
| > add mfail :: m a to Monad instead
There is another variation on 2 that you d
Simon says,
Here are the two proposals I suggested in
http://research.microsoft.com/Users/simonpj
> 1.Fix up the current version.
> use MonadZero for do expressions with *irrefutable* patterns
> (instead of *unfailable* patterns as now)
> 2.Nu
> * Eliminate MonadZero
> * Add 'mfail :: m a' to Monad, with a suitable default decl
> * Every do expression has a type in Monad
>
> I must be dense this morning, as I'm still in the dark. What is the
> intended meaning of `mfail'?
> > 2.Nuke MonadZero altogether.
> > add mfail :: m a to Monad instead
>
> Sorry, I don't understand option 2, can you please explain?
* Eliminate MonadZero
* Add 'mfail :: m a' to Monad, with a suitable default decl
* Every
Folks,
I'm working on the Haskell 98 report this week, but I'm *still*
not sure what to do about the dreaded MonadZero issue, so this message
has one last go at presenting the issues.
Here are the two proposals I suggested in
http://research.microsoft.com/Users/simonpj
>
Klaus (and the rest of the Haskell mailing list),
1) I was surprised that MonadZero does not contain an operation null to
test for the zero monad. The standard monads (lists and the Maybe type)
and usual data structures (queues, ordered sets, ...) could easily
implement this
Hi Haskell experts,
while waiting for the release of Haskell 1.3 (for my machine), I passed the time
reading the almost finished report. The most interesting part was the new monad
system. Could someone please comment on a few questions relating to the class
MonadZero?
1) I was surprised that
46 matches
Mail list logo