module Snorkels.Game ( move , switch , quit , getSurvivors , getNextPlayer , getWinner , hasFinished , validSwitches , makeSwitches ) where import Data.Function import Data.Maybe import Data.List import qualified Data.Bimap as Bimap import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Snorkels.Types import qualified Snorkels.Board as B getSurvivors :: Game -> [Player] getSurvivors game = case filter hasSurvived players of [] -> [game¤tPlayer] s -> s where hasSurvived = not . B.hasLost game players = Map.keys $ game&playerTypes getNextPlayer :: Game -> Maybe Player getNextPlayer game = listToMaybe . drop 1 . dropWhile (/= (game¤tPlayer)) $ cycle $ getSurvivors game advancePlayer :: Game -> Game advancePlayer game = game {currentPlayer = fromJust (getNextPlayer game)} quit :: Game -> Game quit game = (advancePlayer game) {playerTypes = Map.delete (game¤tPlayer) (game&playerTypes)} move :: Position -> Game -> Either String Game move pos game | not validPosition = Left "Cannot place a snorkel there." | not survivors = Left "No surviving players left." | otherwise = Right $ advancePlayer . putSnorkel $ game where validPosition = elem pos $ B.freePositions game survivors = isJust $ getNextPlayer game putSnorkel g = B.putPiece g pos $ Snorkel (game¤tPlayer) validSwitches :: Game -> [Player] validSwitches game = getSurvivors game \\ Bimap.keysR (game&switches) switch :: Player -> Game -> Either String Game switch player game | player `notElem` validSwitches game = Left "Cannot switch to such color." | otherwise = Right $ nextPlayer . putSwitch $ game where putSwitch g = g {switches = Bimap.insert (g¤tPlayer) player (g&switches)} nextPlayer g = g {currentPlayer = fromJust (getNextPlayer g)} makeSwitches :: Game -> Game makeSwitches game = game {playerTypes = Map.mapKeys getChosen $ game&playerTypes} where getChosen p = fromMaybe p (Bimap.lookup p $ game&switches) getWinner :: Game -> Maybe Player getWinner game = case getSurvivors game of [x] -> Just x _ -> Nothing hasFinished :: Game -> Bool hasFinished = isJust . getWinner