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

import Hanafuda (Card, Pack, contains, packOfCards, remove)
import qualified Hanafuda.ID as Hanafuda (ID, IDType(..), Prefix(..))
import Data.Map ((!), Map, elemAt, insert, keys, size)
import qualified Data.Map as Map (fromList, keys)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Except (MonadError(..))
import System.Random (Random(..))

type ID yakus = Hanafuda.ID (Player yakus)
instance Hanafuda.IDType (Player yakus) where
  prefix = Hanafuda.Prefix "Player"

data Player yakus = Player {
      hand :: Pack
    , meld :: Pack
    , yakus :: yakus
  } deriving (Show)
newtype Players yakus = Players (Map (ID yakus) (Player yakus)) deriving (Show)

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

players :: Monoid yakus => [ID yakus] -> Players yakus
players = Players . Map.fromList . fmap (\playerID -> (playerID, new []))

random :: MonadIO m => Players yakus -> m (ID yakus)
random (Players playersByID) =
  fst . ($ playersByID) . elemAt <$> randomIndex
  where
    randomIndex = liftIO $ randomRIO (0, size playersByID - 1)

get :: (ID yakus) -> Players yakus -> Player yakus
get playerID (Players playersByID) = playersByID ! playerID

set :: (ID yakus) -> Player yakus -> Players yakus -> Players yakus
set playerID player (Players playersByID) = Players $ insert playerID player playersByID

deal :: Monoid yakus => Players yakus -> [[Card]] -> Players yakus
deal (Players playersByID) hands =
  Players . Map.fromList . zipWith setHand hands $ Map.keys playersByID
  where
    setHand cards playerID = (playerID, new cards)

plays :: MonadError String m => Player yakus -> Card -> m (Player yakus)
plays player@(Player {hand}) card =
  if hand `contains` card
    then return $ player {hand = remove hand card}
    else throwError "You don't have this card"

type Points = Int
type Scores yakus = Map (ID yakus) Points

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

scores :: Players yakus -> [Points] -> Scores yakus
scores (Players playersByKey) = Map.fromList . zip (keys playersByKey)