git.iko.soy/distributed-process
on ff8d9c6 help sign in
distributed-process/examples/DemoTransport.hs
176 lines 4.4 kB history raw
1{-# LANGUAGE NamedFieldPuns #-}
2module Main where
4import Network.Transport
5import qualified Network.Transport.MVar
6import qualified Network.Transport.Pipes
7import Network.Transport.TCP (mkTransport, TCPConfig (..))
9import Control.Concurrent
10import Control.Monad
12import qualified Data.ByteString.Lazy.Char8 as BS
14import Data.IORef
15import Debug.Trace
17-------------------------------------------
19{- Run a demo above with one of these tranpsort shorthands like this:
20 tcp >>= demo0
21 -}
22tcp = mkTCPOff 8080
23mvar = return Network.Transport.MVar.mkTransport
24pipes = return Network.Transport.Pipes.mkTransport
27-------------------------------------------
28-- Example programs using backend directly
31-- | Check if multiple messages can be sent on the same connection.
32demo0 :: IO Transport -> IO ()
33demo0 mktrans = do
34 trans <- mktrans
36 (sourceAddr, targetEnd) <- newConnection trans
38 forkIO $ logServer "logServer" targetEnd
39 threadDelay 100000
41 sourceEnd <- connect sourceAddr
43 mapM_ (\n -> send sourceEnd [BS.pack ("hello " ++ show n)]) [1 .. 10]
44 threadDelay 100000
46 closeTransport trans
49-- | Check endpoint serialization and deserialization.
50demo1 :: IO Transport -> IO ()
51demo1 mktrans = do
52 trans <- mktrans
54 (sourceAddr, targetEnd) <- newConnection trans
56 forkIO $ logServer "logServer" targetEnd
57 threadDelay 100000
59 sourceEnd <- connect sourceAddr
61 -- This use of Just is slightly naughty
62 let Just sourceAddr' = deserialize trans (serialize sourceAddr)
63 sourceEnd' <- connect sourceAddr'
65 send sourceEnd [BS.pack "hello 1"]
66 send sourceEnd' [BS.pack "hello 2"]
67 threadDelay 100000
68 closeTransport trans
71-- | Check that messages can be sent before receive is set up.
72demo2 :: IO Transport -> IO ()
73demo2 mktrans = do
74 trans <- mktrans
76 (sourceAddr, targetEnd) <- newConnection trans
77 sourceEnd <- connect sourceAddr
79 forkIO $ send sourceEnd [BS.pack "hello 1"]
80 threadDelay 100000
82 forkIO $ logServer "logServer" targetEnd
83 threadDelay 100000
84 closeTransport trans
87-- | Check that two different transports can be created.
88demo3 :: IO Transport -> IO ()
89demo3 mktrans = do
90 trans1 <- mktrans
91 trans2 <- mktrans
93 (sourceAddr1, targetEnd1) <- newConnection trans1
94 (sourceAddr2, targetEnd2) <- newConnection trans2
96 threadId1 <- forkIO $ logServer "logServer1" targetEnd1
97 threadId2 <- forkIO $ logServer "logServer2" targetEnd2
99 sourceEnd1 <- connect sourceAddr1
100 sourceEnd2 <- connect sourceAddr2
102 send sourceEnd1 [BS.pack "hello1"]
103 send sourceEnd2 [BS.pack "hello2"]
105 threadDelay 100000
107 killThread threadId1
108 killThread threadId2
109 closeTransport trans1
110 closeTransport trans2
113-- | Check that two different connections on the same transport can be created.
114demo4 :: IO Transport -> IO ()
115demo4 mktrans = do
116 trans <- mktrans
118 (sourceAddr1, targetEnd1) <- newConnection trans
119 (sourceAddr2, targetEnd2) <- newConnection trans
121 threadId1 <- forkIO $ logServer "logServer1" targetEnd1
122 threadId2 <- forkIO $ logServer "logServer2" targetEnd2
124 sourceEnd1 <- connect sourceAddr1
125 sourceEnd2 <- connect sourceAddr2
127 send sourceEnd1 [BS.pack "hello1"]
128 send sourceEnd2 [BS.pack "hello2"]
130 threadDelay 100000
132 killThread threadId1
133 killThread threadId2
134 closeTransport trans
136--------------------------------------------------------------------------------
138logServer :: String -> TargetEnd -> IO ()
139logServer name targetEnd = forever $ do
140 x <- receive targetEnd
141 trace (name ++ " rcvd: " ++ show x) $ return ()
143mkTCPOff 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)))
149--------------------------------------------------------------------------------
151runWAllTranports :: (IO Transport -> IO ()) -> Int -> IO ()
152runWAllTranports demo offset = do
153 putStrLn "------------------------------------------------------------"
154 putStrLn " MVAR transport:"
155 mvar >>= demo
156 putStrLn "\n TCP transport:"
157 tcp >>= demo
158 putStrLn "\n PIPES transport:"
159 pipes >>= demo
160 putStrLn "\n"
163main = do
164 putStrLn "Demo0:"
165 runWAllTranports demo0 0
166 putStrLn "Demo1:"
167 runWAllTranports demo1 10
168 putStrLn "Demo2:"
169 runWAllTranports demo2 20
170 putStrLn "Demo3:"
171 runWAllTranports demo3 30
172 putStrLn "Demo4:"
173 runWAllTranports demo4 40
175 threadDelay (300 * 1000)
176 putStrLn "Done with all demos!"