static analysis fixes
This commit is contained in:
parent
73adfff54c
commit
fbc2c4da3e
8 changed files with 57 additions and 49 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -11,3 +11,4 @@ result
|
|||
*.local
|
||||
*.svg
|
||||
*~
|
||||
.hie/
|
||||
|
|
|
@ -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
|
||||
)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -15,6 +15,8 @@ extra-doc-files: CHANGELOG.md
|
|||
|
||||
common warnings
|
||||
ghc-options: -Wall -threaded -rtsopts
|
||||
-fwrite-ide-info
|
||||
-hiedir=.hie
|
||||
|
||||
library
|
||||
import: warnings
|
||||
|
|
Loading…
Reference in a new issue