static analysis fixes

This commit is contained in:
Amedeo Molnár 2024-12-12 09:09:17 +01:00
parent 73adfff54c
commit fbc2c4da3e
8 changed files with 57 additions and 49 deletions

1
.gitignore vendored
View file

@ -11,3 +11,4 @@ result
*.local
*.svg
*~
.hie/

View file

@ -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
)

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -15,6 +15,8 @@ extra-doc-files: CHANGELOG.md
common warnings
ghc-options: -Wall -threaded -rtsopts
-fwrite-ide-info
-hiedir=.hie
library
import: warnings