git.iko.soy/distributed-process
on master help sign in
Add several transport examples.
6ddc933Nicolas Wu
examples/DemoTransport.hs+70−15
compare with master
unifiedsplit
@@ -1,23 +1,44 @@
1module DemoTransport where
1module DemoTransport where
2
2
3import Network.Transport
3import Network.Transport
4−import Network.Transport.MVar (mkTransport)
4+import qualified Network.Transport.MVar
5+import Network.Transport.TCP (mkTransport, TCPConfig (..))
5
6
6import Control.Concurrent
7import Control.Concurrent
8+import Control.Monad
9+
7import qualified Data.ByteString.Char8 as BS
10import qualified Data.ByteString.Char8 as BS
8
11
12+import Debug.Trace
13+
9-------------------------------------------
14-------------------------------------------
10-- Example program using backend directly
15-- Example program using backend directly
11--
16--
12
17
13−-- check the endpoint serialisation works
18+-- | Check if multiple messages can be sent on the same connection.
19+demo0 :: IO ()
20+demo0 = do
21+ trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
22+
23+ (sendAddr, receiveEnd) <- newConnection trans
24+
25+ forkIO $ logServer "logServer" receiveEnd
26+ threadDelay 100000
27+
28+ sendEnd <- connect sendAddr
29+
30+ mapM_ (\n -> send sendEnd [BS.pack ("hello " ++ show n)]) [1 .. 10]
31+ threadDelay 100000
32+
33+-- | Check endpoint serialization and deserialization.
14demo1 :: IO ()
34demo1 :: IO ()
15demo1 = do
35demo1 = do
16− trans <- mkTransport
36+ -- trans <- mkTransport
37+ trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
17
38
18 (sendAddr, receiveEnd) <- newConnection trans
39 (sendAddr, receiveEnd) <- newConnection trans
19
40
20− forkIO $ logServer receiveEnd
41+ forkIO $ logServer "logServer" receiveEnd
21 threadDelay 100000
42 threadDelay 100000
22
43
23 sendEnd <- connect sendAddr
44 sendEnd <- connect sendAddr
@@ -30,24 +51,58 @@ demo1 = do
30 send sendEnd' [BS.pack "hello 2"]
51 send sendEnd' [BS.pack "hello 2"]
31 threadDelay 100000
52 threadDelay 100000
32
53
33−-- check that we can send before any corresponding receive
54+-- | Check that messages can be sent before receive is set up.
34demo2 :: IO ()
55demo2 :: IO ()
35demo2 = do
56demo2 = do
36− trans <- mkTransport
57+ -- trans <- mkTransport
58+ trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
37
59
38 (sendAddr, receiveEnd) <- newConnection trans
60 (sendAddr, receiveEnd) <- newConnection trans
39
61
40 sendEnd <- connect sendAddr
62 sendEnd <- connect sendAddr
41−
42 forkIO $ send sendEnd [BS.pack "hello 1"]
63 forkIO $ send sendEnd [BS.pack "hello 1"]
43 threadDelay 100000
64 threadDelay 100000
44− forkIO $ logServer receiveEnd
45− threadDelay 100000
46− forkIO $ send sendEnd [BS.pack "hello 2"]
47− threadDelay 100000
48
65
66+ forkIO $ logServer "logServer" receiveEnd
67+ return ()
68+
69+-- | Check that two different transports can be created.
70+demo3 :: IO ()
71+demo3 = do
72+ trans1 <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
73+ trans2 <- mkTransport $ TCPConfig undefined "127.0.0.1" "8081"
74+
75+ (sendAddr1, receiveEnd1) <- newConnection trans1
76+ (sendAddr2, receiveEnd2) <- newConnection trans2
77+
78+ forkIO $ logServer "logServer1" receiveEnd1
79+ forkIO $ logServer "logServer2" receiveEnd2
80+
81+ sendEnd1 <- connect sendAddr1
82+ sendEnd2 <- connect sendAddr2
83+
84+ send sendEnd1 [BS.pack "hello1"]
85+ send sendEnd2 [BS.pack "hello2"]
86+
87+-- | Check that two different connections on the same transport can be created.
88+demo4 :: IO ()
89+demo4 = do
90+ trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
91+ -- trans <- Network.Transport.MVar.mkTransport
92+
93+ (sendAddr1, receiveEnd1) <- newConnection trans
94+ (sendAddr2, receiveEnd2) <- newConnection trans
95+
96+ forkIO $ logServer "logServer1" receiveEnd1
97+ forkIO $ logServer "logServer2" receiveEnd2
98+
99+ sendEnd1 <- connect sendAddr1
100+ sendEnd2 <- connect sendAddr2
101+
102+ send sendEnd1 [BS.pack "hello1"]
103+ send sendEnd2 [BS.pack "hello2"]
104+
49−logServer :: ReceiveEnd -> IO ()
105+logServer :: String -> ReceiveEnd -> IO ()
50−logServer receiveEnd = do
106+logServer name receiveEnd = forever $ do
51 x <- receive receiveEnd
107 x <- receive receiveEnd
52− print x
108+ trace (name ++ ": " ++ show x) $ return ()
53− logServer receiveEnd