client: found and fixed mem leak

This commit is contained in:
nek0 2024-04-07 13:35:48 +02:00
parent 3349d21195
commit ff3fd6415f
5 changed files with 25 additions and 17 deletions

View file

@ -1,11 +1,14 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BangPatterns #-}
module Client.Communication where
import Control.Exception
import qualified Control.Concurrent.STM as STM
import Control.Monad
import Control.Monad.RWS
import qualified Data.Aeson as A
@ -51,10 +54,11 @@ sendMessage st msg sock = do
VS.unsafeWith
msgVector
(\ptr -> do
eResult <- try $ sendBuf sock ptr (VS.length msgVector)
case eResult of
Left (_ :: IOException) -> gracefulExit st "sendMessage: Quitting due to connection loss…"
Right _ -> pure ()
void $ sendBuf sock ptr (VS.length msgVector)
-- eResult <- try $ sendBuf sock ptr (VS.length msgVector)
-- case eResult of
-- Left (_ :: IOException) -> gracefulExit st "sendMessage: Quitting due to connection loss…"
-- Right _ -> pure ()
)
handleMessages
@ -88,13 +92,13 @@ handleMessage (Ping id') = do
)
sock
handleMessage (TickUpdate slice wizard) = do
modify' (\st@(StateContainer {}) ->
st
{ scWizard = wizard
, scMapSlice = slice
}
)
-- handleMessage (TickUpdate !slice !wizard) = do
-- st <- get
-- let !newState = st
-- { scWizard = wizard
-- , scMapSlice = slice
-- }
-- put newState
handleMessage x =
liftIO $ putStrLn $ "received unexpected message from server: " <> show x
@ -160,7 +164,7 @@ terminateGameOnSigint = do
-- Vty.shutdown (clientVty currentState)
partingMessage st clientId sock
-- Raise SIGINT again so it does not get blocked
raiseSignal keyboardSignal
-- raiseSignal keyboardSignal
)
Nothing

View file

@ -32,9 +32,10 @@ runGame = do
(not . clientStop <$> (liftIO . STM.atomically . STM.readTMVar =<< gets scClientState))
(do
handleMessages
pure ()
-- draw
)
-- liftIO $ killThread recvThread
liftIO $ killThread recvThread
handleEvent
:: Maybe Event

View file

@ -82,6 +82,7 @@ main = do
partingMessage initState clientId sock
threadDelay 100
close sock
putStrLn "bye bye"
where
opts = info (options <**> helper)
( fullDesc

View file

@ -5,6 +5,8 @@ import Control.Concurrent
import qualified Control.Concurrent.STM as STM
import Control.Monad
import Control.Monad.RWS.Strict
import Control.Monad.Loops

View file

@ -14,7 +14,7 @@ extra-doc-files: CHANGELOG.md
-- extra-source-files:
common warnings
ghc-options: -Wall -threaded -prof
ghc-options: -Wall -threaded -rtsopts
library
import: warnings
@ -22,7 +22,7 @@ library
Library.Types.Communication
Library.Types.Map
Library.Types.Player
build-depends: base ^>=4.17.2.1
build-depends: base >=4.17.2.1
, aeson
, linear
, matrix
@ -40,7 +40,7 @@ executable wizard-wipeout-client
Client.Graphics
Client.Types
-- other-extensions:
build-depends: base ^>=4.17.2.1
build-depends: base >=4.17.2.1
, aeson
, bytestring
, linear
@ -67,7 +67,7 @@ executable wizard-wipeout-server
Server.Types
Server.Util
-- other-extensions:
build-depends: base ^>=4.17.2.1
build-depends: base >=4.17.2.1
, aeson
, bytestring
, directory