76 lines
2.0 KiB
Haskell
76 lines
2.0 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
module Hanafuda.KoiKoi.Game (
|
|
Action(..)
|
|
, Environment
|
|
, Game(..)
|
|
, GameID
|
|
, ID
|
|
, Mode(..)
|
|
, Move(..)
|
|
, Player
|
|
, PlayerID
|
|
, PlayerTurn
|
|
, Players
|
|
, Scores
|
|
, Source(..)
|
|
, Step(..)
|
|
, end
|
|
, setPlayer
|
|
) where
|
|
|
|
import Control.Monad.Except (MonadError)
|
|
import Control.Monad.IO.Class (MonadIO)
|
|
import Control.Monad.Writer (MonadWriter)
|
|
import Data.Map (Map)
|
|
import Hanafuda (Card, Flower, Pack)
|
|
import Hanafuda.ID (ID, IDType(..), Prefix(..))
|
|
import qualified Hanafuda.KoiKoi.Yaku as KoiKoi (Score)
|
|
import qualified Hanafuda.Player as Player (ID, Players, Player, Scores, set)
|
|
|
|
data Mode = FirstAt Int | WholeYear deriving (Show)
|
|
data Move = Play Card | Capture (Card, Card) | Choose Card | KoiKoi Bool deriving (Show)
|
|
data Step = ToPlay | Turned Card | Scored | Over deriving (Show)
|
|
data Source = Hand | Deck deriving (Show)
|
|
data Action = Action {
|
|
source :: Source
|
|
, played :: Card
|
|
, captures :: Maybe Card
|
|
} deriving (Show)
|
|
|
|
type Environment m = (MonadIO m, MonadError String m, MonadWriter [Action] m)
|
|
type Player = Player.Player KoiKoi.Score
|
|
type PlayerID = Player.ID KoiKoi.Score
|
|
type Players = Player.Players KoiKoi.Score
|
|
type Scores = Player.Scores KoiKoi.Score
|
|
type GameID = ID Game
|
|
instance IDType Game where
|
|
prefix = Prefix "Game"
|
|
type PlayerTurn = Map PlayerID PlayerID
|
|
|
|
data Game = Game {
|
|
gameID :: GameID
|
|
, mode :: Mode
|
|
, scores :: Scores
|
|
, month :: Flower
|
|
, nextPlayer :: PlayerTurn
|
|
, players :: Players
|
|
, playing :: PlayerID
|
|
, winning :: PlayerID
|
|
, oyake :: PlayerID
|
|
, deck :: [Card]
|
|
, river :: Pack
|
|
, step :: Step
|
|
, trick :: [Card]
|
|
, rounds :: [(PlayerID, KoiKoi.Score)]
|
|
} deriving (Show)
|
|
|
|
setPlayer :: Game -> Player -> Game
|
|
setPlayer game@(Game {players, playing}) player = game {
|
|
players = Player.set playing player players
|
|
}
|
|
|
|
end :: Monad m => Game -> m Game
|
|
end game = return $ game {step = Over}
|