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

import Hanafuda.Card (Flower(Paulownia), cards, shuffle)
import Hanafuda.Month (Month(..), flower, next, score, winner)
import qualified Hanafuda.Month as Month (On(..), Over(..), new)
import Hanafuda.Game (Game(..), Player(Player1), Scores, deal)
import Data.Map (Map, 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
  }

newtype Year = Year (Either Over On)

go :: On -> IO Year
go = return . Year . Right

new :: Mode -> IO Year
new mode = do
  shuffled <- shuffle cards
  go $ On {
        mode
      , month = Month.new Player1 shuffled
      , scores = deal $ cycle [0]
    }

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

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