Dear Brian, Maarten wrote:

Brian Hulley wrote:

Alternatively, you could wrap the custom part within the node as in:

data Node = forall cust. ICustom cust => Node cust Common

getCommon :: Node -> Common getCommon (Node cust com) = com

Thanks. This really helped. The main thing (I think) that you put the custom part behind an interface. After this I separated the custom and common part of two 'piggy bagged' state transformers, so one can access the functionality separately. The state transformers made into active object by putting them behind a channel in a separate thread and one can invoke actions by writing to the channel. The common functionality provides the connections between the active objects. In this way I would like to create some sort of 'agent' structure, that receive message and process them in their own thread. So far this works quite neat. Wonder if this is they way to go though... Only update (see code below) is a bit ugly (I have no idea why I need fixCastUpdate) and Node itself is probably not necessary, so one level of indirection could be removed. Rest is quite straight forward. Thanks again. Maarten ... (imports) data Node = forall cust. (ICustom cust) => Node cust deriving (Typeable) instance Show Node where -- just for debugging show (Node a) = "Node (" ++ show a ++ ")" class (Show a, Typeable a) => ICustom a where getVal :: forall b cust. (Typeable b, ICustom cust) => a -> (cust -> b) -> Maybe b getVal a f = case cast a of Nothing -> Nothing Just cust -> Just (f cust) -- update :: oif -> (forall a. (ObjectIFace a) => a -> a) -> IO oif update :: a -> (forall b. (ICustom b) => b -> b) -> a update a f = f a instance ICustom Node where getVal (Node n) f = getVal n f update (Node n) f = Node (update n f) type NodeState a = StateT Node (StateT Common IO) a type Connection = Chan (NodeState ()) type Connections = [Connection] instance Show Connection where show o = "Chan (StateT Node (StateT Common IO) ())" -- common part data Common = Common { uid::Integer, connections::Connections } deriving (Show,Typeable) -- custom data data Custom = Custom { val::Integer } deriving (Show,Typeable) instance ICustom Custom where data Custom2 = Custom2 { val2::Integer } deriving (Show,Typeable) instance ICustom Custom2 where -- some function to use common functionality uidM :: NodeState Integer uidM = lift $ gets uid addNodeM :: Connection -> NodeState () addNodeM n = lift $ modify (\s -> addNode s n) where addNode (Common i ns) nn = (Common i (nn:ns)) getNodeM :: Integer -> NodeState Connection getNodeM i = do s <- lift $ get return (getNode s i) where getNode (Common _ ns) i = (ns!!(fromInteger i)) getValM f = do s <- get return (getVal s f) updateM :: forall a b. (ICustom a, ICustom b) => (a -> b) -> NodeState () updateM f = do s <- get let s' = update s (fixCastUpdate f) put s' fixCastUpdate f st = case (cast st) of Nothing -> st Just es -> case cast (f es) of Nothing -> st Just g -> g getStateM = get -- function to create active node functionality action [] = return () action (e:es) = do e s <- get -- just for debugging lift $ lift $ putStrLn $ show s action es newBaseState = do uid <- newUnique return (Common ((toInteger .hashUnique) uid) []) initAction list state = do bs <- newBaseState execStateT (execStateT (action list) state) bs return () send chan action = writeChan chan action sync chan f = do mv <- newEmptyMVar send chan (f' mv) a <- takeMVar mv return a where f' mv = do a <- f lift $ lift $ putMVar mv a newActiveObject action state = do chan <- newChan cs <- getChanContents chan forkIO (action cs state) return chan -- example main = do let n1 = Node (Custom 5) let n2 = Node (Custom2 6) let n3 = Node (Custom2 7) chan <- newActiveObject initAction n1 chan2 <- newActiveObject initAction n3 let l = [chan, chan2] mapM_ (\ch -> send ch (addNodeM chan)) l mapM_ (\ch -> send ch (addNodeM chan2)) l r <- mapM (\ch -> sync ch (getNodeM 0)) l putStrLn $ "r:" ++ show r r2 <- mapM (\ch -> sync ch (uidM)) l putStrLn $ "r2:" ++ show r2 r3 <- mapM (\ch -> sync ch (getValM val)) l putStrLn $ "r3:" ++ show r3 mapM_ (\ch -> send ch (updateM (\s -> s { val2 = 100 }))) l r5 <- mapM (\ch -> sync ch (getStateM)) l putStrLn $ "r5:" ++ show r5 getChar return ()