{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
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
  }

newtype Month = Month (Either Over On)

go :: On -> Month
go = Month . Right

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 (On {flower, oyake}) = do
  shuffled <- shuffle cards
  return $ (new (Game.next oyake) shuffled) {flower = succ flower}

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