63 lines
2.0 KiB
Haskell
63 lines
2.0 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
module Game (
|
|
export
|
|
, new
|
|
, play
|
|
) where
|
|
|
|
import qualified App (T, update)
|
|
import Control.Monad.Except (runExceptT, throwError)
|
|
import Control.Monad.Reader (lift)
|
|
import Control.Monad.Writer (runWriterT)
|
|
import Crypto.Saltine.Core.Sign (signDetached)
|
|
import Data.Aeson (encode)
|
|
import Data.Map ((!), mapWithKey)
|
|
import qualified Hanafuda (empty)
|
|
import Hanafuda.KoiKoi (Game, GameID, Mode(..), PlayerID)
|
|
import qualified Hanafuda.KoiKoi as KoiKoi (
|
|
Action, Game(..), Move(..), play, new
|
|
)
|
|
import Hanafuda.Message (PrivateState(..), PublicGame(..), PublicPlayer(..), PublicState(..))
|
|
import qualified Hanafuda.Player (Player(..), Players(..))
|
|
import qualified Server (register)
|
|
|
|
new :: (PlayerID, PlayerID) -> App.T GameID
|
|
new (for, to) =
|
|
Server.register <$> (lift $ KoiKoi.new (for, to) WholeYear) >>= App.update
|
|
|
|
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 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 $
|
|
if playing game == playerID
|
|
then KoiKoi.play move game
|
|
else throwError "Not your turn"
|