WIP: Struggling with using the new public data types
This commit is contained in:
parent
0c5229ae6d
commit
61d8616a5a
2 changed files with 36 additions and 13 deletions
46
src/Game.hs
46
src/Game.hs
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
module Game (
|
||||
export
|
||||
, new
|
||||
|
@ -8,13 +9,15 @@ import qualified App (T, update)
|
|||
import Control.Monad.Except (runExceptT, throwError)
|
||||
import Control.Monad.Reader (lift)
|
||||
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 Hanafuda.KoiKoi (Game, GameBlueprint(..), GameID, Mode(..), PlayerID)
|
||||
import Hanafuda.KoiKoi (Game, GameID, Mode(..), PlayerID)
|
||||
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 Server (register)
|
||||
|
||||
|
@ -22,16 +25,35 @@ new :: (PlayerID, PlayerID) -> App.T GameID
|
|||
new (for, to) =
|
||||
Server.register <$> (lift $ KoiKoi.new (for, to) WholeYear) >>= App.update
|
||||
|
||||
export :: PlayerID -> Game -> PublicGame
|
||||
export playerID game = game {
|
||||
deck = length $ deck game
|
||||
, players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
|
||||
extractPrivateState :: PlayerID -> Game -> PrivateState
|
||||
extractPrivateState playerID game = undefined
|
||||
|
||||
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
|
||||
Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players game
|
||||
maskOpponentsHand k player
|
||||
| k == playerID = player
|
||||
| otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
|
||||
Hanafuda.Player.Players players = KoiKoi.players game
|
||||
publicState = encode $ extractPublicState game
|
||||
|
||||
play :: PlayerID -> KoiKoi.Move -> Game -> App.T (Either String Game, [KoiKoi.Action])
|
||||
play playerID move game = lift . runWriterT . runExceptT $
|
||||
|
|
|
@ -73,4 +73,5 @@ update = Update {alone = [], paired = []}
|
|||
notifyPlayers :: KoiKoi.Game -> [KoiKoi.Action] -> App.T ()
|
||||
notifyPlayers game logs =
|
||||
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}
|
||||
|
|
Loading…
Reference in a new issue