skat/Player.hs

{-# LANGUAGE ExistentialQuantification #-}

module Player where

import Control.Monad.IO.Class

import Card
import Pile

class (Monad m, MonadIO m) => MonadPlayer m where
    trumpColour :: m Colour
    turnColour :: m (Maybe Colour)
    showSkat :: Player p => p -> m (Maybe [Card])

class (Monad m, MonadIO m, MonadPlayer m) => MonadPlayerOpen m where
    showPiles :: m (Piles)

class Player p where
    team :: p -> Team
    hand :: p -> Hand
    chooseCard :: MonadPlayer m
               => p
               -> [CardS Played]
               -> [CardS Played]
               -> [Card]
               -> m (Card, p)
    onCardPlayed :: MonadPlayer m
                 => p
                 -> CardS Played
                 -> m p
    onCardPlayed p _ = return p
    chooseCardOpen :: MonadPlayerOpen m
                   => p
                   -> m Card
    chooseCardOpen p = do
        piles <- showPiles
        let table = tableCardsS piles
            fallen = played piles
            myCards = handCards (hand p) piles
        fmap fst $ chooseCard p table fallen myCards

data PL = forall p. (Show p, Player p) => PL p

instance Show PL where
    show (PL p) = show p

instance Player PL where
    team (PL p) = team p
    hand (PL p) = hand p
    chooseCard (PL p) table fallen hand = do
        (v, a) <- chooseCard p table fallen hand
        return $ (v, PL a)
    onCardPlayed (PL p) card = do
        v <- onCardPlayed p card
        return $ PL v
    chooseCardOpen (PL p) = chooseCardOpen p

data Players = Players PL PL PL
               deriving Show

player :: Players -> Hand -> PL
player (Players p _ _) Hand1 = p
player (Players _ p _) Hand2 = p
player (Players _ _ p) Hand3 = p

updatePlayer :: (Show p, Player p) => p -> Players -> Players
updatePlayer p (Players p1 p2 p3) = case hand p of
    Hand1 -> Players (PL p) p2 p3
    Hand2 -> Players p1 (PL p) p3
    Hand3 -> Players p1 p2 (PL p)

playersToList :: Players -> [PL]
playersToList (Players p1 p2 p3) = [p1, p2, p3]