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, __remoteTable)
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 (__remoteTable initRemoteTable)
           n       <- newLocalNode backend
           Node.runProcess n k

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