lib/src/Hanafuda/KoiKoi.hs

{-# LANGUAGE NamedFieldPuns #-}
module Hanafuda.KoiKoi (
      Card(..)
    , Game(..)
    , Mode(..)
    , Move(..)
    , On(..)
    , Over(..)
    , Score
    , 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 (Game(..), Mode(..), Move(..), On(..), Over(..), Step(..), raise)
import qualified Hanafuda.KoiKoi.Round as Round (deal, next)
import qualified Hanafuda.KoiKoi.Turn as Turn (catch, end, next)

play :: Ord player => Move -> On player -> IO (Game player)
play move on@(On_ {river, step}) =
  case (step, move) of
    (ToPlay, Play card) ->
      either raise (Turn.catch on card) $ match card river
    (ToPlay, Capture (card, caught)) ->
      if card `canCatch` caught
        then Turn.catch on card (remove river caught, [card, caught])
        else raise "You can't choose that card"
    (Turned card, Choose caught) ->
      if card `canCatch` caught
        then Turn.end on (remove river caught, [card, caught])
        else raise "You can't choose that card"
    (Scored, KoiKoi keepOn) -> (if keepOn then Turn.next else Round.next) on
    (_, _) -> raise "You can't play this move in that state"
  where
    canCatch card1 card2 = flower card1 == flower card2 && river `contains` card2

new :: Ord player => [player] -> Mode -> IO (On player)
new playersList mode = do
  playing <- Player.random players
  Round.deal $ On_ {
        mode
      , scores = Player.scores players [0, 0]
      , month = Pine
      , players
      , playing
      , winning = playing
      , oyake = playing
      , deck = undefined
      , river = undefined
      , step = ToPlay
      , trick = []
    }
  where
    players = Player.players playersList