[Haskell-cafe] Cloud Haskell real usage example

[Thiago Negri]

Hello everyone. I'm taking my first steps in Cloud Haskell and got
some unexpected behaviors.

I used the code from Raspberry Pi in a Haskell Cloud [1] as a first
example. Did try to switch the code to use Template Haskell with no
luck, stick with the verbose style.
I changed some of the code, from ProcessId-based messaging to typed
channel to receive the Pong; using "startSlave" to start the worker
nodes; and changed the master node to loop forever sending pings to
the worker nodes.

The unexpected behaviors:
- Dropping a worker node while the master is running makes the master
node to crash.
- Master node do not see worker nodes started after the master process.

In order to fix this, I tried to "findSlaves" at the start of the
master process and send ping to only these ones, ignoring the list of
NodeId enforced by the type signature of "startMaster".

Now the master finds new slaves. The bad thing is that when I close
one of the workers, the master process freezes. It simply stop doing
anything. No more messages and no more Pings to other slaves. :(


My view of Cloud Haskell usage would be something similar to this: a
master node sending work to slaves; slave instances getting up or down
based on demand. So, the master node should be slave-failure-proof and
also find new slaves somehow.

Am I misunderstanding the big picture of Cloud Haskell or doing
anything wrong in the following code?

Code (skipped imports and wiring stuff):

--
newtype Ping = Ping (SendPort Pong)
        deriving (Typeable, Binary, Show)

newtype Pong = Pong ProcessId
        deriving (Typeable, Binary, Show)

worker :: Ping -> Process ()
worker (Ping sPong) = do
  wId <- getSelfPid
  say "Got a Ping!"
  sendChan sPong (Pong wId)

master :: Backend -> [NodeId] -> Process ()
master backend _ = forever $ do
  workers <- findSlaves backend
  say $ "Slaves: " ++ show workers

  (sPong, rPong) <- newChan

  forM_ workers $ \w -> do
    say $ "Sending a Ping to " ++ (show w) ++ "..."
    spawn w (workerClosure (Ping sPong))

  say $ "Waiting for reply from " ++ (show (length workers)) ++ " worker(s)"

  replicateM_ (length workers) $ do
      (Pong wId) <- receiveChan rPong
      say $ "Got back a Pong from " ++ (show $ processNodeId wId) ++ "!"

  (liftIO . threadDelay) 2000000 -- Wait a bit before return

main = do
  prog <- getProgName
  args <- getArgs

  case args of
    ["master", host, port] -> do
      backend <- initializeBackend host port remoteTable
      startMaster backend (master backend)

    ["worker", host, port] -> do
      backend <- initializeBackend host port remoteTable
      startSlave backend

    _ ->
      putStrLn $ "usage: " ++ prog ++ " (master | worker) host port"
--

[1] http://alenribic.com/writings/post/raspberry-pi-in-a-haskell-cloud