lib/src/Hanafuda/KoiKoi.hs

{-# LANGUAGE NamedFieldPuns #-}
module Hanafuda.KoiKoi (
      Card(..)
    , Game(..)
    , Mode(..)
    , Move(..)
    , On(..)
    , Over(..)
    , new
    , play
  ) where

import Hanafuda (Card(..), Flower(Pine), contains, flower, match, remove)
import qualified Hanafuda.Player as Player (deal)
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)
import System.Random (randomIO)

play :: Move -> On -> IO Game
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 :: Mode -> IO On
new mode = do
  playing <- randomIO
  Round.deal $ On_ {
        mode
      , scores = Player.deal [0, 0]
      , month = Pine
      , players = undefined
      , playing
      , winning = playing
      , oyake = playing
      , stock = undefined
      , river = undefined
      , step = ToPlay
      , trick = []
    }