werewolf 0.4.9.0 → 0.4.10.0
raw patch · 11 files changed
+150/−28 lines, 11 files
Files
- CHANGELOG.md +6/−0
- app/Main.hs +2/−0
- app/Werewolf/Command/Boot.hs +48/−0
- app/Werewolf/Command/Help.hs +1/−0
- app/Werewolf/Options.hs +9/−3
- src/Game/Werewolf/Command.hs +16/−20
- src/Game/Werewolf/Engine.hs +14/−1
- src/Game/Werewolf/Game.hs +5/−2
- src/Game/Werewolf/Messages.hs +23/−0
- src/Game/Werewolf/Util.hs +24/−1
- werewolf.cabal +2/−1
CHANGELOG.md view
@@ -2,6 +2,12 @@ #### Upcoming +#### v0.4.10.0++*Minor*++* Added `boot` command. ([#14](https://github.com/hjwylde/werewolf/issues/14))+ #### v0.4.9.0 *Minor*
app/Main.hs view
@@ -20,6 +20,7 @@ import System.Environment +import qualified Werewolf.Command.Boot as Boot import qualified Werewolf.Command.Choose as Choose import qualified Werewolf.Command.Circle as Circle import qualified Werewolf.Command.End as End@@ -56,6 +57,7 @@ handle :: Options -> IO () handle (Options callerName command) = case command of Choose options -> Choose.handle callerName options+ Boot options -> Boot.handle callerName options Circle options -> Circle.handle callerName options End options -> End.handle callerName options Heal -> Heal.handle callerName
+ app/Werewolf/Command/Boot.hs view
@@ -0,0 +1,48 @@+{-|+Module : Werewolf.Command.Boot+Description : Options and handler for the boot subcommand.++Copyright : (c) Henry J. Wylde, 2016+License : BSD3+Maintainer : public@hjwylde.com++Options and handler for the boot subcommand.+-}++module Werewolf.Command.Boot (+ -- * Options+ Options(..),++ -- * Handle+ handle,+) where++import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.State+import Control.Monad.Writer++import Data.Text (Text)++import Game.Werewolf++import Werewolf.Game+import Werewolf.Messages++data Options = Options+ { argTarget :: Text+ } deriving (Eq, Show)++handle :: MonadIO m => Text -> Options -> m ()+handle callerName (Options targetName) = do+ unlessM doesGameExist $ exitWith failure+ { messages = [noGameRunningMessage callerName]+ }++ game <- readGame++ let command = bootCommand callerName targetName++ case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of+ Left errorMessages -> exitWith failure { messages = errorMessages }+ Right (game', messages) -> writeGame game' >> exitWith success { messages = messages }
app/Werewolf/Command/Help.hs view
@@ -75,6 +75,7 @@ [ [ "Global commands:" , "- `start ([-e | --extra-roles ROLE,...] | [-r | --random-extra-roles]) PLAYER...`" , "- `end`"+ , "- `boot PLAYER`" , "- `quit`" , "- `version`" ]
app/Werewolf/Options.hs view
@@ -23,9 +23,10 @@ import qualified Data.Text as T import Data.Version (showVersion) +import qualified Werewolf.Command.Boot as Boot import qualified Werewolf.Command.Choose as Choose import qualified Werewolf.Command.Circle as Circle-import qualified Werewolf.Command.End as End+import qualified Werewolf.Command.End as End import qualified Werewolf.Command.Help as Help import qualified Werewolf.Command.Interpret as Interpret import qualified Werewolf.Command.Poison as Poison@@ -43,7 +44,8 @@ } deriving (Eq, Show) data Command- = Choose Choose.Options+ = Boot Boot.Options+ | Choose Choose.Options | Circle Circle.Options | End End.Options | Heal@@ -92,7 +94,8 @@ , help "Specify the calling player's name" ]) <*> subparser (mconcat- [ command "choose" $ info (helper <*> choose) (fullDesc <> progDesc "Choose an allegiance or player(s)")+ [ command "boot" $ info (helper <*> boot) (fullDesc <> progDesc "Vote to boot a player")+ , command "choose" $ info (helper <*> choose) (fullDesc <> progDesc "Choose an allegiance or player(s)") , command "circle" $ info (helper <*> circle) (fullDesc <> progDesc "Get the game circle") , command "end" $ info (helper <*> end) (fullDesc <> progDesc "End the current game") , command "heal" $ info (helper <*> heal) (fullDesc <> progDesc "Heal the devoured player")@@ -110,6 +113,9 @@ , command "version" $ info (helper <*> version) (fullDesc <> progDesc "Show this engine's version") , command "vote" $ info (helper <*> vote) (fullDesc <> progDesc "Vote against a player") ])++boot :: Parser Command+boot = Boot . Boot.Options <$> playerArgument choose :: Parser Command choose = Choose . Choose.Options . map T.pack <$> some (strArgument $ metavar "(ALLEGIANCE | PLAYER...)")
src/Game/Werewolf/Command.hs view
@@ -19,10 +19,10 @@ Command(..), -- ** Instances- chooseAllegianceCommand, choosePlayerCommand, choosePlayersCommand, circleCommand, healCommand,- noopCommand, passDevotedServantsTurnCommand, passWitchsTurnCommand, pingCommand, poisonCommand,- protectCommand, quitCommand, revealCommand, seeCommand, statusCommand, voteDevourCommand,- voteLynchCommand,+ bootCommand, chooseAllegianceCommand, choosePlayerCommand, choosePlayersCommand, circleCommand,+ healCommand, noopCommand, passDevotedServantsTurnCommand, passWitchsTurnCommand, pingCommand,+ poisonCommand, protectCommand, quitCommand, revealCommand, seeCommand, statusCommand,+ voteDevourCommand, voteLynchCommand, ) where import Control.Lens@@ -48,6 +48,17 @@ data Command = Command { apply :: forall m . (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => m () } +bootCommand :: Text -> Text -> Command+bootCommand callerName targetName = Command $ do+ validatePlayer callerName callerName+ validatePlayer callerName targetName+ whenM (uses (boots . at targetName) $ elem callerName . maybe [] id) $+ throwError [playerHasAlreadyVotedToBootMessage callerName targetName]++ boots %= Map.insertWith (++) targetName [callerName]++ tell [playerVotedToBootMessage callerName targetName]+ chooseAllegianceCommand :: Text -> Text -> Command chooseAllegianceCommand callerName allegianceName = Command $ do validatePlayer callerName callerName@@ -198,24 +209,9 @@ caller <- findPlayerBy_ name callerName - killPlayer callerName tell [playerQuitMessage caller] - passes %= delete callerName- votes %= Map.delete callerName-- when (is angel caller) $ setPlayerAllegiance callerName Villagers- when (is defender caller) $ do- protect .= Nothing- priorProtect .= Nothing- when (is seer caller) $ see .= Nothing- when (is wildChild caller) $ roleModel .= Nothing- when (is witch caller) $ do- heal .= False- healUsed .= False- poison .= Nothing- poisonUsed .= False- when (is wolfHound caller) $ allegianceChosen .= Nothing+ removePlayer callerName revealCommand :: Text -> Command revealCommand callerName = Command $ do
src/Game/Werewolf/Engine.hs view
@@ -48,11 +48,23 @@ checkStage :: (MonadState Game m, MonadWriter [Message] m) => m () checkStage = do game <- get- checkStage' >> checkEvents+ checkBoots >> checkStage' >> checkEvents game' <- get when (game /= game') checkStage +checkBoots :: (MonadState Game m, MonadWriter [Message] m) => m ()+checkBoots = do+ alivePlayerCount <- length . toListOf (players . traverse . alive) <$> get++ booteeNames <- uses boots $ Map.keys . Map.filter (\voters -> length voters > alivePlayerCount `div` 2)+ bootees <- mapM (findPlayerBy_ name) booteeNames++ forM_ (filter (is alive) bootees) $ \bootee -> do+ tell [playerBootedMessage bootee]++ removePlayer (bootee ^. name)+ checkStage' :: (MonadState Game m, MonadWriter [Message] m) => m () checkStage' = use stage >>= \stage' -> case stage' of DefendersTurn -> do@@ -204,6 +216,7 @@ (return . head $ filter (stageAvailable game) (drop1 $ dropWhile (game ^. stage /=) stageCycle)) stage .= nextStage+ boots .= Map.empty passes .= [] see .= Nothing
src/Game/Werewolf/Game.hs view
@@ -17,8 +17,9 @@ module Game.Werewolf.Game ( -- * Game Game,- stage, round, players, events, passes, allegianceChosen, allowedVoters, heal, healUsed, poison,- poisonUsed, priorProtect, protect, roleModel, scapegoatBlamed, see, villageIdiotRevealed, votes,+ stage, round, players, events, boots, passes, allegianceChosen, allowedVoters, heal, healUsed,+ poison, poisonUsed, priorProtect, protect, roleModel, scapegoatBlamed, see,+ villageIdiotRevealed, votes, Stage(..), _DefendersTurn, _DevotedServantsTurn, _GameOver, _Lynching, _ScapegoatsTurn, _SeersTurn,@@ -85,6 +86,7 @@ , _round :: Int , _players :: [Player] , _events :: [Event]+ , _boots :: Map Text [Text] , _allegianceChosen :: Maybe Allegiance -- ^ Wolf-hound , _allowedVoters :: [Text] -- ^ Scapegoat , _heal :: Bool -- ^ Witch@@ -195,6 +197,7 @@ , _round = 0 , _players = players , _events = []+ , _boots = Map.empty , _passes = [] , _allegianceChosen = Nothing , _allowedVoters = players ^.. names
src/Game/Werewolf/Messages.hs view
@@ -25,6 +25,12 @@ playerDoesNotExistMessage, playerCannotDoThatMessage, playerCannotDoThatRightNowMessage, playerIsDeadMessage, targetIsDeadMessage, + -- * Boot messages+ playerVotedToBootMessage, playerBootedMessage,++ -- ** Error messages+ playerHasAlreadyVotedToBootMessage,+ -- * Circle messages circleMessage, @@ -352,6 +358,23 @@ targetIsDeadMessage :: Text -> Text -> Message targetIsDeadMessage to targetName = privateMessage to $ T.unwords [targetName, "is already dead!"]++playerVotedToBootMessage :: Text -> Text -> Message+playerVotedToBootMessage playerName targetName = publicMessage $ T.concat+ [playerName, " voted to boot ", targetName, "!"]++playerBootedMessage :: Player -> Message+playerBootedMessage player = publicMessage $ T.unwords+ [ playerName, article playerRole, playerRole ^. Role.name+ , "has been booted from the game!"+ ]+ where+ playerName = player ^. name+ playerRole = player ^. role++playerHasAlreadyVotedToBootMessage :: Text -> Text -> Message+playerHasAlreadyVotedToBootMessage to targetName = privateMessage to $ T.concat+ ["You've already voted to boot ", targetName, "!"] circleMessage :: Text -> [Player] -> Message circleMessage to players = privateMessage to $ T.concat
src/Game/Werewolf/Util.hs view
@@ -17,7 +17,7 @@ -- * Game -- ** Manipulations- killPlayer, setPlayerAllegiance, setPlayerRole,+ killPlayer, removePlayer, setPlayerAllegiance, setPlayerRole, -- ** Searches findPlayerBy_, getAdjacentAlivePlayers, getPassers, getPlayerVote,@@ -44,6 +44,7 @@ import Data.List import Data.Maybe+import qualified Data.Map as Map import Data.Text (Text) import Game.Werewolf.Game hiding (doesPlayerExist, getAllowedVoters, getPendingVoters,@@ -57,6 +58,28 @@ killPlayer :: MonadState Game m => Text -> m () killPlayer name = modify $ Game.killPlayer name++removePlayer :: MonadState Game m => Text -> m ()+removePlayer name' = do+ killPlayer name'++ passes %= delete name'+ votes %= Map.delete name'++ player <- findPlayerBy_ name name'++ when (is angel player) $ setPlayerAllegiance name' Villagers+ when (is defender player) $ do+ protect .= Nothing+ priorProtect .= Nothing+ when (is seer player) $ see .= Nothing+ when (is wildChild player) $ roleModel .= Nothing+ when (is witch player) $ do+ heal .= False+ healUsed .= False+ poison .= Nothing+ poisonUsed .= False+ when (is wolfHound player) $ allegianceChosen .= Nothing -- | Fudges the player's allegiance. This function is useful for roles such as the Wild-child where -- they align themselves differently given some trigger.
werewolf.cabal view
@@ -1,5 +1,5 @@ name: werewolf-version: 0.4.9.0+version: 0.4.10.0 author: Henry J. Wylde maintainer: public@hjwylde.com@@ -28,6 +28,7 @@ hs-source-dirs: app/ ghc-options: -threaded -with-rtsopts=-N other-modules:+ Werewolf.Command.Boot Werewolf.Command.Choose Werewolf.Command.Circle Werewolf.Command.End