{-# LANGUAGE NamedFieldPuns #-}
module Hanafuda.Yaku where

import Hanafuda.Card (Card(..), Flower, Monthly, Pack, add, contains, intersection, packOfCards, size)
import qualified Data.Map as M (Map, empty, insert, unionWith, (!))
import qualified Data.Set as S (Set, empty, insert, singleton, union)
import Control.Monad.Reader (reader)

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

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

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

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

type YakuByCard = 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)) -> YakuByCard
index (yaku, cards, scorer) =
  let pack = packOfCards cards in
  let yakuFinder = YakuFinder {yaku, rater = scorer pack . intersection pack} in
  foldl (\map card -> M.insert card (S.singleton yakuFinder) map) M.empty cards

finders :: Monthly YakuByCard
finders = do
  monthCardPlus <- reader $ (+) . (4*) . fromEnum
  return $ foldl (\map -> M.unionWith S.union map . 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, (foldl (++) [] [map toEnum [4*i, 4*i+1] | i <- [0..10]]) ++ Lightning : [Paulownia0 .. Sand], moreThan 9)
      , (TsukimiZake, [SakeCup, FullMoon], fixed 3)
      , (HanamiZake, [SakeCup, CampCurtain], fixed 3)
      , (TsukiFuda, map (toEnum . monthCardPlus) [0..3], fixed 5)
    ]
  where
    inoshikacho = [Butterflies, Boar, Deer]
    aotan = [PeonyBlue, ChrysanthemumBlue, MapleBlue]
    akatan = [PinePoetry, PlumPoetry, CherryPoetry]

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