lib/src/Hanafuda/KoiKoi/Game.hs

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