{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Hanafuda.Year where

import Hanafuda.Card (Flower(Paulownia), cards, shuffle)
import Hanafuda.Month (flower, next, score, winner)
import qualified Hanafuda.Month as Month (On(..), Over(..), new)
import Hanafuda.Game (Game(..), Player(Player1), Scores)
import Data.Map (Map, empty, insert, (!))
import System.Random (StdGen)

data Mode = FirstAt Int | WholeYear

data On = On {
      mode :: Mode
    , month :: Month.On
    , scores :: Scores
  }
data Over = Over {
    finalScores :: Scores
  }

type Year = IO (Either Over On)

new :: Mode -> Year
new mode = do
  shuffled <- shuffle cards
  return . Right $ On {
        mode
      , month = Month.new Player1 shuffled
      , scores = empty
    }

consolidate :: On -> Player -> Int -> Year
consolidate year@(On {mode, month, scores}) winner score =
  case mode of
    FirstAt n | n <= newScore -> over
    FirstAt n -> continue
    WholeYear | flower month == Paulownia -> over
    WholeYear -> continue
  where
    newScore = scores ! winner + score
    newScores = insert winner newScore scores
    over = return . Left $ Over {finalScores = newScores}
    continue = do
      nextMonth <- next month
      return . Right $ year {scores = newScores, month = nextMonth}

instance Game On Year where
  play year@(On {mode, month}) move =
    fmap after $ play month move
    where
      after (Left (Month.Over {winner, score})) = consolidate year winner score
      after (Right newMonth) = return . Right $ year {month = newMonth}