diff --git a/src-client/Client/Communication.hs b/src-client/Client/Communication.hs index 5364a14..1380953 100644 --- a/src-client/Client/Communication.hs +++ b/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) - 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 diff --git a/src-client/Client/Game.hs b/src-client/Client/Game.hs index 2a11df6..ae1cfe5 100644 --- a/src-client/Client/Game.hs +++ b/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 diff --git a/src-client/Main.hs b/src-client/Main.hs index 1f235a3..5202bda 100644 --- a/src-client/Main.hs +++ b/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 diff --git a/src-server/Server/Game.hs b/src-server/Server/Game.hs index fb06636..b6e7804 100644 --- a/src-server/Server/Game.hs +++ b/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 diff --git a/wizard-wipeout.cabal b/wizard-wipeout.cabal index b832c0e..79b27b1 100644 --- a/wizard-wipeout.cabal +++ b/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