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

import Hanafuda.Card (Card, Flower(Pine), cards, shuffle, packOfCards)
import Hanafuda.Day (Day(..))
import qualified Hanafuda.Day as Day (Step(Over), next, new)
import Hanafuda.Game (Game(..), Move, Player, Players, PlayerState(..), initPlayers)
import qualified Hanafuda.Game as Game (next)
import Data.Map ((!), insert)
import Control.Monad.State (replicateM, runState, state)

data On = On {
      flower :: Flower
    , players :: Players
    , day :: Day
    , playing :: Player
    , lastScored :: Player
    , oyake :: Player
    , stock :: [Card]
  } 
data Over = Over {
      winner :: Player
    , score :: Int
  }

type Month = Either Over On

new :: Player -> [Card] -> On
new playing shuffled =
  On {
        flower = Pine
      , players
      , day = Day.new (packOfCards river) (players ! playing) next
      , playing
      , lastScored = playing
      , oyake = playing
      , stock
    }
  where
    take8 = state $ splitAt 8
    ([hand1, hand2, river], next:stock) = runState (replicateM 3 take8) shuffled
    players = initPlayers hand1 hand2

next :: On -> IO On
next month@(On {flower, oyake}) = do
  shuffled <- shuffle cards
  return $ (new (Game.next oyake) cards) {flower = succ flower}

instance Game On Month where
  play month@(On {flower, day, playing, players, stock = next : moreStock}) move =
    fmap after $ play day move
    where
      after (Day {step = Day.Over True, player = PlayerState {yakus}}) =
        Left $ Over {winner = playing, score = foldl (+) 0 yakus}
      after (Day {step = Day.Over False, player, river}) =
        let otherPlayer = Game.next playing in
        Right $ month {
            players = insert playing player players
          , playing = otherPlayer
          , day = (Day.new river (players ! otherPlayer) next) { month = flower }
          , stock = moreStock
        }
      after newDay = Right $ month {day = newDay}