[Haskell-cafe] does () match with a??
Hector Guilarte
hectorg87 at gmail.com
Wed Jul 7 20:55:26 EDT 2010
Hey everyone,
I'm making a Game Monad for an assignment (yes, homework) . Here's a little
explanation of what I need to do (I can't use anything from Control.Monad.*,
I need to do everything myself):
I need to define my newtype Game and make it's Monad instance
I need to make the function :
runGame :: Game a -- A particular game
-> Int -- Initial amount of lives
-> Maybe (a , Int ) -- Result and remaining lives.
I need to make the instance for this class:
class Monad m = > GameMonad m where
extraLife :: m ()
getLives :: m Int
checkPoint :: m a -> m a
die :: m a
now what I've done (I was inspired by the State Monad)
I defined my Game type as follows:
> newtype Game r = Game { execGame :: Int -> Maybe (r,Int) }
My Monad instance like this:
> instance Monad Game where
> return a = Game $ \r -> Just (a,r)
> m >>= k = Game $ \r -> let x = execGame m r
> in case x of
> Just (a, r') -> execGame (k a) r'
> Nothing -> Nothing
and my GameMonad instance:
> instance GameMonad Game where
> extraLife = Game $ \l -> Just ((),l+1)
> getLives = Game $ \l -> Just (l,l)
> die = do
> n <- getLives
> Game $ \_ -> Just ((),n-1) -- Here's the problem
so, what's bothering me? Look at the type signature of die in the GameMonad
class, it's supposed to return something of type (m a), but I don't know
what to return in that case, and whatever I try to return it doesn't work,
because when I try to compile it says that it couldn't match expected type
'a' against infered type 'whatever' ('whatever' being anything, from (), to
string, or a number). shouldn't 'a' match with anything I put there?
Note that I can't change the signatures because they were giving to me that
way and I already checked with teacher if they were right. (I fixed it
returning Maybe (Maybe a, Int) instead, but I can't change the signature of
the function runGame)
Thanks you,
Hector Guilarte
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20100707/62c8a1f7/attachment.html
More information about the Haskell-Cafe
mailing list