{-# LANGUAGE NamedFieldPuns #-}
module Hanafuda.KoiKoi.Yaku (
      Score
    , Yaku(..)
    , meldInto
    , sumYakus
  ) where

import Hanafuda (
      Card(..), Monthly, Pack
    , add, cardsOf, cardsOfPack, contains, difference, intersection, packOfCards
    , size
  )
import Hanafuda.Player (Points)
import qualified Data.Map as M (Map, empty, insert, unionWith, (!))
import qualified Data.Set as S (Set, empty, singleton, union)
import Control.Monad.Reader (asks)

data Yaku =
    Lights
  | InoShikaCho
  | Tane
  | Akatan
  | Aotan
  | Tan
  | Kasu
  | TsukimiZake
  | HanamiZake
  | TsukiFuda
  deriving (Eq, Ord, Read, Show)
type YakuRater = Pack -> Maybe Points
type YakuDistance = Pack -> Int
type Score = M.Map Yaku Points

data YakuFinder = YakuFinder {
      yaku :: Yaku
    , rater :: YakuRater
    , distance :: YakuDistance
  }

instance Eq YakuFinder where
  a == b = yaku a == yaku b

instance Ord YakuFinder where
  compare a b = compare (yaku a) (yaku b)

type YakusByCard = M.Map Card (S.Set YakuFinder)

lights :: Pack -> YakuRater
lights _ pack = rate (size pack) (pack `contains` RainMan)
  where
    goko = 10
    shiko = 8
    ameshiko = 7
    sanko = 5
    rate 5 _ = Just goko
    rate 4 hasRainMan = if hasRainMan then Just ameshiko else Just shiko
    rate n hasRainMan = if not hasRainMan && n > 2 then Just sanko else Nothing

fixed :: Points -> Pack -> YakuRater
fixed points indicatorSet pack = if pack == indicatorSet then Just points else Nothing

moreThan :: Int -> (Pack -> YakuRater)
moreThan count _ pack =
  let n = size pack - count in
  if n > 0 then Just n else Nothing

index :: (Yaku, [Card], (Pack -> YakuRater)) -> YakusByCard
index (yaku, cards, scorer) =
  let pack = packOfCards cards in
  let yakuFinder = YakuFinder {
      yaku
    , rater = scorer pack . intersection pack
    , distance = size . difference pack
  } in
  foldl (\yakusByCard card -> M.insert card (S.singleton yakuFinder) yakusByCard) M.empty cards

finders :: Monthly YakusByCard
finders = do
  monthCards <- cardsOfPack <$> asks cardsOf
  return $ foldl (\yakusByCard -> M.unionWith S.union yakusByCard . index) M.empty [
        (Lights, [Crane, CampCurtain, FullMoon, RainMan, Phoenix], lights)
      , (InoShikaCho, inoshikacho, fixed 5)
      , (Tane, [BushWarbler, Cuckoo, EightPlankBridge, Geese, SakeCup, Swallow] ++ inoshikacho, moreThan 4)
      , (Akatan, akatan, fixed 5)
      , (Aotan, aotan, fixed 5)
      , (Tan, [WisteriaRed, IrisRed, BushCloverRed, WillowRed] ++ aotan ++ akatan, moreThan 4)
      , (Kasu, plains, moreThan 9)
      , (TsukimiZake, [SakeCup, FullMoon], fixed 3)
      , (HanamiZake, [SakeCup, CampCurtain], fixed 3)
      , (TsukiFuda, monthCards, fixed 5)
    ]
  where
    inoshikacho = [Butterflies, Boar, Deer]
    aotan = [PeonyBlue, ChrysanthemumBlue, MapleBlue]
    akatan = [PinePoetry, PlumPoetry, CherryPoetry]
    plains = (foldl (++) [] [map toEnum [4*i, 4*i+1] | i <- [0..9]]) ++ Lightning : [Paulownia0 .. Sand]

meldInto :: [Card] -> Pack -> Monthly (Score, Pack)
meldInto cards pack = do
  yakusToCheck <- fmap toCheck finders
  return (foldl scored M.empty yakusToCheck, newPack)
  where
    newPack = foldl add pack cards
    toCheck yakusByCard = foldl (\set key -> S.union set (yakusByCard M.! key)) S.empty cards
    scored score (YakuFinder {yaku, rater}) = foldr (M.insert yaku) score $ rater newPack

sumYakus :: Score -> Points
sumYakus s
  | null s = 6
  | otherwise = foldl (+) 0 s