skat/Skat.hs

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}

module Skat where

import Control.Monad.State
import Control.Monad.Reader
import Data.List

import Card
import Pile
import Player (Players)
import qualified Player as P

data SkatEnv = SkatEnv { piles :: Piles
                       , turnColour :: Maybe Colour
                       , trumpColour :: Colour
                       , players :: Players }
               deriving Show

type Skat = StateT SkatEnv IO

instance P.MonadPlayer Skat where
    trumpColour = gets trumpColour
    turnColour = gets turnColour
    showSkat p = case P.team p of
        Single -> fmap (Just . skatCards) $ gets piles
        Team -> return Nothing

instance P.MonadPlayerOpen Skat where
    showPiles = gets piles

modifyp :: (Piles -> Piles) -> Skat ()
modifyp f = modify g
    where g env@(SkatEnv {piles}) = env { piles = f piles}

getp :: (Piles -> a) -> Skat a
getp f = gets piles >>= return . f

modifyPlayers :: (Players -> Players) -> Skat ()
modifyPlayers f = modify g
    where g env@(SkatEnv {players}) = env { players = f players }

setTurnColour :: Maybe Colour -> SkatEnv -> SkatEnv
setTurnColour col sk = sk { turnColour = col }

mkSkatEnv :: Piles -> Maybe Colour -> Colour -> Players -> SkatEnv
mkSkatEnv = SkatEnv