git.iko.soy/distributed-process
on master help sign in
Begin to update DemoTransport
6c768b5Ryan Newton
examples/DemoTransport.hs+39−11
compare with master
unifiedsplit
@@ -1,7 +1,9 @@
1+{-# LANGUAGE NamedFieldPuns #-}
1−module DemoTransport where
2+module Main where
2
3
3−import Network.Transport
4+import Network.Transport
4−import qualified Network.Transport.MVar
5+import qualified Network.Transport.MVar
6+import qualified Network.Transport.Pipes
5import Network.Transport.TCP (mkTransport, TCPConfig (..))
7import Network.Transport.TCP (mkTransport, TCPConfig (..))
6
8
7import Control.Concurrent
9import Control.Concurrent
@@ -16,9 +18,10 @@ import Debug.Trace
16--
18--
17
19
18-- | Check if multiple messages can be sent on the same connection.
20-- | Check if multiple messages can be sent on the same connection.
19−demo0 :: IO ()
21+demo0 :: IO Transport -> IO ()
20−demo0 = do
22+demo0 mktrans = do
21− trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
23+-- trans@Transport{closeTransport} <- mktrans
24+ trans <- mktrans
22
25
23 (sourceAddr, targetEnd) <- newConnection trans
26 (sourceAddr, targetEnd) <- newConnection trans
24
27
@@ -30,11 +33,14 @@ demo0 = do
30 mapM_ (\n -> send sourceEnd [BS.pack ("hello " ++ show n)]) [1 .. 10]
33 mapM_ (\n -> send sourceEnd [BS.pack ("hello " ++ show n)]) [1 .. 10]
31 threadDelay 100000
34 threadDelay 100000
32
35
36+-- closeSourceEnd sourceEnd
37+-- closeTransport trans
38+
39+
33-- | Check endpoint serialization and deserialization.
40-- | Check endpoint serialization and deserialization.
34−demo1 :: IO ()
41+demo1 :: IO Transport -> IO ()
35−demo1 = do
42+demo1 mktrans = do
36− -- trans <- mkTransport
43+ trans <- mktrans
37− trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
38
44
39 (sourceAddr, targetEnd) <- newConnection trans
45 (sourceAddr, targetEnd) <- newConnection trans
40
46
@@ -105,4 +111,26 @@ demo4 = do
105logServer :: String -> TargetEnd -> IO ()
111logServer :: String -> TargetEnd -> IO ()
106logServer name targetEnd = forever $ do
112logServer name targetEnd = forever $ do
107 x <- receive targetEnd
113 x <- receive targetEnd
108− trace (name ++ ": " ++ show x) $ return ()
114+ trace (name ++ " rcvd: " ++ show x) $ return ()
115+
116+
117+--------------------------------------------------------------------------------
118+
119+runWAllTranports demo = do
120+ putStrLn "------------------------------------------------------------"
121+ putStrLn " MVAR transport:"
122+ demo Network.Transport.MVar.mkTransport
123+ putStrLn "\n TCP transport:"
124+ demo$ mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
125+ putStrLn "\n PIPES transport:"
126+ demo Network.Transport.Pipes.mkTransport
127+ putStrLn "\n"
128+
129+main = do
130+ putStrLn "Demo0:"
131+ runWAllTranports demo0
132+
133+-- putStrLn "Demo1:"
134+-- runWAllTranports demo1
135+
136+
examples/DemoTransport2.hsdeleted−147
@@ -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−
examples/Makefilenew file+13
@@ -0,0 +1,13 @@
1+
2+
3+ifeq ($(GHC),)
4+ GHC=ghc
5+endif
6+
7+all:
8+ $(GHC) -threaded --make DemoTransport.hs -o DemoTransport.exe -fforce-recomp
9+
10+
11+clean:
12+ rm -f *.hi *.o DemoTransport.exe
13+