lib/src/Hanafuda/KoiKoi/Game.hs

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
module Hanafuda.KoiKoi.Game (
      Action(..)
    , Environment
    , Game
    , GameBlueprint(..)
    , GameID
    , ID
    , Mode(..)
    , Move(..)
    , PlayerID
    , Source(..)
    , Step(..)
    , end
    , setPlayer
  ) where

import Control.Monad.Except (MonadError)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Writer (MonadWriter)
import Hanafuda (Card, Flower, Pack)
import Hanafuda.ID (ID)
import qualified Hanafuda.KoiKoi.Yaku as KoiKoi (Score)
import Hanafuda.Player (Players, Player, Scores, set)
import qualified Hanafuda.Player as Player (ID)

data Mode = FirstAt Int | WholeYear deriving (Show)
data Move = Play Card | Capture (Card, Card) | Choose Card | KoiKoi Bool
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 PlayerID = Player.ID KoiKoi.Score
type GameID = ID Game

data GameBlueprint deckType = Game {
      mode :: Mode
    , scores :: Scores KoiKoi.Score
    , month :: Flower
    , players :: Players KoiKoi.Score
    , playing :: PlayerID
    , winning :: PlayerID
    , oyake :: PlayerID
    , deck :: deckType
    , river :: Pack
    , step :: Step
    , trick :: [Card]
    , rounds :: [(PlayerID, KoiKoi.Score)]
  } deriving (Show)
type Game = GameBlueprint [Card]

setPlayer :: Game -> Player KoiKoi.Score -> Game
setPlayer game@(Game {players, playing}) player = game {players = set playing player players}

end :: Monad m => Game -> m Game
end game = return $ game {step = Over}