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 (
|
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 $
|
||||||
|
|
|
@ -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}
|
||||||
|
|
Loading…
Reference in a new issue