module Haverer.Action (
BadPlay,
Play(..),
Action,
bustingHand,
getTarget,
getValidPlays,
playToAction,
viewAction
) where
import BasicPrelude
import Control.Monad.Except
import Haverer.Deck (Card(..))
data Play target = NoEffect | Attack target | Guess target Card deriving (Eq, Show)
data Action target = Action target Card (Play target) deriving (Eq, Show)
data BadPlay target = BadActionForCard (Play target) Card
| BadGuess
| SelfTarget
deriving Show
viewAction :: Action target -> (target, Card, Play target)
viewAction (Action pid card play) = (pid, card, play)
getTarget :: Play target -> Maybe target
getTarget NoEffect = Nothing
getTarget (Attack target) = Just target
getTarget (Guess target _) = Just target
playToAction :: (Eq target, MonadError (BadPlay target) m) => target -> Card -> Play target -> m (Action target)
playToAction pid card play = Action pid card <$> _validatePlay pid card play
_validatePlay :: (Eq target, MonadError (BadPlay target) m) => target -> Card -> Play target -> m (Play target)
_validatePlay _ Soldier (Guess _ Soldier) = throwError BadGuess
_validatePlay player Soldier play@(Guess target _)
| player == target = throwError SelfTarget
| otherwise = return play
_validatePlay player Clown play@(Attack target)
| player == target = throwError SelfTarget
| otherwise = return play
_validatePlay player Knight play@(Attack target)
| player == target = throwError SelfTarget
| otherwise = return play
_validatePlay _ Priestess NoEffect = return NoEffect
_validatePlay _ Wizard play@(Attack _) = return play
_validatePlay player General play@(Attack target)
| player == target = throwError SelfTarget
| otherwise = return play
_validatePlay _ Minister NoEffect = return NoEffect
_validatePlay _ Prince NoEffect = return NoEffect
_validatePlay _ card play = throwError (BadActionForCard play card)
getValidPlaysForCard :: target
-> [target]
-> Card
-> [Play target]
getValidPlaysForCard self others card =
case card of
Soldier -> [Guess tgt c | tgt <- others, c <- [Clown ..]]
Clown -> fmap Attack others
Knight -> fmap Attack others
Priestess -> [NoEffect]
Wizard -> fmap Attack (self:others)
General -> fmap Attack others
Minister -> [NoEffect]
Prince -> [NoEffect]
getValidPlays :: player
-> [player]
-> Card
-> Card
-> [(Card, Play player)]
getValidPlays self others dealt hand = do
guard $ not $ bustingHand dealt hand
[(dealt, play) | play <- playsForCard dealt] ++
[(hand, play) | play <-playsForCard hand]
where playsForCard = getValidPlaysForCard self others
bustingHand :: Card -> Card -> Bool
bustingHand Minister card = card >= Wizard
bustingHand card Minister = bustingHand Minister card
bustingHand _ _ = False