@@ -1,147 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−
3−-- module DemoTransport where
4−module Main where
5−
6−import Network.Transport
7−import qualified Network.Transport.MVar
8−import Network.Transport.TCP (mkTransport, TCPConfig (..))
9−
10−import qualified Network.Transport.Pipes as Pipes
11−
12−import Control.Concurrent
13−import Control.Monad
14−import Control.Exception
15−import System.IO (stderr, hPutStrLn)
16−
17−import qualified Data.ByteString.Char8 as BS
18−
19−import Debug.Trace
20−
21−forkWithExceptions :: (IO () -> IO ThreadId) -> String -> IO () -> IO ThreadId
22−forkWithExceptions forkit descr action = do
23− parent <- myThreadId
24− forkit $
25− Control.Exception.catch
26− action
27− (\ e -> do
28− hPutStrLn stderr $ "Exception inside "++descr++": "++show e
29− throwTo parent (e::SomeException)
30− )
31−
32−-------------------------------------------
33−-- Example program using backend directly
34−--
35−
36−-- | Check if multiple messages can be sent on the same connection.
37−-- demo0 :: IO ()
38−demo0 mkTrans = do
39− trans <- mkTrans
40−
41− (sourceAddr, targetEnd) <- newConnection trans
42−
43−#ifdef EXNTREE
44− -- [2012.02.19] I'm seeing indefinite MVar errors cropping up here:
45− forkWithExceptions forkOS "receiver thread" $ logServer "logServer" targetEnd
46−#else
47− forkIO $ logServer "logServer" targetEnd
48−#endif
49− threadDelay 100000
50−
51− sourceEnd <- connect sourceAddr
52−
53− mapM_ (\n -> send sourceEnd [BS.pack ("hello " ++ show n)]) [1 .. 10]
54− threadDelay 100000
55−
56−
57−main = do
58− putStrLn "MVAR:"
59− demo0 Network.Transport.MVar.mkTransport
60− putStrLn "TCP:"
61− demo0$ mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
62− putStrLn "Pipes:"
63− demo0 Pipes.mkTransport
64−
65−
66−
67−
68−{-
69−-- | Check endpoint serialization and deserialization.
70−demo1 :: IO ()
71−demo1 = do
72− -- trans <- mkTransport
73− trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
74−
75− (sourceAddr, targetEnd) <- newConnection trans
76−
77− forkIO $ logServer "logServer" targetEnd
78− threadDelay 100000
79−
80− sourceEnd <- connect sourceAddr
81−
82− -- This use of Just is slightly naughty
83− let Just sourceAddr' = deserialize trans (serialize sourceAddr)
84− sourceEnd' <- connect sourceAddr'
85−
86− send sourceEnd [BS.pack "hello 1"]
87− send sourceEnd' [BS.pack "hello 2"]
88− threadDelay 100000
89−
90−-- | Check that messages can be sent before receive is set up.
91−demo2 :: IO ()
92−demo2 = do
93− -- trans <- mkTransport
94− trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
95−
96− (sourceAddr, targetEnd) <- newConnection trans
97−
98− sourceEnd <- connect sourceAddr
99− forkIO $ send sourceEnd [BS.pack "hello 1"]
100− threadDelay 100000
101−
102− forkIO $ logServer "logServer" targetEnd
103− return ()
104−
105−-- | Check that two different transports can be created.
106−demo3 :: IO ()
107−demo3 = do
108− trans1 <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
109− trans2 <- mkTransport $ TCPConfig undefined "127.0.0.1" "8081"
110−
111− (sourceAddr1, targetEnd1) <- newConnection trans1
112− (sourceAddr2, targetEnd2) <- newConnection trans2
113−
114− forkIO $ logServer "logServer1" targetEnd1
115− forkIO $ logServer "logServer2" targetEnd2
116−
117− sourceEnd1 <- connect sourceAddr1
118− sourceEnd2 <- connect sourceAddr2
119−
120− send sourceEnd1 [BS.pack "hello1"]
121− send sourceEnd2 [BS.pack "hello2"]
122−
123−-- | Check that two different connections on the same transport can be created.
124−demo4 :: IO ()
125−demo4 = do
126− trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
127− -- trans <- Network.Transport.MVar.mkTransport
128−
129− (sourceAddr1, targetEnd1) <- newConnection trans
130− (sourceAddr2, targetEnd2) <- newConnection trans
131−
132− forkIO $ logServer "logServer1" targetEnd1
133− forkIO $ logServer "logServer2" targetEnd2
134−
135− sourceEnd1 <- connect sourceAddr1
136− sourceEnd2 <- connect sourceAddr2
137−
138− send sourceEnd1 [BS.pack "hello1"]
139− send sourceEnd2 [BS.pack "hello2"]
140−
141−-}
142−
143−logServer :: String -> TargetEnd -> IO ()
144−logServer name targetEnd = forever $ do
145− x <- receive targetEnd
146− trace (name ++ " rcvd: " ++ show x) $ return ()
147−