client: found and fixed mem leak

src-client/Client/Communication.hs

@@ -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)
+      void $ sendBuf sock ptr (VS.length msgVector)
-      case eResult of
+      -- eResult <- try $ sendBuf sock ptr (VS.length msgVector)
-        Left (_ :: IOException) -> gracefulExit st "sendMessage:  Quitting due to connection loss…"
+      -- case eResult of
-        Right _ -> pure ()
+      --   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
+-- handleMessage (TickUpdate !slice !wizard) = do
-  modify' (\st@(StateContainer {}) ->
+--   st <- get
-    st
+--   let !newState = st
-      { scWizard   = wizard
+--         { scWizard   = wizard
-      , scMapSlice = slice
+--         , 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
 

src-client/Client/Game.hs

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

src-client/Main.hs

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

src-server/Server/Game.hs

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

wizard-wipeout.cabal

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