lib/src/Hanafuda/Player.hs

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

import Hanafuda (Card, Pack, contains, packOfCards, remove)
import Data.Map (Map, fromList)
import System.Random (Random(..))

data Seat =
    Player1
  | Player2
  deriving (Eq, Ord, Show, Enum)

instance Random Seat where
  randomR (lo, hi) g =
    let (n, g') = randomR (fromEnum lo, fromEnum hi) g in
    (toEnum n, g')

  random = randomR (Player1, Player2)

next :: Seat -> Seat
next Player1 = Player2
next _ = Player1

data Player a = Player {
      hand :: Pack
    , meld :: Pack
    , yakus :: a
  } deriving (Show)
type Players a = Map Seat (Player a)

deal :: [a] -> Map Seat a
deal = fromList . zip [Player1, Player2]

new :: Monoid a => [Card] -> Player a
new cards = Player {
      hand = packOfCards cards
    , meld = packOfCards []
    , yakus = mempty
  }

plays :: Player a -> Card -> Either String (Player a)
plays player@(Player {hand}) card =
  if hand `contains` card
    then Right $ player {hand = remove hand card}
    else Left "You don't have this card"

type Points = Int

score :: (a -> Points) -> Player a -> Int
score rater = rater . yakus

type Scores = Map Seat Points