Main.hs

module Main where

import           Control.Distributed.Process hiding (call)
import           Control.Distributed.Process.Node as Node (initRemoteTable, runProcess) 
import           Control.Distributed.Process.Extras (resolve)
import           Control.Distributed.Process.Backend.SimpleLocalnet
import           Control.Concurrent (threadDelay)
import           Control.Monad
import           Network.Transport hiding (send)
import           System.Environment
import           Data.ByteString.Char8 as BS

main :: IO ()
main = do
  args <- getArgs
  case args of
    ["server", host, port] ->
      startServer host port
    ["client", host, port, serv] ->
      startClient host port serv
  where
    startServer h p
      = do startCommon h p $ do
             register "foo" =<< getSelfPid
             forever $ liftIO $ threadDelay 10000

    startClient h p srv
      = do startCommon h p $ do
             let n = makeNodeId srv
             Just s <- resolve (n, "foo")
             send s ()

    startCommon h p k
      = do backend <- initializeBackend h p initRemoteTable
           n       <- newLocalNode backend
           Node.runProcess n k

makeNodeId :: String -> NodeId
makeNodeId addr = NodeId . EndPointAddress . BS.concat $ [BS.pack addr, BS.pack ":0"]