[Haskell-cafe] How to implement a source-sink pattern

[Roland Lutz]

Hi!

I'm trying to implement a source-sink type of pattern where there are a 
number of sinks, each connected to exactly one source, and a number of 
sources, each connected to zero or more sinks.  The program consists of 
some modules, each defining their own sources and sinks. To illustrate 
this, here's what this would look like in C:


/* global.h */

struct source {
 	char *state;
 	/* some more fields */
}

struct sink {
 	struct source *source;
 	char *state;
 	/* some more fields */
}

struct sink **get_sinks_for_source(struct source *source);

/* module_a.c */

struct source a_source, another_source;
struct sink foo, bar, baz;

...
 	foo.source = &a_source;
...


Since getting the list of sinks for a source is a common operation, I'd 
probably define some kind of reverse map which is updated when a sink is 
remapped to a new source.

I tried to rebuild this in Haskell, but the result is ridiculously 
complicated.  Since I can't use pointers, I had to define an ordinal type 
class to enumerate the sources and sinks and use this to look up the 
actual data from the world state.  But then I couldn't define the Sink 
type properly as I can't do:

   data SinkInfo = Source a => SinkInfo { sinkSource :: a,
                                          sinkState :: String }

I have to add the source type as a type attribute, leading to a world 
state with as many parameters as there are sinks.  Also, I couldn't figure 
out how to implement a function like

   sinksForSource :: Source a => WorldState p q r -> a -> [Sink b => b]

since the source types won't match the type of the lookup key, and the
sinks can be from different modules.  Now here is the actual code
(comments indicate where I intend to split it into individual files):


{- Global.hs -}

data SourceInfo = SourceInfo { sourceState :: String }

class Eq a => Source a where
     getSourceInfo :: WorldState p q r -> a -> SourceInfo

data SinkInfo a = SinkInfo { sinkSource :: a, sinkState :: String }

class Sink a where
     getSinkInfo :: Source x => WorldState x x x -> a -> SinkInfo x
     -- should allow different arguments to WorldState

{- ModuleA.hs -}

data ModuleASource = ASource | AnotherSource deriving (Eq)

instance Source ModuleASource where
     getSourceInfo world ASource = aSource $ moduleAState world
     getSourceInfo world AnotherSource = anotherSource $ moduleAState world

data ModuleASink = Foo | Bar | Baz

instance Sink ModuleASink where
     getSinkInfo world Foo = foo $ moduleAState world
     getSinkInfo world Bar = bar $ moduleAState world
     getSinkInfo world Baz = baz $ moduleAState world

data ModuleAState p q r = ModuleAState { aSource :: SourceInfo,
                                          anotherSource :: SourceInfo,
                                          foo :: SinkInfo p,
                                          bar :: SinkInfo q,
                                          baz :: SinkInfo r }

sinksForSourceInModuleA :: Source x => ModuleAState x x x -> x -> [ModuleASink]
   -- should allow different arguments to ModuleAState and return Sink b => [b]
sinksForSourceInModuleA (ModuleAState _ _ foo bar baz) source =
     (if sinkSource foo == source then [Foo] else []) ++
     (if sinkSource bar == source then [Bar] else []) ++
     (if sinkSource baz == source then [Baz] else [])

{- Main.hs -}

data WorldState p q r = WorldState { moduleAState :: ModuleAState p q r }

initState :: WorldState ModuleASource ModuleASource ModuleASource
initState = WorldState $ ModuleAState (SourceInfo "a source init state")
                                       (SourceInfo "another source init state")
                                       (SinkInfo ASource "foo init state")
                                       (SinkInfo ASource "bar init state")
                                       (SinkInfo AnotherSource "baz init state")

remapBar :: WorldState p q r -> WorldState p ModuleASource r
remapBar (WorldState a) =
     WorldState $ a { bar = SinkInfo AnotherSource (sinkState $ bar a) }

sinksForSource :: Source x =>
                   WorldState x x x -> x -> [ModuleASink]
   -- should allow different arguments to ModuleAState and return Sink b => [b]
sinksForSource (WorldState a) source = sinksForSourceInModuleA a source

main :: IO ()
main = let before = initState
            after = remapBar before in
        do
            putStrLn $ "Number of sinks for another source before: " ++
                (show $ length $ sinksForSource before AnotherSource)
            putStrLn $ "Number of sinks for another source after: " ++
                (show $ length $ sinksForSource after AnotherSource)


There are some problems with this code:
   * I couldn't figure out how to resolve the circular references which are created by splitting this into individual files.
   * Source and sink ordinals can't be mixed between modules, so I wouldn't be able to add a module B anyway.
   * Looking up the source/sink states by ordinal keys is kind of cumbersome but works.
   * To get the list of sinks connected to a given source, the whole world state has to be polled.  I expect this to be grossly inefficient (unless Haskell does some magic here) but I'm not sure how to add a cache in a consistent way.

I can't believe this should be so complicated in Haskell, so I guess I'm 
trying to do this in an un-Haskell-ish way, or maybe there's something 
obvious I haven't seen.  I'd be happy about any suggestions.

Roland