-- Timber-like reactive objects
import Control.Concurrent
import Data.IORef

-- fake OO notation
infixl 1 #
o # f = f o

-- an object is represented by its message queue
newtype Object = O (Chan Message)

-- a message is just an IO action
type Message = IO ()

-- method types
type Action = IO ()   -- asynchronous method; caller continues (no result)
type Request a = IO a -- synchronous method; caller waits for result

-- construct an action
action :: Object -> IO () -> Action
action (O ch) act = writeChan ch act

-- construct a request
request :: Object -> IO a -> Request a
request (O ch) req = do
  m <- newEmptyMVar
  writeChan ch (do
    r <- req
    putMVar m r)
  takeMVar m

-- construct an object
newObject :: IO Object
newObject = do
  ch <- newChan
  msgs <- getChanContents ch
  forkIO $ sequence_ msgs
  return (O ch)

-- the braindead moving point example

-- point interface
data IPoint = IPoint {
    getX :: IO Int,
    move :: Int -> IO ()
  }

-- construct a point
point = do
  state <- newIORef 0
  self <- newObject
  return IPoint {
      move = \d -> action self $ modifyIORef state ((+) d),
      getX = request self $ readIORef state
    }

main = do
  p <- point
  p # getX >>= print
  p # move $ 3
  p # getX >>= print