
Hi, I am writing a little IPC system to make Haskell values and functions remotely invokable. To do so, I need (or so I believe) to make my objects accessible via a generic interface as in: class AFun f where afun :: Data a => f -> ([Dynamic] -> a) So my generic object is something that takes an array of parameters, that being Dynamic can be anything, and returns a Data, that I can easily serialise and send back on the wire. I start by defining an instance for functions: instance (Typeable a,AFun b) => AFun (a->b) where afun f (p:ps) = let Just v = fromDynamic p in afun (f v) ps afun _ _ = error "Too few arguments" So far so good, but when I try to define an instance for values: instance Data v => AFun v where afun f [] = f afun _ _ = error "Too many arguments" I get: Couldn't match expected type `a' against inferred type `v' `a' is a rigid type variable bound by the type signature for `afun' at /home/titto/.quid2/state/ubuntu.local.8080/wikidata/haskell/package/haskelld/src/HaskellD/Test.hs:7:17 `v' is a rigid type variable bound by the instance declaration .... Why is that? a and v are both declared to be a Data, why should they not match? The full code follows: {-# LANGUAGE FlexibleInstances ,UndecidableInstances ,OverlappingInstances #-} import Data.Data import Data.Dynamic class AFun f where afun :: Data a => f -> ([Dynamic] -> a) instance (Typeable a,AFun b) => AFun (a->b) where afun f (p:ps) = let Just v = fromDynamic p in afun (f v) ps afun _ _ = error "Too few arguments" instance Data v => AFun v where afun f [] = f afun _ _ = error "Too many arguments" Thanks in advance, titto