git.iko.soy/distributed-process
on master help sign in
The Pipes transport works for demo1 and demo0.
ad9c9ccRyan Newton
examples/DemoTransport.hs+23−13
compare with master
unifiedsplit
@@ -60,10 +60,9 @@ demo1 mktrans = do
60 closeTransport trans
60 closeTransport trans
61
61
62-- | Check that messages can be sent before receive is set up.
62-- | Check that messages can be sent before receive is set up.
63−demo2 :: IO ()
63+demo2 :: IO Transport -> IO ()
64−demo2 = do
64+demo2 mktrans = do
65− -- trans <- mkTransport
65+ trans <- mktrans
66− trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
67
66
68 (sourceAddr, targetEnd) <- newConnection trans
67 (sourceAddr, targetEnd) <- newConnection trans
69
68
@@ -77,10 +76,10 @@ demo2 = do
77 closeTransport trans
76 closeTransport trans
78
77
79-- | Check that two different transports can be created.
78-- | Check that two different transports can be created.
80−demo3 :: IO ()
79+demo3 :: (Int -> IO Transport) -> Int -> IO ()
81−demo3 = do
80+demo3 mktrans offset = do
82− trans1 <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
81+ trans1 <- mktrans (offset + 0)
83− trans2 <- mkTransport $ TCPConfig undefined "127.0.0.1" "8081"
82+ trans2 <- mktrans (offset + 1)
84
83
85 (sourceAddr1, targetEnd1) <- newConnection trans1
84 (sourceAddr1, targetEnd1) <- newConnection trans1
86 (sourceAddr2, targetEnd2) <- newConnection trans2
85 (sourceAddr2, targetEnd2) <- newConnection trans2
@@ -101,6 +100,7 @@ demo3 = do
101 closeTransport trans1
100 closeTransport trans1
102 closeTransport trans2
101 closeTransport trans2
103
102
103+
104-- | Check that two different connections on the same transport can be created.
104-- | Check that two different connections on the same transport can be created.
105demo4 :: IO ()
105demo4 :: IO ()
106demo4 = do
106demo4 = do
@@ -133,21 +133,31 @@ logServer name targetEnd = forever $ do
133
133
134--------------------------------------------------------------------------------
134--------------------------------------------------------------------------------
135
135
136−runWAllTranports demo = do
136+runWAllTranports demo offset = do
137 putStrLn "------------------------------------------------------------"
137 putStrLn "------------------------------------------------------------"
138 putStrLn " MVAR transport:"
138 putStrLn " MVAR transport:"
139 demo Network.Transport.MVar.mkTransport
139 demo Network.Transport.MVar.mkTransport
140 putStrLn "\n TCP transport:"
140 putStrLn "\n TCP transport:"
141− demo$ mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
141+ demo$ mkTransport $ TCPConfig undefined "127.0.0.1" (show (8080 + offset))
142 putStrLn "\n PIPES transport:"
142 putStrLn "\n PIPES transport:"
143 demo Network.Transport.Pipes.mkTransport
143 demo Network.Transport.Pipes.mkTransport
144 putStrLn "\n"
144 putStrLn "\n"
145
145
146main = do
146main = do
147 putStrLn "Demo0:"
147 putStrLn "Demo0:"
148− runWAllTranports demo0
148+ runWAllTranports demo0 0
149+
150+ putStrLn "Demo1:"
151+ runWAllTranports demo1 10
152+
153+ putStrLn "Demo2:"
154+ runWAllTranports demo2 20
155+
156+ putStrLn "Done with all demos!"
157+
158+-- trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
149
159
150−-- putStrLn "Demo1:"
160+-- trans1 <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
151−-- runWAllTranports demo1
161+-- trans2 <- mkTransport $ TCPConfig undefined "127.0.0.1" "8081"
152
162
153
163
network-transport/src/Network/Transport/Pipes.hs+3−2
@@ -75,9 +75,10 @@ mkTransport = do
75 -- Note: Linux fifo semantics are NOT to block on open-RW, but this is not Posix standard.
75 -- Note: Linux fifo semantics are NOT to block on open-RW, but this is not Posix standard.
76 --
76 --
77 -- We may protect from blocking other threads by running on a separate (OS) thread:
77 -- We may protect from blocking other threads by running on a separate (OS) thread:
78−-- mv <- onOSThread$ PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags
78+ mv <- onOSThread$ PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags
79-- fd <- PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags
79-- fd <- PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags
80− fd <- PIO.openFd filename PIO.WriteOnly Nothing PIO.defaultFileFlags
80+-- fd <- PIO.openFd filename PIO.WriteOnly Nothing PIO.defaultFileFlags
81+ fd <- takeMVar mv
81
82
82 return $
83 return $
83 -- Write to the named pipe. If the message is less than
84 -- Write to the named pipe. If the message is less than