CloudTest.hs

{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, StandaloneDeriving #-}

module CloudTest where

import Remote

import Control.Applicative
import Control.Monad
import Control.Monad.Trans

import Data.Data
import Data.Binary
import Data.Typeable

-- Note: (Binary a, Typeable a) => Serializable a

data Ping = Ping ProcessId | PoisonPill deriving (Typeable)

instance Binary Ping where
  get            = do id <- get :: Get Word8
                      case id of
                        0 -> do pid <- get
                                return $ Ping pid
                        1 -> return PoisonPill
  put (Ping pid) = put (0 :: Word8) *> put pid
  put PoisonPill = put (1 :: Word8)

data Pong = Pong ProcessId deriving (Typeable)

instance Binary Pong where
  get            = Pong <$ (get :: Get Word8) <*> get
  put (Pong pid) = put (0 :: Word8) *> put pid

-- Sends n Pings to its partner
ping :: Int -> ProcessId -> ProcessM ()
ping n partner = do myPid <- getSelfPid
                    case n of
                      0 -> do say "Ping: terminating."
                              send partner PoisonPill
                              terminate
                      _ -> do send partner (Ping myPid)
                              Pong partner <- expect
                              say "Ping: Got a pong!"
                              ping (n - 1) partner
-- Responds to any Ping with a Pong
pong :: ProcessM ()
pong = do msg <- expect
          case msg of
            Ping partner -> do say "Pong: Got a ping!"
                               myPid <- getSelfPid
                               send partner (Pong myPid)
                               pong
            PoisonPill   -> do say "Pong: terminating"
                               terminate

initialProc :: String -> ProcessM ()
initialProc _ = do pong <- spawnLocal pong
                   ping <- spawnLocal $ ping 5 pong
                   return ()

remotable ['ping, 'pong]

main = remoteInit (Nothing) [CloudTest.__remoteCallMetaData] initialProc

Output Example

*CloudTest> main
2011-09-24 20:49:48.008904 EDT 0 pid://dylukesmbp.home:60302/9/ SAY Pong: Got a ping!
2011-09-24 20:49:48.009255 EDT 0 pid://dylukesmbp.home:60302/10/ SAY Ping: Got a pong!
2011-09-24 20:49:48.009336 EDT 0 pid://dylukesmbp.home:60302/9/ SAY Pong: Got a ping!
2011-09-24 20:49:48.009405 EDT 0 pid://dylukesmbp.home:60302/10/ SAY Ping: Got a pong!
2011-09-24 20:49:48.009476 EDT 0 pid://dylukesmbp.home:60302/9/ SAY Pong: Got a ping!
2011-09-24 20:49:48.009659 EDT 0 pid://dylukesmbp.home:60302/10/ SAY Ping: Got a pong!
2011-09-24 20:49:48.009738 EDT 0 pid://dylukesmbp.home:60302/9/ SAY Pong: Got a ping!
2011-09-24 20:49:48.009805 EDT 0 pid://dylukesmbp.home:60302/10/ SAY Ping: Got a pong!
2011-09-24 20:49:48.009876 EDT 0 pid://dylukesmbp.home:60302/9/ SAY Pong: Got a ping!
2011-09-24 20:49:48.010023 EDT 0 pid://dylukesmbp.home:60302/10/ SAY Ping: Got a pong!
2011-09-24 20:49:48.010058 EDT 0 pid://dylukesmbp.home:60302/10/ SAY Ping: terminating.
2011-09-24 20:49:48.010127 EDT 0 pid://dylukesmbp.home:60302/9/ SAY Pong: terminating