I am trying to write an event driven application in Haskell, to run under Hugs. The following is an extract ... -- just define any sort of handling process (Key a b) = putChar 'a' process (Button a b c) = putChar 'a' process (MouseMove a) = putChar 'a' process (Resize) = putChar 'a' Now I check the type of the following ... process :: Event -> IO () getEvent :: Window -> IO Event openWindow "a" (100,100) :: IO Window So I try ... (openWindow "a" (100,100)) >>= getEvent >>= process And get the following error ... ERROR - Type error in application *** Expression : openWindow "a" (100,100) >>= getEvent >>= process *** Term : openWindow "a" (100,100) >>= getEvent *** Type : IO Event *** Does not match : IO Event Say what? I suspect, perhaps a compatability problem, since I detect the presence of two different versions of getEvent, one of type Window -> IO Event, and the other of type Events -> IO Event. But I can't figure out the right configuration, and that error message makes no sense to me. I even went and got a cup of coffee ... but I still get the same error message. <sigh> Regards, Bruce (IIMS/CS Massey at Albany).
b.i.mills@massey.ac.nz writes: : | ERROR - Type error in application | *** Expression : openWindow "a" (100,100) >>= getEvent >>= process | *** Term : openWindow "a" (100,100) >>= getEvent | *** Type : IO Event | *** Does not match : IO Event Could they have been imported from different modules? Some graphics libraries do things like this: module Bar where import qualified Foo data Event = ... something involving Foo.Event ... ... meaning that there are two incompatible Event types around, which will look the same in error messages which don't show fully qualified names. Regards, Tom
That would be my guess too. Use ":set +Q" to
have the interpreter qualify names when printing.
--sigbjorn
----- Original Message -----
From: "Tom Pledger"
b.i.mills@massey.ac.nz writes: : | ERROR - Type error in application | *** Expression : openWindow "a" (100,100) >>= getEvent >>= process | *** Term : openWindow "a" (100,100) >>= getEvent | *** Type : IO Event | *** Does not match : IO Event
Could they have been imported from different modules?
Some graphics libraries do things like this:
module Bar where import qualified Foo data Event = ... something involving Foo.Event ... ...
meaning that there are two incompatible Event types around, which will look the same in error messages which don't show fully qualified names.
Regards, Tom
participants (3)
-
b.i.mills@massey.ac.nz -
Sigbjorn Finne -
Tom Pledger