{-# LANGUAGE NamedFieldPuns #-}
module AI (
    move
  ) where

import Data.List (sortOn)
import Data.Map ((!))
import Data.Ord (Down(..))
import Data.Set (Set, member)
import qualified Data.Set as Set (fromList, intersection, unions)
import Hanafuda (
      Card(..), Flower(..), Pack
    , cardsOf, cardsOfPack, contains, empty,flower, packOfCards, sameMonth, size, union
  )
import Hanafuda.Player (Player(..), Players(..))
import Hanafuda.KoiKoi (GameBlueprint(..), Move(..), PlayerID, Step(..), Score)
import Hanafuda.Message (PublicGame)

move :: PlayerID -> PublicGame -> Move

move me (Game {step = ToPlay, month, players = Players p, river}) =
  case getAvailableCards myHand (cardsOfPack river) of
    [] -> Play $ worstFor month (p ! (nextPlayer $ p ! me)) myHand
    available ->
      let riverCard = bestFor month (p ! me) available in
      let matchingCards = cardsOfPack . sameMonth riverCard . hand $ p ! me in
      capture (bestFor month (p ! me) matchingCards) riverCard river
  where
    myHand = cardsOfPack . hand $ p ! me

move me (Game {step = Turned card, month, players = Players p, river}) =
  Choose . bestFor month (p ! me) . cardsOfPack $ sameMonth card river

move me (Game {players = Players p}) = KoiKoi $ hand (p ! me) /= empty

capture :: Card -> Card -> Pack -> Move
capture card caught river =
  if size (sameMonth card river) == 1
  then Play card
  else Capture (card, caught)

getAvailableCards :: [Card] -> [Card] -> [Card]
getAvailableCards hand =
  filter ((`member` flowersInHand) . flower)
  where
    flowersInHand = Set.fromList $ flower <$> hand

choose :: Ord a => (Card -> a) -> [Card] -> Card
choose sortCriterion = head . sortOn sortCriterion

bestFor :: Flower -> Player Score -> [Card] -> Card
bestFor monthFlower player = choose (Down . rank monthFlower player)

worstFor :: Flower -> Player Score -> [Card] -> Card
worstFor monthFlower player = choose (rank monthFlower player)

rank :: Flower -> Player Score -> Card -> Int
rank monthFlower _ card
  | isTrueLight card = 5
  | card == RainMan = 2
  | isSpecialRibbon card = 4
  | isRibbon card = 3
  | isSpecialAnimal card = 4
  | isAnimal card = 3
  | isMonthly monthFlower card = 4
  | otherwise = 1

isTrueLight :: Card -> Bool
isTrueLight = (packOfCards [Crane, CampCurtain, FullMoon, Phoenix] `contains`)

isSpecialRibbon :: Card -> Bool
isSpecialRibbon = ((aotan `union` akatan) `contains`)
  where
    aotan = packOfCards [PeonyBlue, ChrysanthemumBlue, MapleBlue]
    akatan = packOfCards [PinePoetry, PlumPoetry, CherryPoetry]

isRibbon :: Card -> Bool
isRibbon card = isSpecialRibbon card || packOfCards other `contains` card
  where
    other = [WisteriaRed, IrisRed, BushCloverRed, WillowRed]

isSpecialAnimal :: Card -> Bool
isSpecialAnimal = (packOfCards [Butterflies, Boar, SakeCup, Deer] `contains`)

isAnimal :: Card -> Bool
isAnimal card = (isSpecialAnimal card) || (packOfCards other `contains` card)
  where
    other = [BushWarbler, Cuckoo, EightPlankBridge, Geese, Swallow]

isMonthly :: Flower -> Card -> Bool
isMonthly monthFlower = (cardsOf monthFlower `contains`)