git.iko.soy/distributed-process
on mxsend-fix help sign in
distributed-process/benchmarks/Spawns.hs
49 lines 1.5 kB history raw
1{-# LANGUAGE BangPatterns #-}
3-- | Like Throughput, but send every ping from a different process
4-- (i.e., require a lightweight connection per ping)
5import System.Environment
6import Control.Monad
7import Control.Applicative
8import Control.Distributed.Process
9import Control.Distributed.Process.Node
10import Network.Transport.TCP (createTransport, defaultTCPAddr, defaultTCPParameters)
11import Data.Binary (encode, decode)
12import qualified Data.ByteString.Lazy as BSL
14counter :: Process ()
15counter = go 0
16 where
17 go :: Int -> Process ()
18 go !n = do
19 b <- expect
20 case b of
21 Nothing -> go (n + 1)
22 Just them -> send them n >> go 0
24count :: Int -> ProcessId -> Process ()
25count n them = do
26 us <- getSelfPid
27 replicateM_ n . spawnLocal $ send them (Nothing :: Maybe ProcessId)
28 send them (Just us)
29 n' <- expect
30 liftIO $ print (n == n')
32initialProcess :: String -> Process ()
33initialProcess "SERVER" = do
34 us <- getSelfPid
35 liftIO $ BSL.writeFile "counter.pid" (encode us)
36 counter
37initialProcess "CLIENT" = do
38 n <- liftIO $ getLine
39 them <- liftIO $ decode <$> BSL.readFile "counter.pid"
40 count (read n) them
42main :: IO ()
43main = do
44 [role, host, port] <- getArgs
45 trans <- createTransport (defaultTCPAddr host port) defaultTCPParameters
46 case trans of
47 Right transport -> do node <- newLocalNode transport initRemoteTable
48 runProcess node $ initialProcess role
49 Left other -> error $ show other