lib/src/Hanafuda/KoiKoi.hs

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}
module Hanafuda.KoiKoi (
      Action(..)
    , Card(..)
    , Environment
    , Game
    , GameBlueprint(..)
    , GameID
    , Mode(..)
    , Move(..)
    , PlayerID
    , Score
    , Source(..)
    , Step(..)
    , Yaku(..)
    , new
    , play
  ) where

import Hanafuda (Card(..), Flower(Pine), contains, flower, match, remove)
import qualified Hanafuda.Player as Player (players, random, scores)
import Hanafuda.KoiKoi.Yaku (Yaku(..), Score)
import Hanafuda.KoiKoi.Game (
      Action(..), Environment, Game, GameBlueprint(..), GameID, Mode(..), Move(..), PlayerID
    , Source(..), Step(..)
  )
import qualified Hanafuda.KoiKoi.Round as Round (deal, next)
import qualified Hanafuda.KoiKoi.Turn as Turn (catch, end, next)
import Control.Monad.Except (MonadError(..))
import Control.Monad.IO.Class (MonadIO)

play :: Environment m => Move -> Game -> m Game
play move game@(Game {river, step}) =
  case (step, move) of
    (ToPlay, Play card) ->
      either throwError (Turn.catch game card) $ match card river
    (ToPlay, Capture (card, caught)) ->
      if card `canCatch` caught
        then Turn.catch game card (remove river caught, [card, caught])
        else throwError "You can't choose that card"
    (Turned card, Choose caught) ->
      if card `canCatch` caught
        then Turn.end game card (remove river caught, [card, caught])
        else throwError "You can't choose that card"
    (Scored, KoiKoi keepGame) -> (if keepGame then Turn.next else Round.next) game
    (Over, _) -> throwError "This game is over"
    (_, _) -> throwError "You can't play this move in that state"
  where
    canCatch card1 card2 = flower card1 == flower card2 && river `contains` card2

new :: MonadIO m => (PlayerID, PlayerID) -> Mode -> m Game
new (playerA, playerB) mode = do
  playing <- Player.random players
  Round.deal $ Game {
        mode
      , scores = Player.scores players [0, 0]
      , month = Pine
      , players
      , playing
      , winning = playing
      , oyake = playing
      , deck = undefined
      , river = undefined
      , step = ToPlay
      , trick = []
      , rounds = []
    }
  where
    players = Player.players [playerA, playerB]