{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Hanafuda.KoiKoi.Turn where

import Hanafuda (Card, Pack, Flower(Pine), contains, flower, match, remove)
import Hanafuda.KoiKoi.Yaku (Score, meldInto)
import Hanafuda.Player (Move(..), State(..), plays)
import Control.Monad.Reader (runReader)

data Step = ToPlay | Turned Card | Scored | Over Bool deriving (Show)
type Player = State Score

data Turn = Turn {
      river :: Pack
    , month :: Flower
    , player :: Player
    , next :: Card
    , step :: Step
    , trick :: [Card]
  } deriving (Show)

new :: Pack -> Player -> Card -> Turn
new river player next = Turn {
      river
    , month = Pine
    , player
    , next
    , step = ToPlay
    , trick = []
  }

play :: Turn -> Move -> Either String Turn
play turn@(Turn {river, step, next, trick, player}) move =
  case (step, move) of
    (ToPlay, Play card) -> match card river >>= play card
    (ToPlay, Capture (card, caught)) ->
      if card `canCatch` caught
        then play card (remove river caught, [card, caught])
        else Left "You can't choose that card"
    (Turned card, Choose caught) ->
      if card `canCatch` caught
        then end $ turn {river = remove river caught, trick = [card, caught] ++ trick}
        else Left "You can't choose that card"
    (Scored, KoiKoi win) -> Right $ turn {step = Over win}
    (_, _) -> Left "You can't play this move in that state"
  where
    canCatch card1 card2 = flower card1 == flower card2 && river `contains` card2
    play card (river, trick) = do
      played <- player `plays` card
      turnOver $ turn {river, trick, player = played}

turnOver :: Turn -> Either String Turn
turnOver turn@(Turn {river, next, trick}) =
  case match next river of
    Right (newRiver, newCaptured) -> end $ turn {river = newRiver, trick = trick ++ newCaptured}
    Left _ -> Right $ turn {step = Turned next}

end :: Turn -> Either String Turn
end turn@(Turn {month, trick, player}) =
  let (scored, newMeld) = runReader (trick `meldInto` (meld player)) month in
  let updatedPlayer = turn {player = player {meld = newMeld, yakus = scored `mappend` (yakus player)}} in
  Right $ if null scored
    then updatedPlayer {step = Over False}
    else updatedPlayer {step = Scored}