[Haskell] ambiguous (partially defined) type problem / active objects

12 Sep 2006

      Dear all,

I'm trying to create active nodes that have a common base part and a 
user definable custom part, run in their own thread and can 
communicate/send message to each other. For some reason the compiler 
complains about an ambiguous type, while I feel, though the type may be 
partially ambiguous, I'm not using that particular part in related 
function calls. So in some ways I think there is nothing to complain. Is 
there a way to resolve this? Are there better/easier solutions to this 
problem?

My solution so far is as follows (see code is below):
The active nodes have different types that have a common base state and 
a changing top state. The base state will be responsible for connection 
nodes to each other, the top state is user defined.
1. I 'piggy-bag' two State transformers (and IO) onto each other, one 
with the base state and one with the custom state
2. In their own thread, the top state transformer processes the contents 
of a list (in which each element is an action) that comes from a channel.
3. The channel is basically the active object and can receive message.
4. Since 'active objects' need to be stored in a list in the base state 
they are wrapped in a general node data structure (GN) that hides the 
type of the active object.

In this way, actions can be fed to the channel and are executed in the 
thread and context of the state monad. One can define a changing 
topstate and add basic functionality to it. This works reasonably well, 
except that when I store a node into another node (using the base 
functionality) and later on retrieve it and then want to apply some 
other suitably typed functions functions using only the base 
functionality, the compiler complains that the type is ambiguous. 
However I feel it shouldn't complain, since the functions doesn't use 
the ambiguous part. Of course the problem is resolved as soon as a 
function establishes the type. However, in many cases I don't know (and 
don't want to know the type). Can this be resolved?

The code below is unfortunately rather long. Of course it doesn't 
compile, unless the last comment is removed. If removed it works fine.

Any comments and pointers appreciated. Thanks. (I'm quite new to 
haskell, so I may be missing some obvious things.)

Maarten

P.S. (Sorry for the long code sample below, but I don't know how to 
condens is into something smaller, while retaining the relevant properties).

{-# OPTIONS -fglasgow-exts -cpp -fallow-undecidable-instances #-}

module Main where

import Data.Generics
import Control.Monad.State

import Data.Unique

import Control.Concurrent (forkIO, forkOS)
import Control.Concurrent.Chan
import Control.Concurrent.MVar

instance Show Unique where
    show a = show (hashUnique a)

-- default node state; same for all states; nodes are active objects 
(see below)
data DefNodeState = DefNodeState { id::Unique,  nodes::ActiveObjects }
    deriving Show

-- make this default state a base state transformer
type BaseStateT m = StateT DefNodeState m
type BaseStateTIO = BaseStateT IO

-- TopStateT with parameterizable state
type TopStateT ts a = StateT ts BaseStateTIO a

instance Show (TopStateT b ()) where
    show a = "TopStateT Monad"

tsTc = mkTyCon "TopStateT"
instance forall ts. (Show ts, Typeable ts) => Typeable1 (StateT ts 
BaseStateTIO) where
    typeOf1 _ = mkTyConApp tsTc []

-- hide top state type so we can put them in a list; typeable so it can 
be cast back
data GN = forall o. (Show o,Typeable o) => GN o

instance Show (GN) where
    show (GN o) = "GN " ++ show o

gnTc = mkTyCon "GN"
instance Typeable GN where
    typeOf _ = mkTyConApp gnTc []

-- convenience type
type ActiveObjects = [GN]

-- active objects
-- make topstate an active object by putting it in a chan
data ActiveObject a = ActiveObject (Chan (TopStateT a ()))

-- make active object instance of show
instance Show (ActiveObject o) where
    show o = "ActiveObject Chan StateT"

-- make active object typeable
activeObjectTc = mkTyCon "ActiveObject"
instance Typeable1 ActiveObject where
    typeOf1 _ = mkTyConApp activeObjectTc []

-- make new active object over some state
newActiveObject action state t = do
    chan <- newChan
    contents <- getChanContents chan   
    forkIO (start (action contents) state)
    return (ActiveObject chan)

-- send an action if we are not interested in the result
send :: forall a . (Typeable a, Show a) => ActiveObject a -> TopStateT a 
() -> IO ()
send (ActiveObject chan) act = do
    writeChan chan act

-- sync an action if we are interested in the result
sync :: forall a b. (Typeable a, Show a) => ActiveObject a -> TopStateT 
a b -> IO b
sync ao f = do
    mv <- newEmptyMVar
    send ao (f' mv)
    a <- takeMVar mv
    return a
    where
    f' mv = do
        a <- f
        lift $ lift $ putMVar mv a

class SendSync t where
    sendM :: forall a. (Typeable a, Show a) =>
    t a -> TopStateT a () -> IO ()
    syncM :: forall a b. (Typeable a, Show a) =>
    t a -> TopStateT a b -> IO b

instance SendSync (ActiveObject) where
    sendM ao m = send ao m
    syncM ao m = sync ao m

{- unforunately doesn't work
instance SendSync (GN) where
    sendM (GN ao) m = sendM ao m
    syncM (GN ao) m = syncM ao m
-}

castGN :: forall a. (Show a,Typeable a) => GN -> ActiveObject a
castGN (GN o) = mcast o
    where
    mcast o = case (cast o) of
        Nothing -> error "No cast possible"
        Just a -> a

-- some test states for toplevel       
data TestState = TestState { val::Int }
    deriving (Show,Typeable)

data TestState2 = TestState2 { val2::Int }
    deriving (Show,Typeable)

uid :: forall b. TopStateT b Unique
uid = lift $ gets Main.id

changeUid :: forall b. Unique -> TopStateT b ()
changeUid n = do
    lift $ modify (\s -> s { Main.id = n })

newUid :: forall b. TopStateT b ()
newUid = do
    n <- lift $ lift $ newUnique
    lift $ modify (\s -> s { Main.id = n })

-- add a node to list in basestate
addNode :: forall o a. (Typeable a, Show o,Typeable o) => ActiveObject o 
-> TopStateT a ()
addNode n = do
    ns <- lift $ gets nodes
    lift $ modify (\s -> s { nodes = (GN n):ns })

-- get a node from list in basestate
getNode :: forall a o. (Show o,Typeable o) => Integer -> (TopStateT a 
(ActiveObject o))
getNode i = do
    ns <- lift $ gets nodes
    let ao = ns !! (fromInteger i)
    return (castGN ao)

-- action that executes messages send to it
action [] = return ()
action (e:es) = do
-- just for testing
    i <- uid
    s <- get
    ns <- lift get
    lift $ lift $ putStrLn $ "event (" ++ show i ++ "):" ++ " state:" ++ 
show s ++ " nstate:" ++ show ns
--
    e
    action es

-- create a new node state with a unique id
newNodeState = do
    u <- newUnique
    return (DefNodeState u [])

-- start evaluation
start action state = do
    ns <- newNodeState
    execStateT (execStateT action state) ns
    return ()

main = do
    ao <- newActiveObject action (TestState 5) TestState
    ao2 <- newActiveObject action (TestState2 5) TestState2

-- simple test
    u1 <- syncM ao (gets val)
    putStrLn $ "u1:" ++ show u1

-- show complete state
    r <- syncM ao (get)
    putStrLn $ show r

-- connect ao to ao2
    sendM ao (addNode ao2)

-- get node back
    ao2' <- syncM ao (getNode 0)

-- get unique id
    u <- syncM ao2' (uid)
    putStrLn $ "u:" ++ show (hashUnique u)

-- set a new id
    sendM ao2' (newUid)

-- show it
    u' <- syncM ao2' (uid)
    putStrLn $ "u':" ++ show (hashUnique u')

--    u2 <- syncM ao2' (gets val2)

    getChar
    return ()