Hey Michael,

If you would look at the type of  >>=, it would give
(>>=) :: (Monad m) => m a -> (a -> m b) -> m b

and specifically in your case:
(>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b

You are applying Just 3 as first argument, which is correct, but then supply a partially applied function (1+) which is of type Num  a => a -> a, while it should be
a -> Maybe b.

What are you expecting as result? You cannot pull something out of a monad using a bind operator. Maybe you meant something like this?
(Just 3) >>= \x -> return (x + 1)
Notice how Just 3 is just the Maybe a argument, and \x -> return (x + 1) is the (a -> Maybe b) argument, finally delivering a Just 4 (of type Maybe b).

(This is the same as do x <- Just 3
                                   return (x + 1)
)


Oh and btw, fail should take an argument (the error string).

Good luck,

Bas van Gijzel

On Sat, May 9, 2009 at 9:31 PM, michael rice <nowgate@yahoo.com> wrote:
Why doesn't this work?

Michael

================

data Maybe a = Nothing | Just a

instance Monad Maybe where
    return         = Just
    fail           = Nothing
    Nothing  >>= f = Nothing
    (Just x) >>= f = f x
    
instance MonadPlus Maybe where
    mzero             = Nothing
    Nothing `mplus` x = x
    x `mplus` _       = x

================

[michael@localhost ~]$ ghci
GHCi, version 6.10.1: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer ... linking ... done.
Loading package base ... linking ... done.
Prelude> Just 3 >>= (1+)

<interactive>:1:0:
    No instance for (Num (Maybe b))
      arising from a use of `it' at <interactive>:1:0-14
    Possible fix: add an instance declaration for (Num (Maybe b))
    In the first argument of `print', namely `it'
    In a stmt of a 'do' expression: print it
Prelude>



_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe