hedgewars: comparison gameServer/Actions.hs

equal deleted inserted replaced

-:a9e4093a7e78
+:08ae94dd4c0d
 processAction :: Action -> StateT ServerState IO ()
 processAction (AnswerClients chans msg) = do
-liftIO $ mapM_ (flip writeChan msg) chans
+io $ mapM_ (flip writeChan msg) chans
 processAction SendServerMessage = do
 chan <- client's sendChan
 protonum <- client's clientProto
 when (ri /= lobbyId) $ do
 processAction $ MoveToLobby ("quit: " `B.append` msg)
 return ()
-liftIO $ do
+io $ do
 infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg))
 --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom
 processAction $ AnswerClients [chan] ["BYE", msg]
 s <- get
 put $! s{removedClients = ci `Set.insert` removedClients s}
 processAction (DeleteClient ci) = do
 rnc <- gets roomsClients
-liftIO $ removeClient rnc ci
+io $ removeClient rnc ci
 s <- get
 put $! s{removedClients = ci `Set.delete` removedClients s}
 {-
 -}
 processAction (ModifyClient f) = do
 (Just ci) <- gets clientIndex
 rnc <- gets roomsClients
-liftIO $ modifyClient rnc f ci
+io $ modifyClient rnc f ci
 return ()
 processAction (ModifyClient2 ci f) = do
 rnc <- gets roomsClients
-liftIO $ modifyClient rnc f ci
+io $ modifyClient rnc f ci
 return ()
 processAction (ModifyRoom f) = do
 rnc <- gets roomsClients
 ri <- clientRoomA
-liftIO $ modifyRoom rnc f ri
+io $ modifyRoom rnc f ri
 return ()
 {-
 processAction (clID, serverInfo, rnc) (ModifyServerInfo func) =
 processAction (MoveToRoom ri) = do
 (Just ci) <- gets clientIndex
 rnc <- gets roomsClients
-liftIO $ do
+io $ do
 modifyClient rnc (\cl -> cl{teamsInGame = 0, isReady = False, isMaster = False}) ci
 modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) ri
 moveClientToRoom rnc ri ci
 chans <- liftM (map sendChan) $ roomClientsS ri
 clNick <- client's nick
 clChan <- client's sendChan
 chans <- othersChans
 mapM_ processAction [AnswerClients chans ["LEFT", clNick, msg], RemoveClientTeams ci]
-liftIO $ do
+io $ do
 modifyRoom rnc (\r -> r{
 playersIn = (playersIn r) - 1,
 readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
 }) ri
 moveClientToLobby rnc ci
 -}
 processAction (AddRoom roomName roomPassword) = do
 Just clId <- gets clientIndex
 rnc <- gets roomsClients
-proto <- liftIO $ client'sM rnc clientProto clId
+proto <- io $ client'sM rnc clientProto clId
 let room = newRoom{
 masterID = clId,
 name = roomName,
 password = roomPassword,
 roomProto = proto
 }
-rId <- liftIO $ addRoom rnc room
+rId <- io $ addRoom rnc room
 processAction $ MoveToRoom rId
 chans <- liftM (map sendChan) $! roomClientsS lobbyId
 processAction RemoveRoom = do
 Just clId <- gets clientIndex
 rnc <- gets roomsClients
-ri <- liftIO $ clientRoomM rnc clId
+ri <- io $ clientRoomM rnc clId
-roomName <- liftIO $ room'sM rnc name ri
+roomName <- io $ room'sM rnc name ri
 others <- othersChans
 lobbyChans <- liftM (map sendChan) $! roomClientsS lobbyId
 mapM_ processAction [
 AnswerClients lobbyChans ["ROOM", "DEL", roomName],
 AnswerClients others ["ROOMABANDONED", roomName]
 ]
-liftIO $ removeRoom rnc ri
+io $ removeRoom rnc ri
 processAction (UnreadyRoomClients) = do
 rnc <- gets roomsClients
 ri <- clientRoomA
 roomPlayers <- roomClientsS ri
-roomClIDs <- liftIO $ roomClientsIndicesM rnc ri
+roomClIDs <- io $ roomClientsIndicesM rnc ri
 processAction $ AnswerClients (map sendChan roomPlayers) ("NOT_READY" : map nick roomPlayers)
-liftIO $ mapM_ (modifyClient rnc (\cl -> cl{isReady = False})) roomClIDs
+io $ mapM_ (modifyClient rnc (\cl -> cl{isReady = False})) roomClIDs
 processAction $ ModifyRoom (\r -> r{readyPlayers = 0})
 processAction (RemoveTeam teamName) = do
 rnc <- gets roomsClients
 cl <- client's id
 ri <- clientRoomA
-inGame <- liftIO $ room'sM rnc gameinprogress ri
+inGame <- io $ room'sM rnc gameinprogress ri
 chans <- othersChans
 if inGame then
 mapM_ processAction [
 AnswerClients chans ["REMOVE_TEAM", teamName],
 ModifyRoom (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r})
 processAction (RemoveClientTeams clId) = do
 rnc <- gets roomsClients
-removeTeamActions <- liftIO $ do
+removeTeamActions <- io $ do
 clNick <- client'sM rnc nick clId
 rId <- clientRoomM rnc clId
 roomTeams <- room'sM rnc teams rId
 return . Prelude.map (RemoveTeam . teamname) . Prelude.filter (\t -> teamowner t == clNick) $ roomTeams
 processAction CheckRegistered = do
 (Just ci) <- gets clientIndex
 n <- client's nick
 h <- client's host
 db <- gets (dbQueries . serverInfo)
-liftIO $ writeChan db $ CheckAccount ci n h
+io $ writeChan db $ CheckAccount ci n h
 return ()
 processAction ClearAccountsCache = do
 dbq <- gets (dbQueries . serverInfo)
-liftIO $ writeChan dbq ClearCache
+io $ writeChan dbq ClearCache
 return ()
 processAction (ProcessAccountInfo info) =
 case info of
 -}
 processAction (AddClient client) = do
 rnc <- gets roomsClients
 si <- gets serverInfo
-liftIO $ do
+io $ do
 ci <- addClient rnc client
 t <- forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci
 forkIO $ clientSendLoop (clientSocket client) t (coreChan si) (sendChan client) ci
 infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))
 processAction PingAll = do
 rnc <- gets roomsClients
-liftIO (allClientsM rnc) >>= mapM_ (kickTimeouted rnc)
+io (allClientsM rnc) >>= mapM_ (kickTimeouted rnc)
-cis <- liftIO $ allClientsM rnc
+cis <- io $ allClientsM rnc
-chans <- liftIO $ mapM (client'sM rnc sendChan) cis
+chans <- io $ mapM (client'sM rnc sendChan) cis
-liftIO $ mapM_ (modifyClient rnc (\cl -> cl{pingsQueue = pingsQueue cl + 1})) cis
+io $ mapM_ (modifyClient rnc (\cl -> cl{pingsQueue = pingsQueue cl + 1})) cis
 processAction $ AnswerClients chans ["PING"]
 where
 kickTimeouted rnc ci = do
-pq <- liftIO $ client'sM rnc pingsQueue ci
+pq <- io $ client'sM rnc pingsQueue ci
 when (pq > 0) $
 withStateT (\as -> as{clientIndex = Just ci}) $
 processAction (ByeClient "Ping timeout")
 processAction (StatsAction) = do
 rnc <- gets roomsClients
 si <- gets serverInfo
-(roomsNum, clientsNum) <- liftIO $ withRoomsAndClients rnc stats
+(roomsNum, clientsNum) <- io $ withRoomsAndClients rnc stats
-liftIO $ writeChan (dbQueries si) $ SendStats clientsNum (roomsNum - 1)
+io $ writeChan (dbQueries si) $ SendStats clientsNum (roomsNum - 1)
 where
 stats irnc = (length $ allRooms irnc, length $ allClients irnc)

branch	server_refactor
changeset 4601	08ae94dd4c0d
parent 4599	a9e4093a7e78
child 4604	831a4b91e9bc