# HG changeset patch
# User unc0rr
# Date 1273427588 0
# Node ID 62089ccec75c4732423553aa3f7a8411c75d061d
# Parent  c250116b91362e872b1da40666216398364466ab
Uses StateT monad instead of manually maintaining the state

diff -r c250116b9136 -r 62089ccec75c gameServer/Actions.hs
--- a/gameServer/Actions.hs	Sat May 08 21:50:26 2010 +0000
+++ b/gameServer/Actions.hs	Sun May 09 17:53:08 2010 +0000
@@ -9,6 +9,7 @@
 import Data.Time
 import Maybe
 import Control.Monad.Reader
+import Control.Monad.State
 
 -----------------------------
 import CoreTypes
@@ -48,14 +49,25 @@
 
 type CmdHandler = [String] -> Reader (ClientIndex, IRnC) [Action]
 
+data ActionsState = ActionsState {
+        clientIndex :: Maybe ClientIndex,
+        serverInfo :: ServerInfo,
+        roomsClients :: MRnC
+    }
+    
+clientRoomA :: StateT ActionsState IO RoomIndex
+clientRoomA = do
+    (Just ci) <- gets clientIndex
+    rnc <- gets roomsClients
+    liftIO $ clientRoomM rnc ci
+
 replaceID a (b, c, d, e) = (a, c, d, e)
 
-processAction :: (ClientIndex, ServerInfo, MRnC) -> Action -> IO (ClientIndex, ServerInfo)
+processAction :: Action -> StateT ActionsState IO ()
 
 
-processAction (ci, serverInfo, rnc) (AnswerClients chans msg) = do
-    mapM_ (flip writeChan msg) chans
-    return (ci, serverInfo)
+processAction (AnswerClients chans msg) = 
+    liftIO $ mapM_ (flip writeChan msg) chans
 
 
 {-
@@ -91,24 +103,28 @@
     return (clID, serverInfo, rnc)
 -}
 
-processAction (ci, serverInfo, rnc) (ByeClient msg) = do
-    infoM "Clients" (show ci ++ " quits: " ++ msg)
-
-    ri <- clientRoomM rnc ci
+processAction (ByeClient msg) = do
+    (Just ci) <- gets clientIndex
+    rnc <- gets roomsClients
+    ri <- clientRoomA
     when (ri /= lobbyId) $ do
-        processAction (ci, serverInfo, rnc) $ RoomRemoveThisClient ("quit: " ++ msg)
+        processAction $ RoomRemoveThisClient ("quit: " ++ msg)
         return ()
 
-    --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom
-    --writeChan (sendChan $ clients ! clID) ["BYE", msg]
-    modifyRoom rnc (\r -> r{
-                    --playersIDs = IntSet.delete ci (playersIDs r)
-                    playersIn = (playersIn r) - 1
-                    --readyPlayers = if isReady client then readyPlayers r - 1 else readyPlayers r
-                    }) ri
-    removeClient rnc ci
-    
-    return (ci, serverInfo)
+    liftIO $ do
+        infoM "Clients" (show ci ++ " quits: " ++ msg)
+
+        ri <- clientRoomM rnc ci
+
+        --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom
+        --writeChan (sendChan $ clients ! clID) ["BYE", msg]
+        modifyRoom rnc (\r -> r{
+                        --playersIDs = IntSet.delete ci (playersIDs r)
+                        playersIn = (playersIn r) - 1
+                        --readyPlayers = if isReady client then readyPlayers r - 1 else readyPlayers r
+                        }) ri
+        removeClient rnc ci
+
     
 {-
     where
@@ -360,20 +376,27 @@
         removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove
 -}
 
-processAction (_, serverInfo, rnc) (AddClient client) = do
-    ci <- addClient rnc client
-    forkIO $ clientRecvLoop (clientHandle client) (coreChan serverInfo) ci
-    forkIO $ clientSendLoop (clientHandle client) (coreChan serverInfo) (sendChan client) ci
+processAction (AddClient client) = do
+    rnc <- gets roomsClients
+    si <- gets serverInfo
+    liftIO $ do
+        ci <- addClient rnc client
+        forkIO $ clientRecvLoop (clientHandle client) (coreChan si) ci
+        forkIO $ clientSendLoop (clientHandle client) (coreChan si) (sendChan client) ci
+
+        infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))
+        writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
 
-    infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))
-    writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
-
-    let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo
+{-        let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo
 
-    if False && (isJust $ host client `Prelude.lookup` newLogins) then
-        processAction (ci, serverInfo{lastLogins = newLogins}, rnc) $ ByeClient "Reconnected too fast"
-        else
-        return (ci, serverInfo)
+        if False && (isJust $ host client `Prelude.lookup` newLogins) then
+            processAction (ci, serverInfo{lastLogins = newLogins}, rnc) $ ByeClient "Reconnected too fast"
+            else
+            return (ci, serverInfo)
+-}
+
+
+
 
 {-
 processAction (clID, serverInfo, rnc) PingAll = do
diff -r c250116b9136 -r 62089ccec75c gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Sat May 08 21:50:26 2010 +0000
+++ b/gameServer/ServerCore.hs	Sun May 09 17:53:08 2010 +0000
@@ -7,6 +7,7 @@
 import qualified Data.IntMap as IntMap
 import System.Log.Logger
 import Control.Monad.Reader
+import Control.Monad.State
 --------------------------------------
 import CoreTypes
 import NetRoutines
@@ -20,25 +21,28 @@
 timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
 
 
-reactCmd :: ServerInfo -> ClientIndex -> [String] -> MRnC -> IO ()
-reactCmd sInfo ci cmd rnc = do
-    actions <- withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
-    forM_ actions (processAction (ci, sInfo, rnc))
+reactCmd :: [String] -> StateT ActionsState IO ()
+reactCmd cmd = do
+    (Just ci) <- gets clientIndex
+    rnc <- gets roomsClients
+    actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
+    forM_ actions processAction
 
-mainLoop :: ServerInfo -> MRnC -> IO ()
-mainLoop serverInfo rnc = forever $ do
-    r <- readChan $ coreChan serverInfo
+mainLoop :: StateT ActionsState IO ()
+mainLoop = forever $ do
+    si <- gets serverInfo
+    r <- liftIO $ readChan $ coreChan si
 
     case r of
         Accept ci -> do
-            processAction
-                (undefined, serverInfo, rnc) (AddClient ci)
+            processAction (AddClient ci)
             return ()
 
-        ClientMessage (clID, cmd) -> do
-            debugM "Clients" $ (show clID) ++ ": " ++ (show cmd)
+        ClientMessage (ci, cmd) -> do
+            liftIO $ debugM "Clients" $ (show ci) ++ ": " ++ (show cmd)
+            modify (\as -> as{clientIndex = Just ci})
             --if clID `IntMap.member` clients then
-            reactCmd serverInfo clID cmd rnc
+            reactCmd cmd
             return ()
                 --else
                 --do
@@ -47,9 +51,7 @@
 
         ClientAccountInfo (clID, info) -> do
             --if clID `IntMap.member` clients then
-            processAction
-                (clID, serverInfo, rnc)
-                (ProcessAccountInfo info)
+            processAction (ProcessAccountInfo info)
             return ()
                 --else
                 --do
@@ -79,6 +81,6 @@
 
     rnc <- newRoomsAndClients newRoom
 
-    forkIO $ mainLoop serverInfo rnc
+    forkIO $ evalStateT mainLoop (ActionsState Nothing serverInfo rnc)
 
     forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"