notify server of quitting client

configuration.yaml

@@ -2,4 +2,4 @@ setSocketPath         : "/tmp/wizard.sock"
 setMapRows            : 20
 setMapColumns         : 20
 setSpawnerProbability : 0.01
-setFPS                : 30
+setFPS                : 5

src-client/Client/Communication.hs

@@ -5,6 +5,8 @@ import qualified Control.Concurrent.STM as STM
 
 import Control.Monad (void)
 
+import Control.Monad.RWS
+
 import qualified Data.Aeson as A
 
 import qualified Data.ByteString as B
@@ -18,9 +20,12 @@ import Foreign hiding (void)
 
 import Network.Socket
 
+import System.Posix.Signals
+
 -- internal imports
 
 import Library.Types
+import Client.Types
 
 connectSocket
   :: FilePath
@@ -57,3 +62,22 @@ receiveMessage sock queue = do
     (putStrLn $ "received garbled data: " <> B8.unpack (B8.fromStrict msg))
     (STM.atomically . STM.writeTQueue queue)
     mJsonMsg
+
+-- | Function that installs a handler on SIGINT to terminate game
+terminateGameOnSigint
+  :: Game ()
+terminateGameOnSigint = do
+  sock <- asks rcSocket
+  clientId <- asks rcClientUUID
+  clientState <- gets scClientState
+  void $ liftIO $ installHandler
+    keyboardSignal
+    (CatchOnce $ do
+      void $ STM.atomically $ STM.swapTMVar serverState (clientState { clientStop = True })
+      threadDelay (10 ^ 6)
+      sendMessage sock (ClientMessage clientId ClientQuit)
+      close sock
+      -- Raise SIGINT again so it does not get blocked
+      raiseSignal keyboardSignal
+    )
+    Nothing

src-client/Client/Types.hs

@@ -24,12 +24,13 @@ options = Options
     )
 
 data ReaderContainer = ReaderContainer
-  { rcSocketHandle :: Socket
-  , rcClientUUID   :: UUID
+  { rcSocket     :: Socket
+  , rcClientUUID :: UUID
   }
 
 newtype StateContainer = StateContainer
-  { scWizard :: Wizard
+  { scWizard      :: Wizard
+  , scClientState :: ClientState
   }
 
 type Game = RWST ReaderContainer String StateContainer IO

src-client/Main.hs

@@ -5,8 +5,6 @@ import Control.Concurrent (threadDelay)
 
 import qualified Control.Concurrent.STM as STM
 
-import Control.Monad.Loops (whileM_)
-
 import Options.Applicative
 
 -- internal imports

wizard-wipeout.cabal

@@ -46,6 +46,7 @@ executable wizard-wipeout-client
                     , network
                     , optparse-applicative
                     , stm
+                    , unix
                     , uuid
                     , vector
                     , vty