Cloud Haskell Hello World

{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable #-}

import Control.Concurrent (threadDelay)
import Control.Distributed.Process (Process, ProcessId, expect, getSelfPid, send)
import Control.Distributed.Process.Node
  (closeLocalNode, forkProcess, initRemoteTable, newLocalNode)
import Control.Monad (forever)
import Control.Monad.IO.Class (liftIO)
import Network.Transport (closeTransport)
import Network.Transport.TCP (createTransport, defaultTCPParameters)

sleepNS n = threadDelay (n * 1000000)
sleep1s = sleepNS 1

ponger ∷ Process ()
ponger = forever $ do
  (pid, "ping") ← expect
  liftIO $ putStr "ping … "
  liftIO $ sleep1s
  send pid "pong"

pinger ∷ ProcessId → Process ()
pinger pongerPid = forever $ do
  selfPid ← getSelfPid
  send pongerPid (selfPid, "ping")
  "pong" ← expect
  liftIO $ putStrLn "pong"
  liftIO $ sleep1s

main = do
  Right transport1 ← createTransport "127.0.0.1" "10001" defaultTCPParameters
  Right transport2 ← createTransport "127.0.0.1" "10002" defaultTCPParameters
  node1 ← newLocalNode transport1 initRemoteTable
  node2 ← newLocalNode transport2 initRemoteTable
  pongerPid ← forkProcess node1 ponger
  forkProcess node2 (pinger pongerPid)
  liftIO $ sleepNS 10
  closeLocalNode node1
  closeTransport transport1
  closeLocalNode node2
  closeTransport transport2