# HG changeset patch
# User unc0rr
# Date 1296155202 -10800
# Node ID 31e042ab870c3a3b0b8c133434188389661bbbd4
# Parent  cd4433b44920e57f56d53da871ee14f706c63c9a
Finally a solution for excess lazyness when working with unsafeThaw'ed arrays

diff -r cd4433b44920 -r 31e042ab870c gameServer/Actions.hs
--- a/gameServer/Actions.hs	Wed Jan 26 22:26:02 2011 +0300
+++ b/gameServer/Actions.hs	Thu Jan 27 22:06:42 2011 +0300
@@ -13,6 +13,7 @@
 import Control.Monad.Reader
 import Control.Monad.State.Strict
 import qualified Data.ByteString.Char8 as B
+import Control.DeepSeq
 -----------------------------
 import CoreTypes
 import Utils
@@ -52,6 +53,12 @@
 
 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
 
+instance NFData Action where
+    rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
+    rnf a = a `seq` ()
+
+instance NFData B.ByteString
+instance NFData (Chan a)
 
 othersChans = do
     cl <- client's id
@@ -62,7 +69,7 @@
 
 
 processAction (AnswerClients chans msg) = do
-    liftIO $ map (flip seq ()) chans `seq` map (flip seq ()) msg `seq` mapM_ (flip writeChan msg) chans
+    liftIO $ mapM_ (flip writeChan msg) chans
 
 
 processAction SendServerMessage = do
@@ -177,11 +184,11 @@
 processAction (MoveToRoom ri) = do
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
+
     liftIO $ do
         modifyClient rnc (\cl -> cl{teamsInGame = 0, isReady = False, isMaster = False}) ci
         modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) ri
-
-    liftIO $ moveClientToRoom rnc ri ci
+        moveClientToRoom rnc ri ci
 
     chans <- liftM (map sendChan) $ roomClientsS ri
     clNick <- client's nick
diff -r cd4433b44920 -r 31e042ab870c gameServer/HWProtoLobbyState.hs
--- a/gameServer/HWProtoLobbyState.hs	Wed Jan 26 22:26:02 2011 +0300
+++ b/gameServer/HWProtoLobbyState.hs	Thu Jan 27 22:06:42 2011 +0300
@@ -9,6 +9,7 @@
 import Data.Word
 import Control.Monad.Reader
 import qualified Data.ByteString.Char8 as B
+import Control.DeepSeq
 --------------------------------------
 import CoreTypes
 import Actions
@@ -76,7 +77,9 @@
     let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris
     let jRI = fromJust maybeRI
     let jRoom = irnc `room` jRI
-    let jRoomClients = map (client irnc) $! roomClients irnc jRI -- no lazyness here!
+    let jRoomClients = map (client irnc) $ roomClients irnc jRI
+    let nicks = map nick jRoomClients
+    let chans = map sendChan (cl : jRoomClients)
     return $
         if isNothing maybeRI then 
             [Warning "No such rooms"]
@@ -87,8 +90,8 @@
             else
             [
                 MoveToRoom jRI,
-                AnswerClients (map sendChan $ cl : jRoomClients) ["NOT_READY", nick cl],
-                AnswerClients [sendChan cl] $ "JOINED" : map nick jRoomClients
+                AnswerClients [sendChan cl] $ "JOINED" : nicks,
+                AnswerClients chans ["NOT_READY", nick cl]
             ]
             ++ (map (readynessMessage cl) jRoomClients)
             ++ (answerFullConfig cl $ params jRoom)
@@ -113,50 +116,6 @@
                     AnswerClients [sendChan cl] $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)]
 
 
-
-{-
-
-handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, roomPassword]
-    | noSuchRoom = [Warning "No such room"]
-    | isRestrictedJoins jRoom = [Warning "Joining restricted"]
-    | roomPassword /= password jRoom = [Warning "Wrong password"]
-    | otherwise =
-        [RoomRemoveThisClient "", -- leave lobby
-        RoomAddThisClient rID] -- join room
-        ++ answerNicks
-        ++ answerReady
-        ++ [AnswerThisRoom ["NOT_READY", nick client]]
-        ++ answerFullConfig
-        ++ answerTeams
-        ++ watchRound
-    where
-        answerNicks =
-            [AnswerThisClient $ "JOINED" :
-            map (\clID -> nick $ clients IntMap.! clID) roomClientsIDs | playersIn jRoom /= 0]
-        answerReady = map
-            ((\ c ->
-                AnswerThisClient
-                [if isReady c then "READY" else "NOT_READY", nick c])
-            . (\ clID -> clients IntMap.! clID))
-            roomClientsIDs
-
-        toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs
-
-        answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart)
-        (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom)
-
-        watchRound = if not $ gameinprogress jRoom then
-                    []
-                else
-                    [AnswerThisClient  ["RUN_GAME"],
-                    AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)]
-
-        answerTeams = if gameinprogress jRoom then
-                answerAllTeams (clientProto client) (teamsAtStart jRoom)
-            else
-                answerAllTeams (clientProto client) (teams jRoom)
--}
-
 handleCmd_lobby ["JOIN_ROOM", roomName] =
     handleCmd_lobby ["JOIN_ROOM", roomName, ""]
 
diff -r cd4433b44920 -r 31e042ab870c gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Wed Jan 26 22:26:02 2011 +0300
+++ b/gameServer/ServerCore.hs	Thu Jan 27 22:06:42 2011 +0300
@@ -10,6 +10,7 @@
 import Control.Monad.State.Strict
 import Data.Set as Set
 import qualified Data.ByteString.Char8 as B
+import Control.DeepSeq
 --------------------------------------
 import CoreTypes
 import NetRoutines
@@ -28,7 +29,7 @@
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
     actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
-    forM_ actions processAction
+    forM_ (actions `deepseq` actions) processAction
 
 mainLoop :: StateT ServerState IO ()
 mainLoop = forever $ do
diff -r cd4433b44920 -r 31e042ab870c gameServer/hedgewars-server.cabal
--- a/gameServer/hedgewars-server.cabal	Wed Jan 26 22:26:02 2011 +0300
+++ b/gameServer/hedgewars-server.cabal	Thu Jan 27 22:06:42 2011 +0300
@@ -27,6 +27,7 @@
     mtl,
     dataenc,
     hslogger,
-    process
-  
-  ghc-options: -O2
\ No newline at end of file
+    process,
+    deepseq
+
+  ghc-options: -O2