Pass the move just played along with the new game's state

This commit is contained in:
Sasha 2018-07-27 23:52:44 +02:00
parent b785bdda22
commit 8b2034279a
2 changed files with 7 additions and 7 deletions

View file

@ -49,7 +49,7 @@ edges (Session.Answering to) message@(Message.Answer {Message.accept}) = do
then do then do
gameKey <- Server.register <$> (lift $ Game.new for to) >>= App.update gameKey <- Server.register <$> (lift $ Game.new for to) >>= App.update
game <- Server.get gameKey <$> App.server game <- Server.get gameKey <$> App.server
Message.notifyPlayers game Message.notifyPlayers game Nothing
return $ Session.Playing gameKey return $ Session.Playing gameKey
else do else do
Message.broadcast $ Message.update {Message.alone = [key, to]} Message.broadcast $ Message.update {Message.alone = [key, to]}
@ -67,7 +67,7 @@ edges status@(Session.Playing gameKey) (Message.Play {Message.move}) = do
KoiKoi.Over _ -> undefined KoiKoi.Over _ -> undefined
KoiKoi.On on -> do KoiKoi.On on -> do
App.update_ $ Server.update gameKey (const on) App.update_ $ Server.update gameKey (const on)
Message.notifyPlayers on Message.notifyPlayers on $ Just move
return status return status
edges state _ = edges state _ =

View file

@ -17,7 +17,7 @@ module Message (
import Data.List (intercalate) import Data.List (intercalate)
import Data.Foldable (forM_) import Data.Foldable (forM_)
import Data.Map (keys) import Data.Map (keys)
import Data.Aeson (FromJSON(..), ToJSON(..), eitherDecode', encode, genericParseJSON, genericToEncoding, defaultOptions) import Data.Aeson (FromJSON(..), ToJSON(..), Value, eitherDecode', encode, genericParseJSON, genericToEncoding, defaultOptions)
import Network.WebSockets (receiveData, sendTextData) import Network.WebSockets (receiveData, sendTextData)
import Data.ByteString.Lazy.Char8 (unpack) import Data.ByteString.Lazy.Char8 (unpack)
import Data.Text (Text) import Data.Text (Text)
@ -48,7 +48,7 @@ data T =
Relay {from :: Player.Key, message :: FromClient} Relay {from :: Player.Key, message :: FromClient}
| Welcome {room :: Server.T, key :: Player.Key} | Welcome {room :: Server.T, key :: Player.Key}
| Update {alone :: [Player.Key], paired :: [Player.Key]} | Update {alone :: [Player.Key], paired :: [Player.Key]}
| Game {game :: Game.T} | Game {game :: Value, played :: Maybe KoiKoi.Move}
| Pong | Pong
| Error {error :: String} | Error {error :: String}
deriving (Generic) deriving (Generic)
@ -98,7 +98,7 @@ get =
update :: T update :: T
update = Update {alone = [], paired = []} update = Update {alone = [], paired = []}
notifyPlayers :: Game.T -> App.T () notifyPlayers :: Game.T -> Maybe KoiKoi.Move -> App.T ()
notifyPlayers game = notifyPlayers game played =
forM_ (keys $ KoiKoi.scores game) $ \k -> forM_ (keys $ KoiKoi.scores game) $ \k ->
sendTo [k] $ Game {game = Game.export k game} sendTo [k] $ Game {game = Game.export k game, played}