From fbc2c4da3ed44d60845808fecb95871122a3d144 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Amedeo=20Moln=C3=A1r?= Date: Thu, 12 Dec 2024 09:09:17 +0100 Subject: [PATCH] static analysis fixes --- .gitignore | 1 + src-client/Client/Graphics.hs | 8 ++-- src-server/Server/Communication.hs | 6 ++- src-server/Server/Communication/Handler.hs | 18 +++++--- src-server/Server/Communication/Send.hs | 7 +-- src-server/Server/Game.hs | 12 +++-- src-server/Server/Types.hs | 52 +++++++++++----------- wizard-wipeout.cabal | 2 + 8 files changed, 57 insertions(+), 49 deletions(-) diff --git a/.gitignore b/.gitignore index 752b0e7..f7c11b7 100644 --- a/.gitignore +++ b/.gitignore @@ -11,3 +11,4 @@ result *.local *.svg *~ +.hie/ diff --git a/src-client/Client/Graphics.hs b/src-client/Client/Graphics.hs index 4ad70ff..78d24d9 100644 --- a/src-client/Client/Graphics.hs +++ b/src-client/Client/Graphics.hs @@ -4,9 +4,9 @@ import qualified Control.Concurrent.STM as STM import Control.Monad.RWS -import qualified Data.Matrix as M +import Data.List (foldl') -import Debug.Trace +import qualified Data.Matrix as M import Graphics.Vty @@ -48,7 +48,7 @@ draw = do (\y -> map (\x -> - getPixel $ foldl + getPixel $ foldl' (\acc coord@(row, col) -> if mapSlice M.! coord == Just Wall then @@ -67,7 +67,7 @@ draw = do [1 .. w] ) [1 .. h] - image = foldl + image = foldl' (\img line -> img <-> string defAttr line ) diff --git a/src-server/Server/Communication.hs b/src-server/Server/Communication.hs index a604808..3fe968e 100644 --- a/src-server/Server/Communication.hs +++ b/src-server/Server/Communication.hs @@ -18,7 +18,7 @@ import Control.Monad.RWS.Strict import Data.List (find) -import Data.Maybe (fromJust) +import Data.Maybe (fromMaybe) import Network.Socket as Net @@ -91,7 +91,9 @@ disconnectClients curLevel clientSockets queueList = do threadDelay 1000 -- wait for the message to be actually sent sock <- do socketList <- STM.atomically $ STM.readTMVar clientSockets - pure $ fromJust $ find (\s -> csUUID s == Just uuid) socketList + pure $ fromMaybe + (error $ "Socket not present for client: " <> show uuid) + (find (\s -> csUUID s == Just uuid) socketList) dropClient curLevel clientSockets queueList (csSocket sock) ) (cqUUID queue) diff --git a/src-server/Server/Communication/Handler.hs b/src-server/Server/Communication/Handler.hs index fb11595..0df8d65 100644 --- a/src-server/Server/Communication/Handler.hs +++ b/src-server/Server/Communication/Handler.hs @@ -17,13 +17,16 @@ import Data.Time import Data.UUID.V4 +import System.Random (randomRIO) + +-- internal imports + import Library.Types import Server.Communication.Send import Server.Log import Server.Types import Server.Util -import System.Random (randomRIO) -- | function for translating 'ClientMessage's into server actions handleMessage @@ -42,9 +45,9 @@ handleMessage stateContainer readerContainer msg = do IdRequest -> do clientId <- nextRandom threadDelay 1000 - let clientIdx = findIndex (isNothing . csUUID) socks - sock = socks !! fromJust clientIdx - queue = queues !! fromJust clientIdx + let clientIdx = fromMaybe (error "no socket found of new client") (findIndex (isNothing . csUUID) socks) + sock = socks !! clientIdx + queue = queues !! clientIdx if csUUID sock == cqUUID queue then do let otherSocks = delete sock socks @@ -118,11 +121,12 @@ handleMessage stateContainer readerContainer msg = do else do now <- getCurrentTime STM.atomically$ do - let otherPlayers = filter (\a -> playerId a /= playerId player) players - modPlayer = player + let !otherPlayers = filter (\a -> playerId a /= playerId player) players + !modPlayer = player { playerLastPong = (now, pongUuid) } - void $ STM.swapTMVar (scPlayers stateContainer) (modPlayer : otherPlayers) + !newPlayers = modPlayer : otherPlayers + void $ STM.swapTMVar (scPlayers stateContainer) newPlayers sendUpdate curLevel stateContainer (rcMap readerContainer) player ) mPlayer diff --git a/src-server/Server/Communication/Send.hs b/src-server/Server/Communication/Send.hs index 6468002..261aca7 100644 --- a/src-server/Server/Communication/Send.hs +++ b/src-server/Server/Communication/Send.hs @@ -151,16 +151,17 @@ dropClient curLevel socketList queueList sock = do maybe (logPrintIO curLevel Warning $ "closing unknown socket: " <> show sock) (\client -> do - logPrintIO curLevel Info $ "killing client sender and listener because of socket closing: " <> show (fromJust $ csUUID client) + let clientUUID = fromMaybe (error "no UUID for client?!") (csUUID client) + logPrintIO curLevel Info $ "killing client sender and listener because of socket closing: " <> show clientUUID killThread (csSender client) killThread (csReceiver client) - logPrintIO curLevel Info $ "dropping client because of socket closing: " <> show (fromJust $ csUUID client) + logPrintIO curLevel Info $ "dropping client because of socket closing: " <> show clientUUID ) mClient STM.atomically $ do queues <- STM.readTMVar queueList let reducedClients = filter (\client -> csSocket client /= sock) clients - reducedQueues = filter (\queue -> cqUUID queue /= csUUID (fromJust mClient)) queues + reducedQueues = filter (\queue -> cqUUID queue /= csUUID (fromMaybe (error "What happened to the client?!") mClient)) queues void $ STM.swapTMVar socketList reducedClients void $ STM.swapTMVar queueList reducedQueues close sock diff --git a/src-server/Server/Game.hs b/src-server/Server/Game.hs index 93f1798..76d1e67 100644 --- a/src-server/Server/Game.hs +++ b/src-server/Server/Game.hs @@ -16,8 +16,6 @@ import Data.Time import Data.String (fromString) -import System.IO (stdout) - -- internal imports import Server.Game.Update @@ -37,11 +35,11 @@ runGame = do handleMessages -- updateSpawners delta -- updateWizards delta - -- modify' - -- (\s -> s - -- { scServerLastTick = now - -- } - -- ) + modify' + (\s -> s + { scServerLastTick = now + } + ) fps <- asks rcFPS sendPings let remainingTime = recip (fromIntegral fps) - delta diff --git a/src-server/Server/Types.hs b/src-server/Server/Types.hs index 059c648..85ef84f 100644 --- a/src-server/Server/Types.hs +++ b/src-server/Server/Types.hs @@ -25,14 +25,14 @@ import Options.Applicative as O import Library.Types data Settings = Settings - { setSocketPath :: FilePath - , setMapRows :: Int - , setMapColumns :: Int - , setSpawnerProbability :: Float - , setFPS :: Int - , setClientMaxTimeout :: Float - , setFramesPerPing :: Int - , setLogLevel :: LogLevel + { setSocketPath :: !FilePath + , setMapRows :: !Int + , setMapColumns :: !Int + , setSpawnerProbability :: !Float + , setFPS :: !Int + , setClientMaxTimeout :: !Float + , setFramesPerPing :: !Int + , setLogLevel :: !LogLevel } deriving (Show, Generic) @@ -61,12 +61,12 @@ options = Options ) data ReaderContainer = ReaderContainer - { rcMap :: ServerMap - , rcFPS :: Int - , rcFramesPerPing :: Int - , rcClientMaxTimeout :: Float - , rcMainSocket :: Socket - , rcLogLevel :: LogLevel + { rcMap :: !ServerMap + , rcFPS :: !Int + , rcFramesPerPing :: !Int + , rcClientMaxTimeout :: !Float + , rcMainSocket :: !Socket + , rcLogLevel :: !LogLevel } deriving (Eq, Show) @@ -81,31 +81,31 @@ data StateContainer = StateContainer } data ClientSocket = ClientSocket - { csUUID :: Maybe UUID - , csSocket :: Socket - , csSender :: ThreadId - , csReceiver :: ThreadId + { csUUID :: !(Maybe UUID) + , csSocket :: !Socket + , csSender :: !ThreadId + , csReceiver :: !ThreadId } deriving (Eq) data ClientQueue = ClientQueue - { cqUUID :: Maybe UUID - , cqQueue :: STM.TQueue ServerMessage + { cqUUID :: !(Maybe UUID) + , cqQueue :: !(STM.TQueue ServerMessage) } deriving (Eq) data Player = Player - { playerId :: UUID - , playerWizard :: Wizard - , playerReady :: Bool - , playerLastPong :: (UTCTime, UUID) + { playerId :: !UUID + , playerWizard :: !Wizard + , playerReady :: !Bool + , playerLastPong :: !(UTCTime, UUID) } deriving (Eq, Show) -- | Data object for storing the server's state data ServerState = ServerState - { serverGameOver :: Bool -- ^ global game over state (only one contestant left) - , serverStop :: Bool -- ^ Server shutdown + { serverGameOver :: !Bool -- ^ global game over state (only one contestant left) + , serverStop :: !Bool -- ^ Server shutdown } deriving (Show, Eq) diff --git a/wizard-wipeout.cabal b/wizard-wipeout.cabal index 8b12036..e884a63 100644 --- a/wizard-wipeout.cabal +++ b/wizard-wipeout.cabal @@ -15,6 +15,8 @@ extra-doc-files: CHANGELOG.md common warnings ghc-options: -Wall -threaded -rtsopts + -fwrite-ide-info + -hiedir=.hie library import: warnings