From 087ae2d07231e8f317b98b54a3a3f66bf4db3a04 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@nek0.eu>
Date: Tue, 12 Dec 2023 03:31:57 +0100
Subject: [PATCH] some little optimizations

---
 src-server/Server/Communication.hs | 29 +++++++++++++++++------------
 src-server/Server/Game.hs          |  5 +++--
 2 files changed, 20 insertions(+), 14 deletions(-)

diff --git a/src-server/Server/Communication.hs b/src-server/Server/Communication.hs
index 46315aa..9dffe22 100644
--- a/src-server/Server/Communication.hs
+++ b/src-server/Server/Communication.hs
@@ -22,7 +22,6 @@ import qualified Data.Matrix as M
 
 import Data.Maybe
 
-import Data.UUID
 import Data.UUID.V4
 
 import qualified Data.Vector.Storable as VS
@@ -115,24 +114,30 @@ sendMessage msg sock = do
     msgVector
     (\ptr -> void $ sendBuf sock ptr (VS.length msgVector))
 
--- | process incoming messages from clients
-processMessages :: Game ()
-processMessages = do
+-- | receive incoming messages from clients
+receiveMessages :: Game ()
+receiveMessages = do
   clientsVar <- gets scClientSockets
   clients <- liftIO $ STM.atomically $ STM.readTMVar clientsVar
   queue <- gets scMessageQueue
-  serverState <- get
-  readerContainer <- ask
-  mapM_
-    (\(uuid, clientSocket) -> void $ liftIO $ forkIO $ do
+  void $ liftIO $ forkIO $ mapM_
+    (\(_, clientSocket) -> do
       receiveMessage clientSocket queue
-      msgs <- liftIO $ STM.atomically $ STM.flushTQueue queue
-      mapM_
-        (handleMessage serverState readerContainer)
-        msgs
     )
     clients
 
+-- | handle received messages
+handleMessages :: Game ()
+handleMessages = do
+  queue <- gets scMessageQueue
+  serverState <- get
+  readerContainer <- ask
+  msgs <- liftIO $ STM.atomically $ STM.flushTQueue queue
+  void $ liftIO $ do
+    mapM_
+      (handleMessage serverState readerContainer)
+      msgs
+
 -- | receive a 'ClientMessage'
 receiveMessage
   :: Socket
diff --git a/src-server/Server/Game.hs b/src-server/Server/Game.hs
index e2eefc6..3587a7f 100644
--- a/src-server/Server/Game.hs
+++ b/src-server/Server/Game.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Server.Game where
 
-import Control.Concurrent (threadDelay, killThread)
+import Control.Concurrent (threadDelay)
 
 import qualified Control.Concurrent.STM as STM
 
@@ -34,7 +34,8 @@ runGame = do
       now <- liftIO getCurrentTime
       let delta = realToFrac $ diffUTCTime now before
       liftIO $ B8.hPutStr stdout $ "tick: " <> fromString (show delta) <> "  \r"
-      processMessages
+      receiveMessages
+      handleMessages
       updateSpawners delta
       updateWizards delta
       modify'