module Haverer.CLI.CommandLine (
ConsoleText(..),
formatScores,
pickNumPlayers,
pickCardToPlay,
pickPlay
) where
import BasicPrelude hiding (round)
import Control.Error hiding (readMay)
import qualified Data.Map as Map
import Haverer.Action (Play(..), viewAction)
import Haverer.Deck (Card(..))
import Haverer.Player (getDiscards, isProtected)
import Haverer.PlayerSet (PlayerSet, toPlayers)
import Haverer.Round (
Event(..),
Result(..),
Round,
Victory(..),
getPlayerMap,
remainingCards
)
import Haverer.CLI.Prompt (
ConsoleText,
repeatedlyPrompt,
chooseItem,
chooseItem',
underline,
toText
)
instance ConsoleText Card where
toText = show
instance ConsoleText a => ConsoleText (Round a) where
toText round =
"Cards remaining: " ++ show (remainingCards round) ++ ".\n\n" ++
underline '-' "All discards" ++ "\n" ++
Map.foldrWithKey (\k a b -> formatPlayer k a ++ "\n" ++ b) "" (getPlayerMap round)
where
formatPlayer pid player =
toText pid ++ ": " ++ intercalate ", " (map toText (getDiscards player)) ++ playerStatus player
playerStatus player =
case isProtected player of
Just True -> " (protected)"
Just False -> ""
Nothing -> " (eliminated)"
instance (Eq a, ConsoleText a, Show a) => ConsoleText (Result a) where
toText (Played (viewAction -> (pid1, Soldier, Guess pid2 card)) NoChange) =
toText pid1 ++ " wrongly guessed " ++ toText pid2 ++ " had a " ++ toText card
++ ". Nothing happened, maybe it was the right guess and they were protected."
toText (Played (viewAction -> (pid1, Knight, Attack pid2)) NoChange) =
toText pid1 ++ " attacked " ++ toText pid2 ++ " with a Knight, but nothing happened. "
++ "Because of a bug in the software, you don't know if it's because of a tie or "
++ "because " ++ toText pid2 ++ " is protected by the Priestess."
toText (Played (viewAction -> (pid1, card, Attack pid2)) NoChange) =
toText pid1 ++ " played " ++ toText card ++ " against " ++ toText pid2 ++
", but they were protected by the Priestess, so nothing happened"
toText (Played (viewAction -> (pid1, card, NoEffect)) NoChange) =
toText pid1 ++ " played " ++ toText card
toText (BustedOut pid c1 c2) =
toText pid ++ " busted out, holding " ++ toText c1 ++ " and " ++ toText c2
toText (Played (viewAction -> (pid, Priestess, _)) (Protected p))
| p == pid =
toText pid ++ " played Priestess, protecting themselves from harm"
| otherwise = error "BUG: " ++ show pid ++ " played Priestess but ended up protecting " ++ show p
toText (Played _ (SwappedHands pid1 pid2)) =
toText pid2 ++ " swapped hands with " ++ toText pid1
toText (Played (viewAction -> (pid1, Soldier, Guess pid2 card)) (Eliminated loser))
| loser == pid2 =
toText pid1 ++ " correctly guessed " ++ toText pid2 ++ " had a " ++ toText card
++ ". " ++ toText pid2 ++ " has been eliminated"
| otherwise = error "BUG: Soldier attacked " ++ show pid2 ++ " but eliminated " ++ show loser
toText (Played (viewAction -> (pid1, Knight, Attack pid2)) (Eliminated loser)) =
toText pid1 ++ " attacked " ++ toText pid2 ++ " with a Knight " ++
(if loser == pid1
then "and lost. "
else (if loser == pid2 then "and won. " else error "BUG: Knight!")) ++
toText loser ++ " has been eliminated"
toText (Played (viewAction -> (pid1, Prince, NoEffect)) (Eliminated loser))
| loser == pid1 = toText pid1 ++ " played the Prince, eliminating themselves"
| otherwise = error "BUG: " ++ show pid1 ++ " played Prince, but " ++ show loser ++ " eliminated."
toText (Played (viewAction -> (pid1, Wizard, Attack pid2)) (Eliminated loser))
| loser == pid2 =
toText pid1 ++ " played Wizard on " ++ toText pid2 ++ " forcing them to discard "
++ "and thus be eliminated from the round"
| otherwise = error "BUG: Wizard attacked " ++ show pid2 ++ " but eliminated " ++ show loser
toText (Played _ (ForcedDiscard pid)) =
toText pid ++ " was forced to discard their hand and draw another card"
toText (Played _ (ForcedReveal pid1 pid2 card)) =
toText pid1 ++ ": " ++ toText pid2 ++ " is holding a " ++ toText card
toText event = "UNKNOWN: " ++ show event
instance ConsoleText a => ConsoleText (Victory a) where
toText (SoleSurvivor pid card) =
toText pid ++ " wins as the only remaining player, holding " ++ toText card
toText (HighestCard card [winner] _) =
toText winner ++ " wins holding " ++ toText card
toText (HighestCard card winners _) =
"Many winners holding " ++ toText card ++ ": " ++ intercalate ", " (map toText winners)
formatScores :: ConsoleText playerId => [(playerId, Int)] -> Text
formatScores scores =
underline '-' "Scores" ++ "\n" ++
unlines (map formatScore scores)
where formatScore (pid, score) = toText pid ++ ": " ++ toText score
pickNumPlayers :: IO Int
pickNumPlayers =
repeatedlyPrompt "Pick number of players: " parseNumPlayers
where
parseNumPlayers s = do
i <- note errMsg (readMay s)
assertErr errMsg (2 <= i && i <= 4)
return i
errMsg = "Please enter a number between 2 and 4" :: Text
pickCardToPlay :: (Card, Card) -> IO Card
pickCardToPlay (dealt, hand) =
chooseItem "\nPlease choose a card: " [dealt, hand]
pickPlay :: ConsoleText playerId => Card -> PlayerSet playerId -> IO (Play playerId)
pickPlay card players =
case card of
Soldier -> pickGuess players
Clown -> pickAttack players
Knight -> pickAttack players
Priestess -> return NoEffect
Wizard -> pickAttack players
General -> pickAttack players
Minister -> return NoEffect
Prince -> return NoEffect
pickTarget :: ConsoleText playerId => PlayerSet playerId -> IO playerId
pickTarget ps = chooseItem "\nPlease choose a target: " (toPlayers ps)
pickAttack :: ConsoleText playerId => PlayerSet playerId -> IO (Play playerId)
pickAttack players = fmap Attack (pickTarget players)
pickGuess :: ConsoleText playerId => PlayerSet playerId -> IO (Play playerId)
pickGuess players = do
target <- pickTarget players
guess <- pickGuessCard
return $ Guess target guess
where pickGuessCard = chooseItem' "\nWhat card do they have?" 2 [Clown ..]