cloudtest.hs

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

module CloudTest where

import Remote
import Remote.Call

import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Control.Monad.State
import Control.Monad.State.Class

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

import Text.Printf

-- Some sugar for the Erlangers
pid ! msg = send pid msg

data MyState = MyState {total_ :: Int, count_ :: Int}

total = lens (\MyState{total_} -> total_) (\t s -> s{total_=t})
count = lens (\MyState{count_} -> count_) (\c s -> s{count_=c})

data SumMessage = Add Int | Display | PoisonPill deriving (Typeable, Data)

instance Binary SumMessage where
  get = genericGet
  put = genericPut

sumProc :: Int -> ProcessM ()
sumProc init = runStateT sumProc' (MyState {total_=0, count_=0}) >> return ()
  where sumProc' :: StateT MyState ProcessM ()
        sumProc' = forever $ do msg <- lift expect
                                case msg of
                                  Add n      -> do total += n
                                                   count += 1
                                                   return ()
                                  Display    -> do t <- access total
                                                   c <- access count
                                                   lift . say $ printf "Sum of %d numbers is %d" c t
                                  PoisonPill -> lift terminate


initialProc :: String -> ProcessM ()
initialProc _ = do nid <- getSelfNode
                   sum <- spawnLocal $ sumProc 0
                   sum ! Add 1
                   sum ! Add 2
                   sum ! Add 3
                   sum ! Display
                   sum ! PoisonPill
                   terminate

remotable ['sumProc]

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

output

2011-09-25 15:41:00.976864 EDT 0 pid://dylukesmbp.home:52710/9/ SAY Sum of 3 numbers is 6