module Hanafuda (
      Card(..)
    , Flower(..)
    , Monthly
    , Pack
    , add
    , cards
    , cardsOf
    , cardsOfPack
    , contains
    , difference
    , empty
    , flower
    , intersection
    , match
    , packOfCards
    , remove
    , sameMonth
    , shuffle
    , size
    , union
  ) where

import Data.Word (Word64)
import Data.Bits (
      clearBit
    , popCount
    , setBit
    , shift
    , testBit
    , xor
    , (.&.)
    , (.|.)
    , countTrailingZeros
  )
import System.Random (randomRIO)
import Control.Monad.IO.Class (MonadIO(..))
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

newtype Pack = Pack { unpack :: Word64 } deriving (Eq)

empty :: Pack
empty = Pack 0

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

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

cardsOfPack :: Pack -> [Card]
cardsOfPack (Pack 0) = []
cardsOfPack p =
  let c = smallest p in
  c : cardsOfPack (remove p c)

instance Show Pack where
  show = ("packOfCards " ++) . show . cardsOfPack

portEnum :: Enum e => (Word64 -> Int -> b) -> Pack -> e -> b
portEnum f (Pack p) = f p . fromEnum

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

size :: Pack -> Int
size (Pack p) = popCount p

add :: Pack -> Card -> Pack
add p = Pack . portEnum setBit p

remove :: Pack -> Card -> Pack
remove p = Pack . portEnum clearBit p

portBinary :: (Word64 -> Word64 -> Word64) -> Pack -> Pack -> Pack
portBinary operator (Pack a) (Pack b) = Pack $ operator a b

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

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

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

cardsOf :: Flower -> Pack
cardsOf = Pack . shift 0xf . (* 4) . fromEnum

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

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

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

match :: Card -> Pack -> Either String (Pack, [Card])
match card pack =
  let sameMonthCards = sameMonth card pack in
  case size sameMonthCards of
    0 -> Right (add pack card, [])
    1 -> Right (difference pack sameMonthCards, card : cardsOfPack sameMonthCards)
    _ -> Left "This card can match several others"