@@ -0,0 +1,45 @@
1+-- | Like Throughput, but send every ping from a different process
2+-- (i.e., require a lightweight connection per ping)
3+import System.Environment
4+import Control.Monad
5+import Control.Applicative
6+import Control.Distributed.Process
7+import Control.Distributed.Process.Node
8+import Network.Transport.TCP (createTransport, defaultTCPParameters)
9+import Data.Binary (encode, decode)
10+import qualified Data.ByteString.Lazy as BSL
11+
12+counter :: Process ()
13+counter = go 0
14+ where
15+ go :: Int -> Process ()
16+ go !n = do
17+ b <- expect
18+ case b of
19+ Nothing -> go (n + 1)
20+ Just them -> send them n >> go 0
21+
22+count :: Int -> ProcessId -> Process ()
23+count n them = do
24+ us <- getSelfPid
25+ replicateM_ n . spawnLocal $ send them (Nothing :: Maybe ProcessId)
26+ send them (Just us)
27+ n' <- expect
28+ liftIO $ print (n == n')
29+
30+initialProcess :: String -> Process ()
31+initialProcess "SERVER" = do
32+ us <- getSelfPid
33+ liftIO $ BSL.writeFile "counter.pid" (encode us)
34+ counter
35+initialProcess "CLIENT" = do
36+ n <- liftIO $ getLine
37+ them <- liftIO $ decode <$> BSL.readFile "counter.pid"
38+ count (read n) them
39+
40+main :: IO ()
41+main = do
42+ [role, host, port] <- getArgs
43+ Right transport <- createTransport host port defaultTCPParameters
44+ node <- newLocalNode transport initRemoteTable
45+ runProcess node $ initialProcess role