Follow the simplication of Game data type on lib's side

This commit is contained in:
Tissevert 2019-07-22 08:40:42 +02:00
parent b3808551fd
commit 71b666ca7d
3 changed files with 24 additions and 37 deletions

View file

@ -50,7 +50,7 @@ receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do
then do
gameKey <- Server.register <$> (lift $ Game.new for to) >>= App.update
game <- Server.get gameKey <$> App.server
Message.notifyPlayers (KoiKoi.On game) []
Message.notifyPlayers game []
return $ Session.Playing gameKey
else do
Message.broadcast $ Message.update {Message.alone = [key, to]}
@ -66,17 +66,17 @@ receive (Session.Playing gameKey) played@(Message.Play {}) = do
case result of
Left message -> sendError message
Right newGame ->
case newGame of
KoiKoi.Over _ -> do
if KoiKoi.on newGame
then do
App.update_ $ Server.update gameKey (const newGame)
Message.notifyPlayers newGame logs
else do
let newStatus = Session.LoggedIn True
let opponent = Player.next (KoiKoi.players game) key
let opponent = Player.next (KoiKoi.players newGame) 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
receive state _ = sendError $ "Invalid message in state " ++ show state

View file

@ -8,7 +8,6 @@
{-# LANGUAGE OverloadedStrings #-}
module Game (
Key
, View
, T
, export
, new
@ -26,7 +25,7 @@ import qualified Data (Key)
import qualified Player (Key)
import qualified Hanafuda (Flower(..), Card(..), Pack, cardsOfPack, empty)
import qualified Hanafuda.Player (Player(..), Players(..))
import qualified Hanafuda.KoiKoi (Action(..), Game(..), Environment, Mode(..), Move(..), On(..), Over(..), Score, Source(..), Step(..), Yaku(..), new, play)
import qualified Hanafuda.KoiKoi (Action(..), Game(..), Environment, Mode(..), Move(..), Score, Source(..), Step(..), Yaku(..), new, play)
import GHC.Generics
deriving instance Generic Hanafuda.Card
@ -40,17 +39,11 @@ deriving instance Generic Hanafuda.KoiKoi.Step
deriving instance Generic1 (Hanafuda.Player.Player Player.Key)
deriving instance Generic1 (Hanafuda.Player.Players Player.Key)
type On = Hanafuda.KoiKoi.On Player.Key
type Over = Hanafuda.KoiKoi.Over Player.Key
type View = Hanafuda.KoiKoi.Game Player.Key
type T = Hanafuda.KoiKoi.Game Player.Key
deriving instance Generic On
deriving instance Generic Over
deriving instance Generic View
deriving instance Generic T
instance ToJSON On where
toEncoding = genericToEncoding JSON.defaultOptions
instance ToJSON Over where
instance ToJSON T where
toEncoding = genericToEncoding JSON.defaultOptions
instance FromJSON Hanafuda.Card
@ -95,28 +88,25 @@ instance ToJSON (Hanafuda.Player.Players Player.Key Hanafuda.KoiKoi.Score) where
toJSON = toJSON1
toEncoding = toEncoding1
type T = On
type Key = Data.Key T
new :: Player.Key -> Player.Key -> IO T
new p1 p2 = do
Hanafuda.KoiKoi.new [p1, p2] Hanafuda.KoiKoi.WholeYear
Hanafuda.KoiKoi.new [p1, p2] $ Hanafuda.KoiKoi.FirstAt 1
export :: Player.Key -> View -> Value
export _ (Hanafuda.KoiKoi.Over over) = toJSON over
export key (Hanafuda.KoiKoi.On on) = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck on) $ ast
export :: Player.Key -> T -> Value
export key game = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck game) $ ast
where
Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players on
Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players game
maskOpponentsHand k player
| k == key = player
| otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
Object ast = toJSON $ on {
Object ast = toJSON $ game {
Hanafuda.KoiKoi.players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
}
play :: Hanafuda.KoiKoi.Environment m => Player.Key -> Hanafuda.KoiKoi.Move -> T -> m (Hanafuda.KoiKoi.Game Player.Key)
play key move on
| Hanafuda.KoiKoi.playing on == key =
Hanafuda.KoiKoi.play move on
play key move game
| Hanafuda.KoiKoi.playing game == key =
Hanafuda.KoiKoi.play move game
| otherwise = throwError "Not your turn"

View file

@ -23,11 +23,11 @@ import Data.ByteString.Lazy.Char8 (unpack)
import Data.Text (Text)
import Control.Monad.Reader (asks, lift)
import qualified Player (Key)
import qualified Game (View, export)
import qualified Game (T, export)
import qualified Session (T(..))
import qualified Server (T(..), get)
import qualified App (Context(..), T, connection, debug, server)
import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game(..), On(..), Over(..), Move(..))
import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game(..), Move(..))
import GHC.Generics (Generic)
data FromClient =
@ -98,10 +98,7 @@ get =
update :: T
update = Update {alone = [], paired = []}
notifyPlayers :: Game.View -> [KoiKoi.Action] -> App.T ()
notifyPlayers game@(KoiKoi.Over over) logs =
forM_ (keys $ KoiKoi.finalScores over) $ \k ->
sendTo [k] $ Game {game = Game.export k game, logs}
notifyPlayers game@(KoiKoi.On on) logs =
forM_ (keys $ KoiKoi.scores on) $ \k ->
notifyPlayers :: Game.T -> [KoiKoi.Action] -> App.T ()
notifyPlayers game logs =
forM_ (keys $ KoiKoi.scores game) $ \k ->
sendTo [k] $ Game {game = Game.export k game, logs}