Handle disconnection server side

src/Automaton.hs

@@ -8,15 +8,14 @@ import Control.Monad.Reader (asks, lift)
 import Control.Monad.Writer (runWriterT)
 import qualified Data (RW(..))
 import qualified Game (new, play)
-import qualified Hanafuda.KoiKoi as KoiKoi (Game(..))
+import qualified Hanafuda.KoiKoi as KoiKoi (Game(..), players)
+import qualified Hanafuda.Player as Player (next)
 import qualified Session (Status(..), T(..), Update)
-import qualified Server (get, logIn, logOut, update, register)
+import qualified Server (endGame, get, logIn, logOut, update, register)
 import qualified App (Context(..), T, current, debug, get, server, try, update, update_)
 import qualified Message (FromClient(..), T(..), broadcast, get, notifyPlayers, relay, send, sendTo, update)
 
-type Vertex = Session.Status
-
-receive :: Vertex -> Message.FromClient -> App.T ()
+receive :: Session.Status -> Message.FromClient -> App.T ()
 
 receive (Session.LoggedIn False) logIn@(Message.LogIn login) =
   asks App.key >>= App.try . (Server.logIn login)
@@ -68,8 +67,13 @@ receive (Session.Playing gameKey) played@(Message.Play {}) = do
     Left message -> sendError message
     Right newGame ->
       case newGame of
-        KoiKoi.Over _ ->
+        KoiKoi.Over _ -> do
+          let newStatus = Session.LoggedIn True
+          let opponent = Player.next (KoiKoi.players game) key
+          App.update_ $ Server.endGame gameKey
+          App.update_ $ Server.update opponent (Data.set newStatus :: Session.Update)
           Message.notifyPlayers newGame logs
+          move newStatus
         KoiKoi.On on -> do
           App.update_ $ Server.update gameKey (const on)
           Message.notifyPlayers newGame logs
@@ -79,7 +83,7 @@ receive state _ = sendError $ "Invalid message in state " ++ show state
 sendError :: String -> App.T ()
 sendError = Message.send . Message.Error
 
-move :: Vertex -> App.T ()
+move :: Session.Status -> App.T ()
 move newStatus = do
   key <- asks App.key
   App.update_ $ Server.update key $ (Data.set newStatus :: Session.Update)

src/Server.hs

@@ -8,6 +8,7 @@
 module Server (
       T(..)
     , disconnect
+    , endGame
     , get
     , logIn
     , logOut
@@ -96,6 +97,10 @@ disconnect :: Player.Key -> T -> T
 disconnect key =
   Data.update (delete key :: Sessions -> Sessions) . logOut key
 
+endGame :: Game.Key -> T -> T
+endGame key =
+  Data.update (delete key :: Games -> Games)
+
 logIn :: Text -> Player.Key -> T -> Either String T
 logIn name key server =
   Data.update (Set.insert name) .