module Hanafuda.Card where

import Data.Word (Word64)
import Data.Bits (
      clearBit
    , popCount
    , setBit
    , shift
    , testBit
    , xor
    , Bits
    , (.&.)
    , (.|.)
    , countTrailingZeros
  )
import System.Random (randomRIO)
import Control.Monad.Reader (Reader)

data Flower =
    Pine
  | Plum
  | Cherry
  | Wisteria
  | Iris
  | Peony
  | BushClover
  | SusukiGrass
  | Chrysanthemum
  | Maple
  | Willow
  | Paulownia
  deriving (Eq, Ord, Enum, Show)

data Card =
      Pine0 | Pine1 | PinePoetry | Crane
    | Plum0 | Plum1 | PlumPoetry | BushWarbler
    | Cherry0 | Cherry1 | CherryPoetry | CampCurtain
    | Wisteria0 | Wisteria1 | WisteriaRed | Cuckoo
    | Iris0 | Iris1 | IrisRed | EightPlankBridge
    | Peony0 | Peony1 | PeonyBlue | Butterflies
    | BushClover0 | BushClover1 | BushCloverRed | Boar
    | SusukiGrass0 | SusukiGrass1 | Geese | FullMoon
    | Chrysanthemum0 | Chrysanthemum1 | ChrysanthemumBlue | SakeCup
    | Maple0 | Maple1 | MapleBlue | Deer
    | Lightning | WillowRed | Swallow | RainMan
    | Paulownia0 | Paulownia1 | Sand | Phoenix
  deriving (Eq, Ord, Enum, Show)

flower :: Card -> Flower
flower = toEnum . (`div` 4) . fromEnum

type Monthly a = Reader Flower a

type Pack = Word64

empty :: Pack
empty = 0

packOfCards :: [Card] -> Pack
packOfCards = foldl add 0

smallest :: Pack -> Card
smallest = toEnum . countTrailingZeros

cardsOfPack :: Pack -> [Card]
cardsOfPack 0 = []
cardsOfPack pack =
  let n = countTrailingZeros pack in
  toEnum n : cardsOfPack (clearBit pack n)

port :: (Bits a, Enum e) => (a -> Int -> b) -> a -> e -> b
port f bits = f bits . fromEnum

contains :: Pack -> Card -> Bool
contains = port testBit

size :: Pack -> Int
size = popCount

add :: Pack -> Card -> Pack
add = port setBit

remove :: Pack -> Card -> Pack
remove = port clearBit

union :: Pack -> Pack -> Pack
union = (.|.)

intersection :: Pack -> Pack -> Pack
intersection = (.&.)

difference :: Pack -> Pack -> Pack
difference a b = a `xor` (a .&. b)

sameMonth :: Card -> Pack
sameMonth card = 0xf `shift` (fromEnum card .&. 0xfc)

cards :: [Card]
cards = [Pine0 .. Phoenix]

shuffle :: [a] -> IO [a]
shuffle l =
  aux (length l) l
  where
    aux n [] = return []
    aux n (h:t) = do
      cut <- randomRIO (0, n-1)
      shuffled <- shuffle t
      let (top, bottom) = splitAt cut shuffled
      return $ top ++ h : bottom

pair :: Card -> Pack -> Maybe (Pack, [Card])
pair card pack =
  let sameMonthCards = sameMonth card `intersection` pack in
  case size sameMonthCards of
    0 -> Just (add pack card, [])
    1 -> Just (difference pack sameMonthCards, card : cardsOfPack sameMonthCards)
    _ -> Nothing