{-# 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"