server/src/Game.hs

41 lines
1.3 KiB
Haskell

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 Data.Map (mapWithKey)
import qualified Hanafuda (empty)
import qualified Hanafuda.KoiKoi as KoiKoi (
Action, Move(..), play, new
)
import Hanafuda.KoiKoi (Game, GameBlueprint(..), GameID, Mode(..), PlayerID)
import qualified Hanafuda.Player (Player(..), Players(..))
import Hanafuda.Message (PublicGame)
import qualified Server (register)
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
}
where
Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players game
maskOpponentsHand k player
| k == playerID = player
| otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
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"