equal
deleted
inserted
replaced
21 |
21 |
22 timerLoop :: Int -> Chan CoreMessage -> IO () |
22 timerLoop :: Int -> Chan CoreMessage -> IO () |
23 timerLoop tick messagesChan = threadDelay 30000000 >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan |
23 timerLoop tick messagesChan = threadDelay 30000000 >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan |
24 |
24 |
25 |
25 |
26 reactCmd :: [B.ByteString] -> StateT ServerState IO () |
26 reactCmd :: [B.ByteString] -> StateT (ServerState c) IO () |
27 reactCmd cmd = do |
27 reactCmd cmd = do |
28 (Just ci) <- gets clientIndex |
28 (Just ci) <- gets clientIndex |
29 rnc <- gets roomsClients |
29 rnc <- gets roomsClients |
30 actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc)) |
30 actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc)) |
31 forM_ (actions `deepseq` actions) processAction |
31 forM_ (actions `deepseq` actions) processAction |
32 |
32 |
33 mainLoop :: StateT ServerState IO () |
33 mainLoop :: StateT (ServerState c) IO () |
34 mainLoop = forever $ do |
34 mainLoop = forever $ do |
35 -- get >>= \s -> put $! s |
35 -- get >>= \s -> put $! s |
36 |
36 |
37 si <- gets serverInfo |
37 si <- gets serverInfo |
38 r <- liftIO $ readChan $ coreChan si |
38 r <- liftIO $ readChan $ coreChan si |
66 TimerAction tick -> |
66 TimerAction tick -> |
67 mapM_ processAction $ |
67 mapM_ processAction $ |
68 PingAll : [StatsAction | even tick] |
68 PingAll : [StatsAction | even tick] |
69 |
69 |
70 |
70 |
71 startServer :: ServerInfo -> Socket -> IO () |
71 startServer :: ServerInfo c -> Socket -> IO () |
72 startServer si serverSocket = do |
72 startServer si serverSocket = do |
73 putStrLn $ "Listening on port " ++ show (listenPort si) |
73 putStrLn $ "Listening on port " ++ show (listenPort si) |
74 |
74 |
75 _ <- forkIO $ |
75 _ <- forkIO $ |
76 acceptLoop |
76 acceptLoop |