@@ -10,21 +10,27 @@ import Control.Concurrent
1010import Control.Monad
1111
1212import qualified Data.ByteString.Lazy.Char8 as BS
13−-- import qualified Data.ByteString.Char8 as BS
1413
1514import Data.IORef
1615import Debug.Trace
1716
18−-- closeTransport _ = return ()
17+-------------------------------------------
18+
19+{- Run a demo above with one of these tranpsort shorthands like this:
20+ tcp >>= demo0
21+ -}
22+tcp = mkTCPOff 8080
23+mvar = return Network.Transport.MVar.mkTransport
24+pipes = return Network.Transport.Pipes.mkTransport
25+
1926
2027-------------------------------------------
21−-- Example program using backend directly
22−--
28+-- Example programs using backend directly
29+
2330
2431-- | Check if multiple messages can be sent on the same connection.
2532demo0 :: IO Transport -> IO ()
2633demo0 mktrans = do
27−-- trans@Transport{closeTransport} <- mktrans
2834 trans <- mktrans
2935
3036 (sourceAddr, targetEnd) <- newConnection trans
@@ -37,7 +43,8 @@ demo0 mktrans = do
3743 mapM_ (\n -> send sourceEnd [BS.pack ("hello " ++ show n)]) [1 .. 10]
3844 threadDelay 100000
3945
40−-- closeTransport trans
46+ closeTransport trans
47+
4148
4249-- | Check endpoint serialization and deserialization.
4350demo1 :: IO Transport -> IO ()
@@ -60,25 +67,23 @@ demo1 mktrans = do
6067 threadDelay 100000
6168 closeTransport trans
6269
70+
6371-- | Check that messages can be sent before receive is set up.
6472demo2 :: IO Transport -> IO ()
6573demo2 mktrans = do
6674 trans <- mktrans
6775
6876 (sourceAddr, targetEnd) <- newConnection trans
69− putStrLn " ================= "
7077 sourceEnd <- connect sourceAddr
71− putStrLn " FRK TO SEND"
78+
7279 forkIO $ send sourceEnd [BS.pack "hello 1"]
7380 threadDelay 100000
7481
75− putStrLn " NEXT fork receiver (logServer):"
76−
7782 forkIO $ logServer "logServer" targetEnd
7883 threadDelay 100000
79−
8084 closeTransport trans
8185
86+
8287-- | Check that two different transports can be created.
8388demo3 :: IO Transport -> IO ()
8489demo3 mktrans = do
@@ -135,36 +140,27 @@ logServer name targetEnd = forever $ do
135140 x <- receive targetEnd
136141 trace (name ++ " rcvd: " ++ show x) $ return ()
137142
138−-- Run a demo above with one of these tranpsort shorthands as argument:
139−
140−-- do cnt <- readIORef cntr
141−-- writeIORef cntr (cnt+1)
142−-- mkTransport (TCPConfig undefined "127.0.0.1" (show (8080 + offset + cnt)))
143−
144−--mkTCP = do cntr <- newIORef 0
145−-- mkTCPOff 8080
143+mkTCPOff off = do
144+ cntr <- newIORef 0
145+ return$ do cnt <- readIORef cntr
146+ writeIORef cntr (cnt+1)
147+ mkTransport (TCPConfig undefined "127.0.0.1" (show (off + cnt)))
146148
147149--------------------------------------------------------------------------------
148150
149151runWAllTranports :: (IO Transport -> IO ()) -> Int -> IO ()
150152runWAllTranports demo offset = do
151153 putStrLn "------------------------------------------------------------"
152−
153154 putStrLn " MVAR transport:"
154− demo Network.Transport.MVar.mkTransport
155−
155+ mvar >>= demo
156156 putStrLn "\n TCP transport:"
157− cntr <- newIORef 0
158− demo$ do cnt <- readIORef cntr
159− writeIORef cntr (cnt+1)
160− mkTransport (TCPConfig undefined "127.0.0.1" (show (8080 + offset + cnt)))
161−
157+ tcp >>= demo
162158 putStrLn "\n PIPES transport:"
163− demo Network.Transport.Pipes.mkTransport
159+ pipes >>= demo
164160 putStrLn "\n"
165161
166−main = do
167162
163+main = do
168164 putStrLn "Demo0:"
169165 runWAllTranports demo0 0
170166 putStrLn "Demo1:"
@@ -176,5 +172,5 @@ main = do
176172 putStrLn "Demo4:"
177173 runWAllTranports demo4 40
178174
179− threadDelay (500 * 1000)
175+ threadDelay (300 * 1000)
180176 putStrLn "Done with all demos!"