diff --git a/src-server/Main.hs b/src-server/Main.hs index 0f65df6..97ff6c3 100644 --- a/src-server/Main.hs +++ b/src-server/Main.hs @@ -68,7 +68,7 @@ main = do sock logLevel initState = StateContainer (arenaSpawners arena) emptyPLayers serverState now sockList queueList messageQueue - (finalState, finalWrite) <- execRWST + (_finalState, _finalWrite) <- execRWST (do terminateGameOnSigint runGame diff --git a/src-server/Server/Communication.hs b/src-server/Server/Communication.hs index 84ec84a..a604808 100644 --- a/src-server/Server/Communication.hs +++ b/src-server/Server/Communication.hs @@ -63,7 +63,7 @@ terminateGameOnSigint = do (CatchOnce $ do logPrintIO curLevel Info "SIGINT caught, terminating…" disconnectClients curLevel clientList queueList - threadDelay (10 ^ 6) + threadDelay (10 ^ (6 :: Int)) close sock st <- STM.atomically $ STM.readTMVar serverState void $ STM.atomically $ STM.swapTMVar serverState $ st @@ -121,13 +121,13 @@ processRequests = do sockContainer <- STM.newTMVarIO clientSock receiverThreadId <- liftIO $ do t <- forkIO $ do - threadDelay $ 10 ^ 6 + threadDelay $ 10 ^ (6 :: Int) forever $ receiveMessage curLevel socketList queueList sockContainer serverQueue logPrintIO curLevel Verbose "enabled listener thread" pure t senderThreadId <- liftIO $ do t <- forkIO $ do - threadDelay $ 10 ^ 6 + threadDelay $ 10 ^ (6 :: Int) forever $ sendMessageQueue curLevel sockContainer clientQueue logPrintIO curLevel Verbose "enabled sender thread" pure t diff --git a/src-server/Server/Communication/Receive.hs b/src-server/Server/Communication/Receive.hs index b9054aa..9ec043d 100644 --- a/src-server/Server/Communication/Receive.hs +++ b/src-server/Server/Communication/Receive.hs @@ -7,8 +7,6 @@ import qualified Control.Concurrent.STM as STM import Control.Exception -import Control.Monad.IO.Class - import qualified Data.Aeson as A import qualified Data.ByteString as B diff --git a/src-server/Server/Communication/Send.hs b/src-server/Server/Communication/Send.hs index a445aad..6468002 100644 --- a/src-server/Server/Communication/Send.hs +++ b/src-server/Server/Communication/Send.hs @@ -94,7 +94,7 @@ sendMessageQueue curLevel sockContainer queue = do sendPings :: Game () sendPings = do now <- liftIO getCurrentTime - maxTimeout <- asks rcClientMaxTimeout + _maxTimeout <- asks rcClientMaxTimeout framesPerPing <- asks rcFramesPerPing curLevel <- asks rcLogLevel fps <- asks rcFPS diff --git a/src-server/Server/Game.hs b/src-server/Server/Game.hs index 7e0e1a4..93f1798 100644 --- a/src-server/Server/Game.hs +++ b/src-server/Server/Game.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} module Server.Game where import Control.Concurrent @@ -47,6 +46,6 @@ runGame = do sendPings let remainingTime = recip (fromIntegral fps) - delta when (remainingTime > 0) $ - liftIO $ threadDelay $ floor $ remainingTime * 10 ^ 6 + liftIO $ threadDelay $ floor (remainingTime * 10 ^ (6 :: Int) :: Float) ) - liftIO $ threadDelay (10 ^ 6) + liftIO $ threadDelay (10 ^ (6 :: Int)) diff --git a/src-server/Server/Game/Update.hs b/src-server/Server/Game/Update.hs index 42dc123..438dcb4 100644 --- a/src-server/Server/Game/Update.hs +++ b/src-server/Server/Game/Update.hs @@ -8,6 +8,8 @@ import Control.Monad.Reader import Control.Monad.State +import Data.List (foldl') + -- internal imports import Library.Types @@ -40,8 +42,8 @@ updateWizards dt = do playersVar <- gets scPlayers players <- liftIO $ STM.atomically $ STM.readTMVar playersVar let newPlayers = map - (\player@(Player pId wizard@(Wizard _ _ health _ _ effects) readiness lastPong) -> - let newEffects = foldl + (\player@(Player _pId wizard@(Wizard _ _ health _ _ effects) readiness _lastPong) -> + let newEffects = foldl' (\acc effect@(Effect _ ttl) -> if ttl - dt < 0 then acc @@ -51,7 +53,7 @@ updateWizards dt = do ) [] effects - effectDamage = foldl + effectDamage = foldl' (\acc (Effect kind _) -> if kind `elem` harmingAfflictions then acc + 1 diff --git a/src-server/Server/Types.hs b/src-server/Server/Types.hs index 7fabf09..059c648 100644 --- a/src-server/Server/Types.hs +++ b/src-server/Server/Types.hs @@ -71,13 +71,13 @@ data ReaderContainer = ReaderContainer deriving (Eq, Show) data StateContainer = StateContainer - { scSpawners :: [Spawner] - , scPlayers :: STM.TMVar [Player] - , scServerState :: STM.TMVar ServerState - , scServerLastTick :: UTCTime - , scClientSockets :: STM.TMVar [ClientSocket] - , scClientQueues :: STM.TMVar [ClientQueue] - , scMessageQueue :: STM.TQueue ClientMessage + { scSpawners :: ![Spawner] + , scPlayers :: !(STM.TMVar [Player]) + , scServerState :: !(STM.TMVar ServerState) + , scServerLastTick :: !UTCTime + , scClientSockets :: !(STM.TMVar [ClientSocket]) + , scClientQueues :: !(STM.TMVar [ClientQueue]) + , scMessageQueue :: !(STM.TQueue ClientMessage) } data ClientSocket = ClientSocket diff --git a/wizard-wipeout.cabal b/wizard-wipeout.cabal index 97bbd06..8b12036 100644 --- a/wizard-wipeout.cabal +++ b/wizard-wipeout.cabal @@ -75,6 +75,8 @@ executable wizard-wipeout-server Server.Map Server.Types Server.Util + default-extensions: + StrictData -- other-extensions: build-depends: base >=4.17.2.1 , aeson