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