WIP: Struggling with using the new public data types

This commit is contained in:
Tissevert 2019-10-16 18:53:27 +02:00
parent 0c5229ae6d
commit 61d8616a5a
2 changed files with 36 additions and 13 deletions

View File

@ -1,3 +1,4 @@
{-# LANGUAGE NamedFieldPuns #-}
module Game ( module Game (
export export
, new , new
@ -8,13 +9,15 @@ import qualified App (T, update)
import Control.Monad.Except (runExceptT, throwError) import Control.Monad.Except (runExceptT, throwError)
import Control.Monad.Reader (lift) import Control.Monad.Reader (lift)
import Control.Monad.Writer (runWriterT) import Control.Monad.Writer (runWriterT)
import Data.Map (mapWithKey) import Crypto.Saltine.Core.Sign (signDetached)
import Data.Aeson (encode)
import Data.Map ((!), mapWithKey)
import qualified Hanafuda (empty) import qualified Hanafuda (empty)
import Hanafuda.KoiKoi (Game, GameBlueprint(..), GameID, Mode(..), PlayerID) import Hanafuda.KoiKoi (Game, GameID, Mode(..), PlayerID)
import qualified Hanafuda.KoiKoi as KoiKoi ( import qualified Hanafuda.KoiKoi as KoiKoi (
Action, Move(..), play, new Action, Game(..), Move(..), play, new
) )
import Hanafuda.Message (PublicGame) import Hanafuda.Message (PrivateState(..), PublicGame(..), PublicPlayer(..), PublicState(..))
import qualified Hanafuda.Player (Player(..), Players(..)) import qualified Hanafuda.Player (Player(..), Players(..))
import qualified Server (register) import qualified Server (register)
@ -22,16 +25,35 @@ new :: (PlayerID, PlayerID) -> App.T GameID
new (for, to) = new (for, to) =
Server.register <$> (lift $ KoiKoi.new (for, to) WholeYear) >>= App.update Server.register <$> (lift $ KoiKoi.new (for, to) WholeYear) >>= App.update
export :: PlayerID -> Game -> PublicGame extractPrivateState :: PlayerID -> Game -> PrivateState
export playerID game = game { extractPrivateState playerID game = undefined
deck = length $ deck game
, players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered extractPublicState :: Game -> PublicState
extractPublicState game = PublicState {
mode = KoiKoi.mode game
, scores = KoiKoi.scores game
, month = KoiKoi.month game
, playing = KoiKoi.playing game
, winning = KoiKoi.winning game
, oyake = KoiKoi.oyake game
, river = KoiKoi.river game
, step = KoiKoi.step game
, trick = KoiKoi.trick game
, rounds = KoiKoi.rounds game
} }
export :: PlayerID -> Game -> App.T PublicGame
export playerID game = do
secretKey <- asks $ fst . keypair . mServer
return $ PublicGame {
playerHand = hand $ players ! playerID
, privateState = extractPrivateState playerID game
, publicState
, publicSignature = signDetached secretKey publicState
}
where where
Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players game Hanafuda.Player.Players players = KoiKoi.players game
maskOpponentsHand k player publicState = encode $ extractPublicState game
| k == playerID = player
| otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
play :: PlayerID -> KoiKoi.Move -> Game -> App.T (Either String Game, [KoiKoi.Action]) play :: PlayerID -> KoiKoi.Move -> Game -> App.T (Either String Game, [KoiKoi.Action])
play playerID move game = lift . runWriterT . runExceptT $ play playerID move game = lift . runWriterT . runExceptT $

View File

@ -73,4 +73,5 @@ update = Update {alone = [], paired = []}
notifyPlayers :: KoiKoi.Game -> [KoiKoi.Action] -> App.T () notifyPlayers :: KoiKoi.Game -> [KoiKoi.Action] -> App.T ()
notifyPlayers game logs = notifyPlayers game logs =
forM_ (keys $ KoiKoi.scores game) $ \k -> forM_ (keys $ KoiKoi.scores game) $ \k ->
sendTo [k] $ Game {game = Game.export k game, logs} game <- Game.export k game
sendTo [k] $ Game {game, logs}