distributed-process-azure-0.1.0: demos/Echo.hs

{-# LANGUAGE TemplateHaskell #-}

import System.IO (hFlush, stdout)
import System.Environment (getArgs)
import Control.Monad (unless, forever)
import Control.Monad.IO.Class (liftIO)
import Control.Distributed.Process (Process, expect)
import Control.Distributed.Process.Closure (remotable, mkClosure) 
import Control.Distributed.Process.Backend.Azure 

echoRemote :: () -> Backend -> Process ()
echoRemote () _backend = forever $ do
  str <- expect 
  remoteSend (str :: String)

remotable ['echoRemote]

echoLocal :: LocalProcess ()
echoLocal = do
  str <- liftIO $ putStr "# " >> hFlush stdout >> getLine
  unless (null str) $ do
    localSend str
    liftIO $ putStr "Echo: " >> hFlush stdout
    echo <- localExpect
    liftIO $ putStrLn echo
    echoLocal

main :: IO ()
main = do
  args <- getArgs
  case args of
    "onvm":args' -> 
      -- Pass execution to 'onVmMain' if we are running on the VM
      -- ('callOnVM' will provide the right arguments)
      onVmMain __remoteTable args'

    sid:x509:pkey:user:cloudService:virtualMachine:port:_ -> do
      -- Initialize the Azure backend
      params <- defaultAzureParameters sid x509 pkey 
      let params' = params { azureSshUserName = user }
      backend <- initializeBackend params' cloudService

      -- Find the specified virtual machine
      Just vm <- findNamedVM backend virtualMachine
      
      -- Run the echo client proper
      callOnVM backend vm port $
        ProcessPair ($(mkClosure 'echoRemote) ()) 
                    echoLocal