{-# 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