[Haskell-cafe] Using classes for a heterogeneous graph structure

Jeremy Bowers jbowers at barracuda.com
Mon Dec 29 11:37:16 EST 2008


I'm trying to use a class to create a heterogeneous graph structure. Part of this involves holding things in a Data.Map identified only as "instances of some class", but then I can't figure out how to actually use these things. What is mystifying me is exemplified in the following code:


-----------------

module Sample where

import qualified Data.Map as Map

class Thing thing where
      set_int :: thing -> Integer -> thing

      -- for wrapper
      wrapper :: thing -> ThingWrapper
      wrapper thing = ThingWrapper thing

instance Thing Integer where
	 set_int me i = i -- in the generic case, this actually does something

type ThingsByString = (Thing thing) => Map.Map Integer thing

update :: Integer -> Integer -> ThingsByString -> ThingsByString
update key value map =
       let (Just thing) = Map.lookup key map
       in Map.insert key (set_int thing value) map

test =
     let my_map = Map.empty::ThingsByString
         map1 = Map.insert 0 1 my_map
         map2 = update 0 8 map1
     in map1

data ThingWrapper = forall t. (Thing t) => ThingWrapper t

instance Thing ThingWrapper where
	 set_int (ThingWrapper thing) i = wrapper $ set_int thing i
	 wrapper thing_wrapper = thing_wrapper

-----------------

This gives an error message (in GHC 6.8 w/ -fglasgow-exts , and yeah, that's deprecated, I'm still in dev):

Sample.hs:27:16:
    Inferred type is less polymorphic than expected
      Quantified type variable `thing' is mentioned in the environment:
        map1 :: Map.Map Integer thing (bound at Sample.hs:26:9)
        my_map :: Map.Map Integer thing (bound at Sample.hs:25:9)
    In the third argument of `update', namely `map1'
    In the expression: update 0 8 map1
    In the definition of `map2': map2 = update 0 8 map1


Now, I sort of understand this message. What I don't understand is how to do what I want to do; I've rearranged things in a number of ways but this comes up every which way. It seems like once I have one of these "things" there's absolutely nothing I can do to it (or absolutely no way to do what update does, which is mutate it using only the defined class interface without ever knowing what's in there). What's annoying is that at least as a human, what I want seems well-defined to me. Moreover, as shown in the code above, I can create a "wrapper" structure, and if I do that and manipulate only the wrapper (not shown in this example), everything works as I'd like. (If that's the answer, that's OK with me, but it seems klunky, wasteful, and amenable to being automatically done by the compiler as I understand it, and I expect there's a reason it isn't.)

My question is: How can I have this heterogeneous graph structure and actually be able to manipulate it solely through a class interface? Or, is it impossible? (I'm open to "you're doing it entirely wrong and you should do X", but in that case I'd like to know what using classes to specify the interface a node should conform to is the wrong thing, because it sure *seems* right, based on what the interface is and how classes are documented. And it would need to work for a heterogeneous graph structure, not my very-simplified example above.)

----------------------------------
Barracuda Networks makes the best spam firewalls and web filters. www.barracudanetworks.com


More information about the Haskell-Cafe mailing list