Ticket #2785: threadring.hs

File threadring.hs, 1.0 KB (added by felixmar, 5 years ago)
Line 
1import Control.Concurrent
2import Control.Monad
3import Network.Socket
4import System.Environment
5import System.IO.Unsafe
6
7local :: HostAddress
8local = unsafePerformIO $ inet_addr "127.0.0.1"
9
10udpSocket :: IO Socket
11udpSocket = do
12  sock <- socket AF_INET Datagram 17
13  bindSocket sock (SockAddrInet 0 local)
14  return sock
15
16new :: PortNumber -> Int -> IO PortNumber
17new port_right i = do
18  sock <- udpSocket
19  forkIO (thread i port_right sock)
20  socketPort sock
21
22thread :: Int -> PortNumber -> Socket -> IO ()
23thread i port_right sock = go
24  where
25    go = do
26      (m_str, _, _) <- recvFrom sock 8
27      let m = read m_str
28      when (m == 1) (print i)
29      sendTo sock (show (m-1)) (SockAddrInet port_right local)
30      when (m > 0) go
31
32main = do
33  ring_str : n : _ <- getArgs
34  let ring = read ring_str
35  sock <- udpSocket
36  port_left <- socketPort sock
37  port_right <- foldM new port_left [ring+2-i | i <- [2..ring]]
38  sendTo sock n (SockAddrInet port_right local)
39  thread 1 port_right sock