diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,26 @@ ### Upcoming +### v1.2.0.0 + +*Major* + +* Renamed FerinasGrunt to DruidsTurn. ([#155](https://github.com/hjwylde/werewolf/issues/155)) +* Added tag field to Role. ([#155](https://github.com/hjwylde/werewolf/issues/155)) +* Added variant field to Game. ([#222](https://github.com/hjwylde/werewolf/issues/222)) + +*Minor* + +* Moved messages to external files using QuasiQuotes. ([#155](https://github.com/hjwylde/werewolf/issues/155)) +* Moved role names, descriptions and rules to external files using QuasiQuotes. ([#155](https://github.com/hjwylde/werewolf/issues/155)) +* Removed `--include-seer` option from `start`. ([#223](https://github.com/hjwylde/werewolf/issues/223)) +* Removed `--force` option from `end`. ([#224](https://github.com/hjwylde/werewolf/issues/224)) +* Added the no-role-knowledge variant. ([#182](https://github.com/hjwylde/werewolf/issues/182)) + +*Revisions* + +* Updated Crooked Senator's balance to 2. + ### v1.1.1.0 *Revisions* diff --git a/app/Game/Werewolf/Command.hs b/app/Game/Werewolf/Command.hs --- a/app/Game/Werewolf/Command.hs +++ b/app/Game/Werewolf/Command.hs @@ -24,6 +24,7 @@ validatePlayer, ) where +import Control.Lens.Extra import Control.Monad.Except import Control.Monad.Extra import Control.Monad.State @@ -31,9 +32,9 @@ import Data.Text (Text) -import Game.Werewolf.Game -import Game.Werewolf.Messages -import Game.Werewolf.Response +import Game.Werewolf +import Game.Werewolf.Message.Command +import Game.Werewolf.Message.Error import Game.Werewolf.Util data Command = Command { apply :: forall m . (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => m () } @@ -42,7 +43,10 @@ noopCommand = Command $ return () validatePlayer :: (MonadError [Message] m, MonadState Game m) => Text -> Text -> m () -validatePlayer callerName name = do +validatePlayer callerName name' = do whenM isGameOver $ throwError [gameIsOverMessage callerName] - unlessM (doesPlayerExist name) $ throwError [playerDoesNotExistMessage callerName name] - whenM (isPlayerDead name) $ throwError [if callerName == name then playerIsDeadMessage callerName else targetIsDeadMessage callerName name] + unlessM (doesPlayerExist name') $ throwError [playerDoesNotExistMessage callerName name'] + + player <- findPlayerBy_ name name' + + when (is dead player) $ throwError [if callerName == name' then playerIsDeadMessage callerName else targetIsDeadMessage callerName player] diff --git a/app/Game/Werewolf/Command/Global.hs b/app/Game/Werewolf/Command/Global.hs --- a/app/Game/Werewolf/Command/Global.hs +++ b/app/Game/Werewolf/Command/Global.hs @@ -25,19 +25,24 @@ import Game.Werewolf import Game.Werewolf.Command -import Game.Werewolf.Messages +import Game.Werewolf.Message.Command +import Game.Werewolf.Message.Error import Game.Werewolf.Util bootCommand :: Text -> Text -> Command bootCommand callerName targetName = Command $ do validatePlayer callerName callerName validatePlayer callerName targetName + + caller <- findPlayerBy_ name callerName + target <- findPlayerBy_ name targetName + whenM (uses (boots . at targetName) $ elem callerName . fromMaybe []) $ - throwError [playerHasAlreadyVotedToBootMessage callerName targetName] + throwError [playerHasAlreadyVotedToBootMessage callerName target] boots %= Map.insertWith (++) targetName [callerName] - tell [playerVotedToBootMessage callerName targetName] + tell [playerVotedToBootMessage caller target] quitCommand :: Text -> Command quitCommand callerName = Command $ do diff --git a/app/Game/Werewolf/Command/Hunter.hs b/app/Game/Werewolf/Command/Hunter.hs --- a/app/Game/Werewolf/Command/Hunter.hs +++ b/app/Game/Werewolf/Command/Hunter.hs @@ -23,7 +23,8 @@ import Game.Werewolf import Game.Werewolf.Command -import Game.Werewolf.Messages +import Game.Werewolf.Message.Command +import Game.Werewolf.Message.Error import Game.Werewolf.Util chooseCommand :: Text -> Text -> Command diff --git a/app/Game/Werewolf/Command/Oracle.hs b/app/Game/Werewolf/Command/Oracle.hs --- a/app/Game/Werewolf/Command/Oracle.hs +++ b/app/Game/Werewolf/Command/Oracle.hs @@ -22,7 +22,7 @@ import Game.Werewolf import Game.Werewolf.Command -import Game.Werewolf.Messages +import Game.Werewolf.Message.Error import Game.Werewolf.Util divineCommand :: Text -> Text -> Command diff --git a/app/Game/Werewolf/Command/Orphan.hs b/app/Game/Werewolf/Command/Orphan.hs --- a/app/Game/Werewolf/Command/Orphan.hs +++ b/app/Game/Werewolf/Command/Orphan.hs @@ -22,7 +22,7 @@ import Game.Werewolf import Game.Werewolf.Command -import Game.Werewolf.Messages +import Game.Werewolf.Message.Error import Game.Werewolf.Util chooseCommand :: Text -> Text -> Command diff --git a/app/Game/Werewolf/Command/Protector.hs b/app/Game/Werewolf/Command/Protector.hs --- a/app/Game/Werewolf/Command/Protector.hs +++ b/app/Game/Werewolf/Command/Protector.hs @@ -23,7 +23,7 @@ import Game.Werewolf import Game.Werewolf.Command -import Game.Werewolf.Messages +import Game.Werewolf.Message.Error import Game.Werewolf.Util protectCommand :: Text -> Text -> Command diff --git a/app/Game/Werewolf/Command/Scapegoat.hs b/app/Game/Werewolf/Command/Scapegoat.hs --- a/app/Game/Werewolf/Command/Scapegoat.hs +++ b/app/Game/Werewolf/Command/Scapegoat.hs @@ -22,7 +22,8 @@ import Game.Werewolf import Game.Werewolf.Command -import Game.Werewolf.Messages +import Game.Werewolf.Message.Command +import Game.Werewolf.Message.Error import Game.Werewolf.Util chooseCommand :: Text -> [Text] -> Command diff --git a/app/Game/Werewolf/Command/Seer.hs b/app/Game/Werewolf/Command/Seer.hs --- a/app/Game/Werewolf/Command/Seer.hs +++ b/app/Game/Werewolf/Command/Seer.hs @@ -22,7 +22,7 @@ import Game.Werewolf import Game.Werewolf.Command -import Game.Werewolf.Messages +import Game.Werewolf.Message.Error import Game.Werewolf.Util seeCommand :: Text -> Text -> Command diff --git a/app/Game/Werewolf/Command/Status.hs b/app/Game/Werewolf/Command/Status.hs --- a/app/Game/Werewolf/Command/Status.hs +++ b/app/Game/Werewolf/Command/Status.hs @@ -11,7 +11,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} module Game.Werewolf.Command.Status ( -- * Commands @@ -25,11 +24,12 @@ import Data.List import Data.Text (Text) -import Game.Werewolf hiding (getPendingVoters) -import Game.Werewolf.Command -import Game.Werewolf.Messages -import qualified Game.Werewolf.Role as Role -import Game.Werewolf.Util +-- TODO (hjw): remove Message.Engine +import Game.Werewolf hiding (getPendingVoters) +import Game.Werewolf.Command +import Game.Werewolf.Message.Command +import Game.Werewolf.Message.Engine +import Game.Werewolf.Util circleCommand :: Text -> Bool -> Command circleCommand callerName includeDead = Command $ do @@ -39,7 +39,7 @@ pingCommand :: Text -> Command pingCommand callerName = Command $ use stage >>= \stage' -> case stage' of - FerinasGrunt -> return () + DruidsTurn -> return () GameOver -> tell [gameIsOverMessage callerName] HuntersTurn1 -> pingRole hunterRole HuntersTurn2 -> pingRole hunterRole @@ -60,7 +60,7 @@ pingRole role' = do player <- findPlayerBy_ role role' - tell [pingRoleMessage $ role' ^. Role.name] + tell . (:[]) . pingRoleMessage role' =<< get tell [pingPlayerMessage $ player ^. name] pingVillagers :: (MonadState Game m, MonadWriter [Message] m) => m () @@ -68,23 +68,21 @@ allowedVoterNames <- use allowedVoters pendingVoterNames <- toListOf names <$> getPendingVoters - tell [pingRoleMessage "village"] + tell [pingVillageMessage] tell $ map pingPlayerMessage (allowedVoterNames `intersect` pendingVoterNames) pingWerewolves :: (MonadState Game m, MonadWriter [Message] m) => m () pingWerewolves = do pendingVoters <- getPendingVoters - tell [pingRoleMessage "Werewolves"] + tell . (:[]) . pingWerewolvesMessage =<< get tell $ map pingPlayerMessage (pendingVoters ^.. werewolves . name) statusCommand :: Text -> Command -statusCommand callerName = Command $ use stage >>= \stage' -> case stage' of - GameOver -> tell [gameIsOverMessage callerName] - _ -> tell . statusMessages stage' =<< use players - where - statusMessages stage players = - currentStageMessages callerName stage ++ - [ rolesInGameMessage (Just callerName) (players ^.. roles) - , playersInGameMessage callerName players - ] +statusCommand callerName = Command $ do + game <- get + + tell [ currentStageMessage callerName game + , rolesInGameMessage (Just callerName) game + , playersInGameMessage callerName game + ] diff --git a/app/Game/Werewolf/Command/Villager.hs b/app/Game/Werewolf/Command/Villager.hs --- a/app/Game/Werewolf/Command/Villager.hs +++ b/app/Game/Werewolf/Command/Villager.hs @@ -29,7 +29,8 @@ import Game.Werewolf import Game.Werewolf.Command -import Game.Werewolf.Messages +import Game.Werewolf.Message.Command +import Game.Werewolf.Message.Error import Game.Werewolf.Util unvoteCommand :: Text -> Command @@ -39,8 +40,10 @@ votes %= Map.delete callerName + caller <- findPlayerBy_ name callerName + whenJustM (preuse $ players . crookedSenators . alive) $ \crookedSenator -> - tell [playerRescindedVoteMessage (crookedSenator ^. name) callerName] + tell [playerRescindedVoteMessage (crookedSenator ^. name) caller] voteCommand :: Text -> Text -> Command voteCommand callerName targetName = Command $ do @@ -50,8 +53,11 @@ votes %= Map.insert callerName targetName + caller <- findPlayerBy_ name callerName + target <- findPlayerBy_ name targetName + whenJustM (preuse $ players . crookedSenators . alive) $ \crookedSenator -> - tell [playerMadeLynchVoteMessage (Just $ crookedSenator ^. name) callerName targetName] + tell [playerMadeLynchVoteMessage (Just $ crookedSenator ^. name) caller target] validateCommand :: (MonadError [Message] m, MonadState Game m) => Text -> m () validateCommand callerName = do diff --git a/app/Game/Werewolf/Command/Werewolf.hs b/app/Game/Werewolf/Command/Werewolf.hs --- a/app/Game/Werewolf/Command/Werewolf.hs +++ b/app/Game/Werewolf/Command/Werewolf.hs @@ -33,7 +33,8 @@ import Game.Werewolf import Game.Werewolf.Command -import Game.Werewolf.Messages +import Game.Werewolf.Message.Command +import Game.Werewolf.Message.Error import Game.Werewolf.Util unvoteCommand :: Text -> Command @@ -43,9 +44,10 @@ votes %= Map.delete callerName - aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get + aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get + caller <- findPlayerBy_ name callerName - tell [playerRescindedVoteMessage werewolfName callerName | werewolfName <- aliveWerewolfNames \\ [callerName]] + tell [playerRescindedVoteMessage werewolfName caller | werewolfName <- aliveWerewolfNames \\ [callerName]] voteCommand :: Text -> Text -> Command voteCommand callerName targetName = Command $ do @@ -56,9 +58,11 @@ votes %= Map.insert callerName targetName - aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get + aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get + caller <- findPlayerBy_ name callerName + target <- findPlayerBy_ name targetName - tell [playerMadeDevourVoteMessage werewolfName callerName targetName | werewolfName <- aliveWerewolfNames \\ [callerName]] + tell [playerMadeDevourVoteMessage werewolfName caller target | werewolfName <- aliveWerewolfNames \\ [callerName]] validateCommand :: (MonadError [Message] m, MonadState Game m) => Text -> m () validateCommand callerName = do diff --git a/app/Game/Werewolf/Command/Witch.hs b/app/Game/Werewolf/Command/Witch.hs --- a/app/Game/Werewolf/Command/Witch.hs +++ b/app/Game/Werewolf/Command/Witch.hs @@ -28,7 +28,7 @@ import Game.Werewolf import Game.Werewolf.Command -import Game.Werewolf.Messages +import Game.Werewolf.Message.Error import Game.Werewolf.Util healCommand :: Text -> Command diff --git a/app/Game/Werewolf/Engine.hs b/app/Game/Werewolf/Engine.hs --- a/app/Game/Werewolf/Engine.hs +++ b/app/Game/Werewolf/Engine.hs @@ -29,12 +29,14 @@ import qualified Data.Map as Map import Data.Maybe -import Game.Werewolf.Game hiding (getAllowedVoters, getPendingVoters, hasAnyoneWon, - hasFallenAngelWon, hasVillagersWon, hasWerewolvesWon) -import Game.Werewolf.Messages +-- TODO (hjw): remove Message.Command +import Game.Werewolf.Game hiding (getAllowedVoters, getPendingVoters, hasAnyoneWon, + hasFallenAngelWon, hasVillagersWon, hasWerewolvesWon) +import Game.Werewolf.Message.Command +import Game.Werewolf.Message.Engine import Game.Werewolf.Player import Game.Werewolf.Response -import Game.Werewolf.Role hiding (name) +import Game.Werewolf.Role hiding (name) import Game.Werewolf.Util import Prelude hiding (round) @@ -61,7 +63,7 @@ checkStage' :: (MonadRandom m, MonadState Game m, MonadWriter [Message] m) => m () checkStage' = use stage >>= \stage' -> case stage' of - FerinasGrunt -> do + DruidsTurn -> do druid <- findPlayerBy_ role druidRole players' <- filter (isn't alphaWolf) <$> getAdjacentAlivePlayers (druid ^. name) @@ -103,8 +105,8 @@ whenM (isJust <$> use protect) advanceStage ScapegoatsTurn -> unlessM (use scapegoatBlamed) $ do - allowedVoters' <- use allowedVoters - tell [scapegoatChoseAllowedVotersMessage allowedVoters'] + game <- get + tell [scapegoatChoseAllowedVotersMessage game] advanceStage @@ -147,17 +149,13 @@ orphan <- findPlayerBy_ role orphanRole whenM (isPlayerDead roleModelsName &&^ return (is alive orphan) &&^ return (is villager orphan)) $ do - aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get - setPlayerAllegiance (orphan ^. name) Werewolves - tell $ orphanJoinedPackMessages (orphan ^. name) aliveWerewolfNames + tell . orphanJoinedPackMessages (orphan ^. name) =<< get advanceStage VillageDrunksTurn -> do - aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get - randomAllegiance <- getRandomAllegiance players . villageDrunks . role . allegiance .= randomAllegiance @@ -165,13 +163,18 @@ if is villager villageDrunk then tell [villageDrunkJoinedVillageMessage $ villageDrunk ^. name] - else tell $ villageDrunkJoinedPackMessages (villageDrunk ^. name) aliveWerewolfNames + else tell . villageDrunkJoinedPackMessages (villageDrunk ^. name) =<< get advanceStage VillagesTurn -> whenM (null <$> liftM2 intersect getAllowedVoters getPendingVoters) $ do - tell . map (uncurry $ playerMadeLynchVoteMessage Nothing) =<< uses votes Map.toList + uses votes Map.toList >>= mapM_ (\(voterName, voteeName) -> do + voter <- findPlayerBy_ name voterName + votee <- findPlayerBy_ name voteeName + tell [playerMadeLynchVoteMessage Nothing voter votee] + ) + advanceStage WerewolvesTurn -> whenM (none (is werewolf) <$> getPendingVoters) $ do @@ -190,7 +193,7 @@ | is jester votee = do jesterRevealed .= True - tell [jesterLynchedMessage $ votee ^. name] + tell . (:[]) . jesterLynchedMessage =<< get | is fallenAngel votee = do fallenAngelLynched .= True @@ -203,7 +206,7 @@ scapegoatBlamed .= True killPlayer (scapegoat ^. name) - tell [scapegoatLynchedMessage (scapegoat ^. name)] + tell . (:[]) . scapegoatLynchedMessage =<< get _ -> tell [noPlayerLynchedMessage] devourVotee :: (MonadState Game m, MonadWriter [Message] m) => Maybe Player -> m () diff --git a/app/Game/Werewolf/Message.hs b/app/Game/Werewolf/Message.hs new file mode 100644 --- /dev/null +++ b/app/Game/Werewolf/Message.hs @@ -0,0 +1,65 @@ +{-| +Module : Game.Werewolf.Message +Description : Utility functions for building messages. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +A 'Message' is used to relay information back to either all players or a single player. This module +defines some utility functions for building messages. See "Game.Werewolf.Message.Command", +"Game.Werewolf.Message.Engine" and "Game.Werewolf.Message.Error" for actual message definitions. + +@werewolf@ was designed to be ambivalent to the playing chat client. The response-message structure +reflects this by staying away from anything that could be construed as client-specific. This +includes features such as emoji support. +-} + +{-# LANGUAGE OverloadedStrings #-} + +module Game.Werewolf.Message ( + -- * Utility functions + humanisePlayerWithRole, humanisePlayersWithRoles, humanisePlayerWithRoleIfTrueVillager, + humanisePlayerWithState, article, conjugateToBe, pluralise, +) where + +import Control.Lens hiding (isn't) +import Control.Lens.Extra + +import Data.String.Humanise +import Data.Text (Text) +import qualified Data.Text as T + +import Game.Werewolf.Player +import Game.Werewolf.Role hiding (name) + +-- TODO (hjw): tidy up all of the messages + +humanisePlayerWithRole :: Player -> Text +humanisePlayerWithRole player = T.concat [humanise player, " (", humanise $ player ^. role, ")"] + +humanisePlayersWithRoles :: [Player] -> Text +humanisePlayersWithRoles = humanise . map humanisePlayerWithRole + +humanisePlayerWithRoleIfTrueVillager :: Player -> Text +humanisePlayerWithRoleIfTrueVillager player + | is trueVillager player = humanisePlayerWithRole player + | otherwise = humanise player + +humanisePlayerWithState :: Player -> Text +humanisePlayerWithState player + | is alive player = humanise player + | otherwise = T.concat [humanise player, " (dead)"] + +article :: Role -> Text +article role + | role `elem` restrictedRoles = "the" + | otherwise = "a" + +conjugateToBe :: Int -> Text +conjugateToBe 1 = "is" +conjugateToBe _ = "are" + +pluralise :: Int -> Text -> Text +pluralise 1 word = word +pluralise _ word = T.snoc word 's' diff --git a/app/Game/Werewolf/Message/Command.hs b/app/Game/Werewolf/Message/Command.hs new file mode 100644 --- /dev/null +++ b/app/Game/Werewolf/Message/Command.hs @@ -0,0 +1,194 @@ +{-| +Module : Game.Werewolf.Message.Command +Description : Suite of command messages used throughout the game. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +A 'Message' is used to relay information back to either all players or a single player. This module +defines suite of command messages used throughout the werewolf game. +-} + +module Game.Werewolf.Message.Command ( + -- * Quit + playerQuitMessage, + + -- * Boot + playerVotedToBootMessage, + + -- * Circle + circleMessage, + + -- * Choose + playerShotMessage, + + -- * End + gameEndedMessage, + + -- * Help + gameDescriptionMessage, globalCommandsMessage, helpCommandsMessage, hunterCommandsMessage, + oracleCommandsMessage, orphanCommandsMessage, protectorCommandsMessage, roleMessage, + rulesMessage, scapegoatCommandsMessage, seerCommandsMessage, stagesMessage, + standardCommandsMessage, statusCommandsMessage, witchCommandsMessage, + + -- * Ping + pingPlayerMessage, pingRoleMessage, pingVillageMessage, pingWerewolvesMessage, + + -- * Status + currentStageMessage, gameIsOverMessage, playersInGameMessage, + + -- * Unvote + playerRescindedVoteMessage, + + -- * Version + engineVersionMessage, + + -- * Vote + playerMadeDevourVoteMessage, playerMadeLynchVoteMessage, +) where + +import Control.Lens + +import Data.Maybe +import Data.Text (Text) +import qualified Data.Text as T + +import Game.Werewolf.Game +import Game.Werewolf.Player +import Game.Werewolf.Response +import Game.Werewolf.Role +import Game.Werewolf.Variant.NoRoleKnowledge.Command as NoRoleKnowledge +import Game.Werewolf.Variant.Standard.Command as Standard + +playerQuitMessage :: Player -> Message +playerQuitMessage = publicMessage . callerQuitText + +playerVotedToBootMessage :: Player -> Player -> Message +playerVotedToBootMessage caller = publicMessage . callerVotedBootText caller + +circleMessage :: Text -> [Player] -> Message +circleMessage to = privateMessage to . gameCircleText + +playerShotMessage :: Player -> Message +playerShotMessage = publicMessage . playerShotText + +gameEndedMessage :: Text -> Message +gameEndedMessage = publicMessage . gameEndedText + +gameDescriptionMessage :: Text -> Message +gameDescriptionMessage to = privateMessage to gameDescriptionText + +globalCommandsMessage :: Text -> Message +globalCommandsMessage to = privateMessage to globalCommandsText + +helpCommandsMessage :: Text -> Message +helpCommandsMessage to = privateMessage to helpCommandsText + +hunterCommandsMessage :: Text -> Message +hunterCommandsMessage to = privateMessage to hunterCommandsText + +oracleCommandsMessage :: Text -> Message +oracleCommandsMessage to = privateMessage to oracleCommandsText + +orphanCommandsMessage :: Text -> Message +orphanCommandsMessage to = privateMessage to orphanCommandsText + +protectorCommandsMessage :: Text -> Message +protectorCommandsMessage to = privateMessage to protectorCommandsText + +roleMessage :: Text -> Role -> Message +roleMessage to = privateMessage to . roleDescriptionText + +rulesMessage :: Text -> Message +rulesMessage to = privateMessage to gameRulesText + +scapegoatCommandsMessage :: Text -> Message +scapegoatCommandsMessage to = privateMessage to scapegoatCommandsText + +seerCommandsMessage :: Text -> Message +seerCommandsMessage to = privateMessage to seerCommandsText + +stagesMessage :: Text -> Maybe Game -> Message +stagesMessage to mGame = privateMessage to . T.concat $ + [ standardCycleText + , sunsetText + ] ++ [ orphansTurnText + | isNothing mGame || has (players . orphans . named to) (fromJust mGame) + ] ++ [ villageDrunksTurnText + | isNothing mGame || has (players . villageDrunks . named to) (fromJust mGame) + ] ++ [ seersTurnText + | isNothing mGame || has (players . seers . named to) (fromJust mGame) + ] ++ [ oraclesTurnText + | isNothing mGame || has (players . oracles . named to) (fromJust mGame) + ] ++ [ protectorsTurnText + | isNothing mGame || has (players . protectors . named to) (fromJust mGame) + ] ++ [ werewolvesTurnText + ] ++ [ witchsTurnText + | isNothing mGame || has (players . witches . named to) (fromJust mGame) + ] ++ [ sunriseText + ] ++ [ huntersTurnText + | isNothing mGame || has (players . hunters . named to) (fromJust mGame) + ] ++ [ druidsTurnText + | isNothing mGame || has (players . druids . named to) (fromJust mGame) + ] ++ [ villagesTurnText + ] ++ [ huntersTurnText + | isNothing mGame || has (players . hunters . named to) (fromJust mGame) + ] ++ [ scapegoatsTurnText + | isNothing mGame || has (players . scapegoats . named to) (fromJust mGame) + ] ++ [ winConditionText + ] + +standardCommandsMessage :: Text -> Message +standardCommandsMessage to = privateMessage to standardCommandsText + +statusCommandsMessage :: Text -> Message +statusCommandsMessage to = privateMessage to statusCommandsText + +witchCommandsMessage :: Text -> Message +witchCommandsMessage to = privateMessage to witchCommandsText + +pingPlayerMessage :: Text -> Message +pingPlayerMessage to = privateMessage to playerPingedText + +pingRoleMessage :: Role -> Game -> Message +pingRoleMessage role game + | has (variant . _NoRoleKnowledge) game = publicMessage $ NoRoleKnowledge.rolePingedText role + | otherwise = publicMessage $ Standard.rolePingedText role + +pingVillageMessage :: Message +pingVillageMessage = publicMessage villagePingedText + +pingWerewolvesMessage :: Game -> Message +pingWerewolvesMessage game + | has (variant . _NoRoleKnowledge) game = publicMessage NoRoleKnowledge.werewolvesPingedText + | otherwise = publicMessage Standard.werewolvesPingedText + +currentStageMessage :: Text -> Game -> Message +currentStageMessage to game + | has (stage . _GameOver) game = gameIsOverMessage to + | has (variant . _NoRoleKnowledge) game = privateMessage to $ NoRoleKnowledge.currentTurnText game + | otherwise = privateMessage to $ Standard.currentTurnText game + +gameIsOverMessage :: Text -> Message +gameIsOverMessage to = privateMessage to gameOverText + +playersInGameMessage :: Text -> Game -> Message +playersInGameMessage to game = privateMessage to $ T.append alivePlayersText' deadPlayersText' + where + alivePlayersText' = alivePlayersText game + deadPlayersText' + | has (players . traverse . dead) game = deadPlayersText game + | otherwise = T.empty + +playerRescindedVoteMessage :: Text -> Player -> Message +playerRescindedVoteMessage to = privateMessage to . callerRescindedVoteText + +engineVersionMessage :: Text -> Message +engineVersionMessage to = privateMessage to engineVersionText + +playerMadeDevourVoteMessage :: Text -> Player -> Player -> Message +playerMadeDevourVoteMessage to caller = privateMessage to . callerVotedDevourText caller + +playerMadeLynchVoteMessage :: Maybe Text -> Player -> Player -> Message +playerMadeLynchVoteMessage mTo caller = Message mTo . callerVotedLynchText caller diff --git a/app/Game/Werewolf/Message/Engine.hs b/app/Game/Werewolf/Message/Engine.hs new file mode 100644 --- /dev/null +++ b/app/Game/Werewolf/Message/Engine.hs @@ -0,0 +1,328 @@ +{-| +Module : Game.Werewolf.Message.Engine +Description : Suite of engine messages used throughout the game. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +A 'Message' is used to relay information back to either all players or a single player. This module +defines suite of engine messages used throughout the werewolf game. +-} + +-- TODO (hjw): sort this file +module Game.Werewolf.Message.Engine ( + playerBootedMessage, villageDrunkJoinedPackMessages, villageDrunkJoinedVillageMessage, + playerTurnedToStoneMessage, playerSeenMessage, playerDivinedMessage, playerDevouredMessage, + noPlayerDevouredMessage, scapegoatChoseAllowedVotersMessage, playerPoisonedMessage, + scapegoatLynchedMessage, playerLynchedMessage, noPlayerLynchedMessage, jesterLynchedMessage, + ferinaGruntsMessage, orphanJoinedPackMessages, playerKilledMessage, playerLostMessage, + playerContributedMessage, playerWonMessage, witchsTurnMessages, firstWerewolvesTurnMessages, + villagesTurnMessage, nightFallsMessage, sunriseMessage, villageDrunksTurnMessages, + seersTurnMessages, scapegoatsTurnMessage, protectorsTurnMessages, orphansTurnMessages, + oraclesTurnMessages, huntersTurnMessages, stageMessages, fallenAngelMessage, + trueVillagerMessage, spitefulGhostMessage, beholderMessage, newPlayerMessage, + rolesInGameMessage, newPlayersInGameMessage, newGameMessages, gameOverMessages, + fallenAngelWonMessage, +) where + +import Control.Lens +import Control.Lens.Extra + +import Data.List.Extra +import Data.Text (Text) + +import Game.Werewolf.Game +import Game.Werewolf.Player +import Game.Werewolf.Response +import Game.Werewolf.Role hiding (name) +import Game.Werewolf.Variant.NoRoleKnowledge.Engine as NoRoleKnowledge +import Game.Werewolf.Variant.Standard.Engine as Standard + +playerBootedMessage :: Player -> Message +playerBootedMessage = publicMessage . playerBootedText + +gameOverMessages :: Game -> [Message] +gameOverMessages game + | hasFallenAngelWon game = concat + [ [fallenAngelWonMessage] + , [playerRolesMessage game] + , [playerWonMessage fallenAngelsName] + , map playerLostMessage (game ^.. players . names \\ [fallenAngelsName]) + ] + | otherwise = concat + [ [allegianceWonMessage winningAllegiance] + , [playerRolesMessage game] + , playerWonMessages + , playerContributedMessages + , playerLostMessages + ] + where + winningAllegiance + | hasVillagersWon game = Villagers + | hasWerewolvesWon game = Werewolves + | otherwise = undefined + + winningPlayers = game ^.. players . traverse . filteredBy (role . allegiance) winningAllegiance + losingPlayers = game ^. players \\ winningPlayers + + playerWonMessages = map playerWonMessage (winningPlayers ^.. traverse . alive . name) + playerContributedMessages = map playerContributedMessage (winningPlayers ^.. traverse . dead . name) + playerLostMessages = map playerLostMessage (losingPlayers ^.. names) + + fallenAngelsName = game ^?! players . fallenAngels . name + +fallenAngelWonMessage :: Message +fallenAngelWonMessage = publicMessage fallenAngelWonText + +allegianceWonMessage :: Allegiance -> Message +allegianceWonMessage = publicMessage . allegianceWonText + +playerRolesMessage :: Game -> Message +playerRolesMessage = publicMessage . playerRolesText + +newGameMessages :: Game -> [Message] +newGameMessages game = concat + [ [newPlayersInGameMessage game] + , [rolesInGameMessage Nothing game] + , map newPlayerMessage players' + , beholderMessages + , spitefulGhostMessages + , trueVillagerMessages + , fallenAngelMessages + , stageMessages game + ] + where + players' = game ^. players + beholderMessages = case (,) <$> players' ^? beholders <*> players' ^? seers of + Just (beholder, _) -> [beholderMessage (beholder ^. name) game] + _ -> [] + spitefulGhostMessages = case players' ^? spitefulGhosts of + Just spitefulGhost -> [spitefulGhostMessage (spitefulGhost ^. name) game] + _ -> [] + trueVillagerMessages = [trueVillagerMessage game | has trueVillagers players'] + fallenAngelMessages = if has fallenAngels players' + then [fallenAngelMessage] + else [] + +newPlayersInGameMessage :: Game -> Message +newPlayersInGameMessage = publicMessage . playersInGameText + +rolesInGameMessage :: Maybe Text -> Game -> Message +rolesInGameMessage mTo game + | has (variant . _NoRoleKnowledge) game = Message mTo $ NoRoleKnowledge.rolesInGameText game + | otherwise = Message mTo $ Standard.rolesInGameText game + +newPlayerMessage :: Player -> Message +newPlayerMessage player = privateMessage (player ^. name) $ newPlayerText player + +beholderMessage :: Text -> Game -> Message +beholderMessage to = privateMessage to . beholderText + +spitefulGhostMessage :: Text -> Game -> Message +spitefulGhostMessage to = privateMessage to . spitefulGhostText + +trueVillagerMessage :: Game -> Message +trueVillagerMessage = publicMessage . trueVillagerText + +fallenAngelMessage :: Message +fallenAngelMessage = publicMessage fallenAngelText + +stageMessages :: Game -> [Message] +stageMessages game = case game ^. stage of + DruidsTurn -> [] + GameOver -> [] + HuntersTurn1 -> huntersTurnMessages game + HuntersTurn2 -> huntersTurnMessages game + Lynching -> [] + OraclesTurn -> oraclesTurnMessages oraclesName game + OrphansTurn -> orphansTurnMessages orphansName game + ProtectorsTurn -> protectorsTurnMessages protectorsName game + ScapegoatsTurn -> [scapegoatsTurnMessage game] + SeersTurn -> seersTurnMessages seersName game + Sunrise -> [sunriseMessage] + Sunset -> [nightFallsMessage] + VillageDrunksTurn -> villageDrunksTurnMessages game + VillagesTurn -> [villagesTurnMessage] + WerewolvesTurn -> if is firstRound game + then firstWerewolvesTurnMessages game + else werewolvesTurnMessages aliveWerewolfNames game + WitchsTurn -> witchsTurnMessages game + where + players' = game ^. players + oraclesName = players' ^?! oracles . name + orphansName = players' ^?! orphans . name + protectorsName = players' ^?! protectors . name + seersName = players' ^?! seers . name + aliveWerewolfNames = players' ^.. werewolves . alive . name + +huntersTurnMessages :: Game -> [Message] +huntersTurnMessages game = + [ publicMessage $ huntersTurnPublicText game + , privateMessage hunterName huntersTurnPrivateText + ] + where + hunterName = game ^?! players . hunters . name + +oraclesTurnMessages :: Text -> Game -> [Message] +oraclesTurnMessages to game + | has (variant . _NoRoleKnowledge) game = + [ privateMessage to oraclesTurnPrivateText ] + | otherwise = + [ publicMessage oraclesTurnPublicText + , privateMessage to oraclesTurnPrivateText + ] + +orphansTurnMessages :: Text -> Game -> [Message] +orphansTurnMessages to game + | has (variant . _NoRoleKnowledge) game = + [ privateMessage to orphansTurnPrivateText ] + | otherwise = + [ publicMessage orphansTurnPublicText + , privateMessage to orphansTurnPrivateText + ] + +protectorsTurnMessages :: Text -> Game -> [Message] +protectorsTurnMessages to game + | has (variant . _NoRoleKnowledge) game = + [ privateMessage to protectorsTurnPrivateText ] + | otherwise = + [ publicMessage protectorsTurnPublicText + , privateMessage to protectorsTurnPrivateText + ] + +scapegoatsTurnMessage :: Game -> Message +scapegoatsTurnMessage = publicMessage . scapegoatsTurnText + +seersTurnMessages :: Text -> Game -> [Message] +seersTurnMessages to game + | has (variant . _NoRoleKnowledge) game = + [ privateMessage to seersTurnPrivateText ] + | otherwise = + [ publicMessage seersTurnPublicText + , privateMessage to seersTurnPrivateText + ] + +villageDrunksTurnMessages :: Game -> [Message] +villageDrunksTurnMessages game + | has (variant . _NoRoleKnowledge) game = [] + | otherwise = [publicMessage villageDrunksTurnText] + +sunriseMessage :: Message +sunriseMessage = publicMessage sunriseText + +nightFallsMessage :: Message +nightFallsMessage = publicMessage sunsetText + +villagesTurnMessage :: Message +villagesTurnMessage = publicMessage villagesTurnText + +firstWerewolvesTurnMessages :: Game -> [Message] +firstWerewolvesTurnMessages game = + [privateMessage (player ^. name) (firstWerewolvesTurnText player game) + | length werewolves > 1, player <- werewolves] + ++ werewolvesTurnMessages (map (view name) werewolves) game + where + werewolves = game ^.. players . traverse . alive . filtered (is werewolf) + +werewolvesTurnMessages :: [Text] -> Game -> [Message] +werewolvesTurnMessages tos game + | has (variant . _NoRoleKnowledge) game = + groupMessages tos werewolvesTurnPrivateText + | otherwise = + publicMessage werewolvesTurnPublicText + : groupMessages tos werewolvesTurnPrivateText + +witchsTurnMessages :: Game -> [Message] +witchsTurnMessages game = concat + [ wakeUpMessages + , healMessages + , poisonMessages + , [passMessage] + ] + where + to = game ^?! players . witches . name + wakeUpMessages + | has (variant . _NoRoleKnowledge) game = [] + | otherwise = [publicMessage witchsTurnText] + passMessage = privateMessage to passText + healMessages + | game ^. healUsed = [] + | hasn't votee game = [] + | otherwise = [privateMessage to $ healText game] + poisonMessages + | game ^. poisonUsed = [] + | otherwise = [privateMessage to poisonText] + +playerWonMessage :: Text -> Message +playerWonMessage to = privateMessage to playerWonText + +playerContributedMessage :: Text -> Message +playerContributedMessage to = privateMessage to playerContributedText + +playerLostMessage :: Text -> Message +playerLostMessage to = privateMessage to playerLostText + +playerKilledMessage :: Text -> Message +playerKilledMessage to = privateMessage to playerKilledText + +orphanJoinedPackMessages :: Text -> Game -> [Message] +orphanJoinedPackMessages to game = + privateMessage to (orphanJoinedWerewolvesPrivateText game) + : groupMessages (map (view name) werewolves) (orphanJoinedWerewolvesGroupText game) + where + orphan = game ^?! players . villageDrunks + werewolves = game ^.. players . traverse . alive . filtered (is werewolf) \\ [orphan] + +ferinaGruntsMessage :: Message +ferinaGruntsMessage = publicMessage druidsTurnText + +jesterLynchedMessage :: Game -> Message +jesterLynchedMessage = publicMessage . jesterLynchedText + +noPlayerLynchedMessage :: Message +noPlayerLynchedMessage = publicMessage noPlayerLynchedText + +playerLynchedMessage :: Player -> Message +playerLynchedMessage player + | is simpleWerewolf player + || is alphaWolf player = publicMessage $ werewolfLynchedText player + | otherwise = publicMessage $ playerLynchedText player + +scapegoatLynchedMessage :: Game -> Message +scapegoatLynchedMessage = publicMessage . scapegoatLynchedText + +scapegoatChoseAllowedVotersMessage :: Game -> Message +scapegoatChoseAllowedVotersMessage = publicMessage . scapegoatsTurnEndedText + +noPlayerDevouredMessage :: Message +noPlayerDevouredMessage = publicMessage noPlayerDevouredText + +playerDevouredMessage :: Player -> Message +playerDevouredMessage = publicMessage . playerDevouredText + +playerDivinedMessage :: Text -> Player -> Message +playerDivinedMessage to = privateMessage to . playerDivinedText + +playerPoisonedMessage :: Player -> Message +playerPoisonedMessage = publicMessage . playerPoisonedText + +playerSeenMessage :: Text -> Player -> Message +playerSeenMessage to player + | is alphaWolf player = privateMessage to $ alphaWolfSeenText player + | is lycan player = privateMessage to $ lycanSeenText player + | otherwise = privateMessage to $ playerSeenText player + +playerTurnedToStoneMessage :: Player -> Message +playerTurnedToStoneMessage = publicMessage . playerTurnedToStoneText + +villageDrunkJoinedVillageMessage :: Text -> Message +villageDrunkJoinedVillageMessage to = privateMessage to villageDrunkJoinedVillageText + +villageDrunkJoinedPackMessages :: Text -> Game -> [Message] +villageDrunkJoinedPackMessages to game = + privateMessage to (villageDrunkJoinedWerewolvesPrivateText game) + : groupMessages (map (view name) werewolves) (villageDrunkJoinedWerewolvesGroupText game) + where + villageDrunk = game ^?! players . villageDrunks + werewolves = game ^.. players . traverse . alive . filtered (is werewolf) \\ [villageDrunk] diff --git a/app/Game/Werewolf/Message/Error.hs b/app/Game/Werewolf/Message/Error.hs new file mode 100644 --- /dev/null +++ b/app/Game/Werewolf/Message/Error.hs @@ -0,0 +1,115 @@ +{-| +Module : Game.Werewolf.Message.Error +Description : Suite of error messages used throughout the game. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +A 'Message' is used to relay information back to either all players or a single player. This module +defines suite of error messages used throughout the werewolf game. +-} + +module Game.Werewolf.Message.Error ( + -- * Command + + -- ** Boot + playerHasAlreadyVotedToBootMessage, + + -- ** Choose + playerCannotChooseSelfMessage, playerCannotChooseJesterMessage, + playerMustChooseAtLeastOneTargetMessage, + + -- ** General + noGameRunningMessage, playerCannotDoThatMessage, playerCannotDoThatRightNowMessage, + playerIsDeadMessage, playerDoesNotExistMessage, targetIsDeadMessage, + + -- ** Heal + playerHasAlreadyHealedMessage, + + -- ** Poison + playerHasAlreadyPoisonedMessage, + + -- ** Protect + playerCannotProtectSamePlayerTwiceInARowMessage, + + -- ** Start + gameAlreadyRunningMessage, mustHaveAtLeast7PlayersMessage, playerNamesMustBeUniqueMessage, + roleCountRestrictedMessage, roleDoesNotExistMessage, + + -- ** Unvote + playerHasNotVotedMessage, + + -- ** Vote + playerHasAlreadyVotedMessage, playerCannotDevourAnotherWerewolfMessage, +) where + +import Data.Text (Text) + +import Game.Werewolf.Player +import Game.Werewolf.Response +import Game.Werewolf.Role +import Game.Werewolf.Variant.Standard.Error + +playerHasAlreadyVotedToBootMessage :: Text -> Player -> Message +playerHasAlreadyVotedToBootMessage to = privateMessage to . callerAlreadyVotedBootText + +playerCannotChooseSelfMessage :: Text -> Message +playerCannotChooseSelfMessage to = privateMessage to callerCannotChooseSelfText + +playerCannotChooseJesterMessage :: Text -> Message +playerCannotChooseJesterMessage to = privateMessage to callerCannotChooseJesterText + +playerMustChooseAtLeastOneTargetMessage :: Text -> Message +playerMustChooseAtLeastOneTargetMessage to = privateMessage to noTargetText + +noGameRunningMessage :: Text -> Message +noGameRunningMessage to = privateMessage to noGameRunningText + +playerCannotDoThatMessage :: Text -> Message +playerCannotDoThatMessage to = privateMessage to callerCannotDoThatText + +playerCannotDoThatRightNowMessage :: Text -> Message +playerCannotDoThatRightNowMessage to = privateMessage to callerCannotDoThatRightNowText + +playerIsDeadMessage :: Text -> Message +playerIsDeadMessage to = privateMessage to callerDeadText + +playerDoesNotExistMessage :: Text -> Text -> Message +playerDoesNotExistMessage to = privateMessage to . playerDoesNotExistText + +targetIsDeadMessage :: Text -> Player -> Message +targetIsDeadMessage to = privateMessage to . targetDeadText + +playerHasAlreadyHealedMessage :: Text -> Message +playerHasAlreadyHealedMessage to = privateMessage to callerAlreadyHealedText + +playerHasAlreadyPoisonedMessage :: Text -> Message +playerHasAlreadyPoisonedMessage to = privateMessage to callerAlreadyPoisonedText + +playerCannotProtectSamePlayerTwiceInARowMessage :: Text -> Message +playerCannotProtectSamePlayerTwiceInARowMessage to = privateMessage to callerCannotProtectSamePlayerText + +gameAlreadyRunningMessage :: Text -> Message +gameAlreadyRunningMessage to = privateMessage to gameAlreadyRunningText + +mustHaveAtLeast7PlayersMessage :: Text -> Message +mustHaveAtLeast7PlayersMessage to = privateMessage to playerCountTooLowText + +playerNamesMustBeUniqueMessage :: Text -> Message +playerNamesMustBeUniqueMessage to = privateMessage to playerNamesNotUniqueText + +roleCountRestrictedMessage :: Text -> Role -> Message +roleCountRestrictedMessage to = privateMessage to . roleCountRestrictedText + +roleDoesNotExistMessage :: Text -> Text -> Message +roleDoesNotExistMessage to = privateMessage to . roleDoesNotExistText + +playerHasNotVotedMessage :: Text -> Message +playerHasNotVotedMessage to = privateMessage to callerNotVotedText + +playerHasAlreadyVotedMessage :: Text -> Message +playerHasAlreadyVotedMessage to = privateMessage to callerAlreadyVotedText + +playerCannotDevourAnotherWerewolfMessage :: Text -> Message +playerCannotDevourAnotherWerewolfMessage to = privateMessage to callerCannotDevourAnotherWerewolfText diff --git a/app/Game/Werewolf/Messages.hs b/app/Game/Werewolf/Messages.hs deleted file mode 100644 --- a/app/Game/Werewolf/Messages.hs +++ /dev/null @@ -1,658 +0,0 @@ -{-| -Module : Game.Werewolf.Messages -Description : Suite of messages used throughout the game. - -Copyright : (c) Henry J. Wylde, 2016 -License : BSD3 -Maintainer : public@hjwylde.com - -A 'Message' is used to relay information back to either all players or a single player. This module -defines suite of messages used throughout the werewolf game, including both game play messages and -binary errors. - -@werewolf@ was designed to be ambivalent to the playing chat client. The response-message structure -reflects this by staying away from anything that could be construed as client-specific. This -includes features such as emoji support. --} - -{-# LANGUAGE OverloadedStrings #-} - -module Game.Werewolf.Messages ( - -- * Generic messages - newGameMessages, stageMessages, gameOverMessages, playerQuitMessage, gameIsOverMessage, - playerKilledMessage, - - -- ** Error messages - playerDoesNotExistMessage, playerCannotDoThatMessage, playerCannotDoThatRightNowMessage, - playerIsDeadMessage, targetIsDeadMessage, - - -- * Boot messages - playerVotedToBootMessage, playerBootedMessage, - - -- ** Error messages - playerHasAlreadyVotedToBootMessage, - - -- * Circle messages - circleMessage, - - -- * Ping messages - pingPlayerMessage, pingRoleMessage, - - -- * Status messages - currentStageMessages, rolesInGameMessage, playersInGameMessage, - - -- * Druid's turn messages - ferinaGruntsMessage, - - -- * Hunter's turn messages - playerShotMessage, - - -- * Oracle's turn messages - playerDivinedMessage, - - -- * Orphan's turn messages - orphanJoinedPackMessages, - - -- * Protector's turn messages - - -- ** Error messages - playerCannotProtectSamePlayerTwiceInARowMessage, - - -- * Scapegoat's turn messages - scapegoatChoseAllowedVotersMessage, - - -- ** Error messages - playerMustChooseAtLeastOneTargetMessage, playerCannotChooseJesterMessage, - - -- * Seer's turn messages - playerSeenMessage, - - -- * Village Drunk's turn messages - villageDrunkJoinedVillageMessage, villageDrunkJoinedPackMessages, - - -- * Villages' turn messages - playerMadeLynchVoteMessage, playerRescindedVoteMessage, playerLynchedMessage, - noPlayerLynchedMessage, jesterLynchedMessage, scapegoatLynchedMessage, - - -- ** Error messages - playerHasAlreadyVotedMessage, playerHasNotVotedMessage, - - -- * Werewolves' turn messages - playerMadeDevourVoteMessage, playerDevouredMessage, playerTurnedToStoneMessage, - noPlayerDevouredMessage, - - -- ** Error messages - playerCannotDevourAnotherWerewolfMessage, - - -- ** Error messages - playerCannotChooseSelfMessage, - - -- * Witch's turn messages - playerPoisonedMessage, - - -- ** Error messages - playerHasAlreadyHealedMessage, playerHasAlreadyPoisonedMessage, -) where - -import Control.Arrow -import Control.Lens -import Control.Lens.Extra - -import Data.List.Extra -import Data.String.Humanise -import Data.Text (Text) -import qualified Data.Text as T - -import Game.Werewolf.Game -import Game.Werewolf.Player -import Game.Werewolf.Response -import Game.Werewolf.Role hiding (name) - -newGameMessages :: Game -> [Message] -newGameMessages game = concat - [ [newPlayersInGameMessage $ players' ^.. names] - , [rolesInGameMessage Nothing $ players' ^.. roles] - , map newPlayerMessage players' - , beholderMessages - , spitefulGhostMessages - , trueVillagerMessages - , fallenAngelMessages - , stageMessages game - ] - where - players' = game ^. players - beholderMessages = case (,) <$> players' ^? beholders <*> players' ^? seers of - Just (beholder, seer) -> [beholderMessage (beholder ^. name) (humanise seer)] - _ -> [] - spitefulGhostMessages = case players' ^? spitefulGhosts of - Just spitefulGhost -> [spitefulGhostMessage (spitefulGhost ^. name) (players' \\ [spitefulGhost])] - _ -> [] - trueVillagerMessages = case players' ^? trueVillagers of - Just trueVillager -> [trueVillagerMessage $ humanise trueVillager] - _ -> [] - fallenAngelMessages = if has fallenAngels players' - then [fallenAngelMessage] - else [] - -newPlayersInGameMessage :: [Text] -> Message -newPlayersInGameMessage playerNames = publicMessage $ T.concat - ["A new game of werewolf is starting with ", concatList playerNames, "!"] - -newPlayerMessage :: Player -> Message -newPlayerMessage player = privateMessage (player ^. name) $ T.intercalate "\n" - [ T.concat ["You're ", article playerRole, " ", humanise playerRole, "."] - , playerRole ^. description - , playerRole ^. rules - ] - where - playerRole = player ^. role - -beholderMessage :: Text -> Text -> Message -beholderMessage to seerName = privateMessage to $ T.concat - [ "The Seer has always been held in high regard among the Villagers. Few are as lucky as you to" - , " know the Seer, ", seerName, ", personally." - ] - -spitefulGhostMessage :: Text -> [Player] -> Message -spitefulGhostMessage to players = privateMessage to $ T.concat - [ "Being ethereal seldom has it's benefits. Perhaps however this knowledge of the townsfolks' " - , "natures will bring you some joy in the afterlife: ", playerNamesWithRoles, "." - ] - where - playerNamesWithRoles = concatList $ map - (\player -> T.concat [humanise player, " (", humanise $ player ^. role, ")"]) - players - -trueVillagerMessage :: Text -> Message -trueVillagerMessage name = publicMessage $ T.unwords - [ "Unguarded advice is seldom given, for advice is a dangerous gift, even from the wise to the" - , "wise, and all courses may run ill. Yet as you feel like you need help, I begrudgingly leave" - , "you with this:", name, "is the True Villager." - ] - -fallenAngelMessage :: Message -fallenAngelMessage = publicMessage $ T.unwords - [ "Alas, again I regrettably yield advice: an angelic menace walks among you. Do not cast your" - , "votes lightly, for they will relish in this opportunity to be free from their terrible" - , "nightmare." - ] - -stageMessages :: Game -> [Message] -stageMessages game = case game ^. stage of - FerinasGrunt -> [] - GameOver -> [] - HuntersTurn1 -> huntersTurnMessages huntersName - HuntersTurn2 -> huntersTurnMessages huntersName - Lynching -> [] - OraclesTurn -> oraclesTurnMessages oraclesName - OrphansTurn -> orphansTurnMessages orphansName - ProtectorsTurn -> protectorsTurnMessages protectorsName - ScapegoatsTurn -> scapegoatsTurnMessages scapegoatsName - SeersTurn -> seersTurnMessages seersName - Sunrise -> [sunriseMessage] - Sunset -> [nightFallsMessage] - VillageDrunksTurn -> [villageDrunksTurnMessage] - VillagesTurn -> villagesTurnMessages - WerewolvesTurn -> if is firstRound game - then firstWerewolvesTurnMessages aliveWerewolfNames - else werewolvesTurnMessages aliveWerewolfNames - WitchsTurn -> witchsTurnMessages game - where - players' = game ^. players - huntersName = players' ^?! hunters . name - oraclesName = players' ^?! oracles . name - orphansName = players' ^?! orphans . name - protectorsName = players' ^?! protectors . name - scapegoatsName = humanise $ players' ^?! scapegoats - seersName = players' ^?! seers . name - aliveWerewolfNames = players' ^.. werewolves . alive . name - -huntersTurnMessages :: Text -> [Message] -huntersTurnMessages huntersName = - [ publicMessage $ T.unwords ["Just before", huntersName, "was murdered they let off a shot."] - , privateMessage huntersName "Whom do you `choose` to kill with your last shot?" - ] - -oraclesTurnMessages :: Text -> [Message] -oraclesTurnMessages to = - [ publicMessage "The Oracle wakes up." - , privateMessage to "Whose role would you like to `divine`?" - ] - -orphansTurnMessages :: Text -> [Message] -orphansTurnMessages to = - [ publicMessage "The Orphan wakes up." - , privateMessage to "Whom do you `choose` to be your role model?" - ] - -protectorsTurnMessages :: Text -> [Message] -protectorsTurnMessages to = - [ publicMessage "The Protector wakes up." - , privateMessage to "Whom would you like to `protect`?" - ] - -scapegoatsTurnMessages :: Text -> [Message] -scapegoatsTurnMessages scapegoatsName = - [ publicMessage "Just before the Scapegoat burns to a complete crisp, they cry out a dying wish." - , publicMessage $ T.concat [scapegoatsName, ", which players do you `choose` to vote on the next day?"] - ] - -seersTurnMessages :: Text -> [Message] -seersTurnMessages to = - [ publicMessage "The Seer wakes up." - , privateMessage to "Whose allegiance would you like to `see`?" - ] - -villageDrunksTurnMessage :: Message -villageDrunksTurnMessage = publicMessage "The Village Drunk sobers up." - -sunriseMessage :: Message -sunriseMessage = publicMessage "The sun rises. Everybody wakes up and opens their eyes..." - -nightFallsMessage :: Message -nightFallsMessage = publicMessage "Night falls, the village is asleep." - -villagesTurnMessages :: [Message] -villagesTurnMessages = - [ publicMessage "As the village gathers in the square the Town Clerk calls for a vote." - , publicMessage "Whom would you like to `vote` to lynch?" - ] - -firstWerewolvesTurnMessages :: [Text] -> [Message] -firstWerewolvesTurnMessages tos = - [privateMessage to $ packMessage to | length tos > 1, to <- tos] - ++ werewolvesTurnMessages tos - where - packMessage werewolfName = T.unwords - [ "You feel restless, like an old curse is keeping you from sleep. It seems you're not" - , "the only one...", packNames werewolfName - , conjugateToBe (length tos - 1), "also emerging from their" - , tryPlural (length tos - 1) "home" - ] - packNames werewolfName = concatList $ tos \\ [werewolfName] - -werewolvesTurnMessages :: [Text] -> [Message] -werewolvesTurnMessages tos = - publicMessage "The Werewolves wake up, transform and choose a new victim." - : groupMessages tos "Whom would you like to `vote` to devour?" - -witchsTurnMessages :: Game -> [Message] -witchsTurnMessages game = concat - [ [wakeUpMessage] - , devourMessages - , healMessages - , poisonMessages - , [passMessage] - ] - where - witchsName = game ^?! players . witches . name - wakeUpMessage = publicMessage "The Witch wakes up." - passMessage = privateMessage witchsName "Type `pass` to end your turn." - devourMessages = case game ^? votee of - Just votee -> - [ privateMessage witchsName $ - T.unwords ["You see", humanise votee, "sprawled outside bleeding uncontrollably."] - ] - _ -> [] - healMessages - | game ^. healUsed = [] - | hasn't votee game = [] - | otherwise = [privateMessage witchsName "Would you like to `heal` them?"] - poisonMessages - | game ^. poisonUsed = [] - | otherwise = [privateMessage witchsName "Would you like to `poison` anyone?"] - -gameOverMessages :: Game -> [Message] -gameOverMessages game - | hasFallenAngelWon game = concat - [ [publicMessage "You should have heeded my warning, for now the Fallen Angel has been set free!"] - , [publicMessage "The game is over! The Fallen Angel has won."] - , [playerRolesMessage] - , [playerWonMessage fallenAngelsName] - , map playerLostMessage (game ^.. players . names \\ [fallenAngelsName]) - ] - | hasVillagersWon game = concat - [ [publicMessage "The game is over! The Villagers have won."] - , [playerRolesMessage] - , playerWonMessages - , playerContributedMessages - , playerLostMessages - ] - | hasWerewolvesWon game = concat - [ [publicMessage "The game is over! The Werewolves have won."] - , [playerRolesMessage] - , playerWonMessages - , playerContributedMessages - , playerLostMessages - ] - | otherwise = undefined - where - playerRolesMessage = publicMessage $ T.concat - [ "As I know you're all wondering who lied to you, here's the role allocations: " - , concatList $ map - (\player -> T.concat [humanise player, " (", humanise $ player ^. role, ")"]) - (game ^. players) - , "." - ] - - winningAllegiance - | hasVillagersWon game = Villagers - | hasWerewolvesWon game = Werewolves - | otherwise = undefined - - winningPlayers = game ^.. players . traverse . filteredBy (role . allegiance) winningAllegiance - losingPlayers = game ^. players \\ winningPlayers - - playerWonMessages = map playerWonMessage (winningPlayers ^.. traverse . alive . name) - playerContributedMessages = map playerContributedMessage (winningPlayers ^.. traverse . dead . name) - playerLostMessages = map playerLostMessage (losingPlayers ^.. names) - - fallenAngelsName = game ^?! players . fallenAngels . name - -playerWonMessage :: Text -> Message -playerWonMessage to = privateMessage to "Victory! You won!" - -playerContributedMessage :: Text -> Message -playerContributedMessage to = privateMessage to "Your team won, but you died. Congratulations?" - -playerLostMessage :: Text -> Message -playerLostMessage to = privateMessage to "Feck, you lost this time round." - -playerQuitMessage :: Player -> Message -playerQuitMessage player = publicMessage $ T.unwords [playerName, "the", playerRole, "has quit!"] - where - playerName = humanise player - playerRole = humanise $ player ^. role - -gameIsOverMessage :: Text -> Message -gameIsOverMessage to = privateMessage to "The game is over!" - -playerKilledMessage :: Text -> Message -playerKilledMessage to = privateMessage to "Guh, you've been killed!" - -playerDoesNotExistMessage :: Text -> Text -> Message -playerDoesNotExistMessage to name = privateMessage to $ T.unwords ["Player", name, "does not exist."] - -playerCannotDoThatMessage :: Text -> Message -playerCannotDoThatMessage to = privateMessage to "You cannot do that!" - -playerCannotDoThatRightNowMessage :: Text -> Message -playerCannotDoThatRightNowMessage to = privateMessage to "You cannot do that right now!" - -playerIsDeadMessage :: Text -> Message -playerIsDeadMessage to = privateMessage to "Sshh, you're meant to be dead!" - -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, "the", playerRole , "has been booted from the game!"] - where - playerName = humanise player - playerRole = humanise $ 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.intercalate "\n" - [ "The players are sitting in the following order:" - , T.intercalate " <-> " (map playerName (players ++ [head players])) - ] - where - playerName player = T.concat [humanise player, if is dead player then " (dead)" else ""] - -pingPlayerMessage :: Text -> Message -pingPlayerMessage to = privateMessage to "Waiting on you..." - -pingRoleMessage :: Text -> Message -pingRoleMessage roleName = publicMessage $ T.concat ["Waiting on the ", roleName, "..."] - -currentStageMessages :: Text -> Stage -> [Message] -currentStageMessages _ FerinasGrunt = [] -currentStageMessages to GameOver = [gameIsOverMessage to] -currentStageMessages _ Lynching = [] -currentStageMessages _ Sunrise = [] -currentStageMessages _ Sunset = [] -currentStageMessages to turn = [privateMessage to $ T.concat - [ "It's currently the ", humanise turn, "." - ]] - -rolesInGameMessage :: Maybe Text -> [Role] -> Message -rolesInGameMessage mTo roles = Message mTo $ T.concat - [ "The roles in play are " - , concatList $ map (\(role, count) -> - T.concat [humanise role, " (", T.pack $ show count, ")"]) - roleCounts - , " for a total balance of ", T.pack $ show totalBalance, "." - ] - where - roleCounts = map (head &&& length) (groupSortOn (humanise :: Role -> Text) roles) - totalBalance = sumOf (traverse . balance) roles - -playersInGameMessage :: Text -> [Player] -> Message -playersInGameMessage to players = privateMessage to . T.intercalate "\n" $ - alivePlayersText : [deadPlayersText | any (is dead) players] - where - alivePlayers = players ^.. traverse . alive - deadPlayers = players ^.. traverse . dead - - alivePlayersText = T.concat - [ "The following players are still alive: " - , concatList $ map (\player -> if is trueVillager player then playerNameWithRole player else humanise player) alivePlayers, "." - ] - deadPlayersText = T.concat - [ "The following players are dead: " - , concatList $ map playerNameWithRole deadPlayers, "." - ] - playerNameWithRole player = T.concat [humanise player, " (", humanise $ player ^. role, ")"] - -ferinaGruntsMessage :: Message -ferinaGruntsMessage = publicMessage - "Ferina wakes from her slumber, disturbed and on edge. She loudly grunts as she smells danger." - -playerShotMessage :: Player -> Message -playerShotMessage target = publicMessage $ T.unwords - [ targetName, "the", targetRole, "slumps down to the ground, hands clutching at their chest" - , "while blood slips between their fingers and pools around them." - ] - where - targetName = humanise target - targetRole = humanise $ target ^. role - -playerDivinedMessage :: Text -> Player -> Message -playerDivinedMessage to player = privateMessage to $ T.concat - [playerName, " is ", article playerRole, " ", humanise playerRole, "."] - where - playerName = humanise player - playerRole = player ^. role - -orphanJoinedPackMessages :: Text -> [Text] -> [Message] -orphanJoinedPackMessages orphansName werewolfNames = - privateMessage orphansName (T.unwords - [ "The death of your role model is distressing. Without second thought you abandon the" - , "Villagers and run off into the woods, towards a new home. As you arrive you see the" - , tryPlural (length werewolfNames) "face", "of" - , concatList werewolfNames, "waiting for you." - ]) - : groupMessages werewolfNames (T.unwords - [ orphansName, "the Orphan scampers off into the woods. Without their role model they have" - , "abandoned the village and are in search of a new home. You welcome them into your pack." - ]) - -playerCannotProtectSamePlayerTwiceInARowMessage :: Text -> Message -playerCannotProtectSamePlayerTwiceInARowMessage to = - privateMessage to "You cannot protect the same player twice in a row!" - -scapegoatChoseAllowedVotersMessage :: [Text] -> Message -scapegoatChoseAllowedVotersMessage allowedVoters = publicMessage $ T.unwords - [ "On the next day only", concatList allowedVoters, "shall be allowed to vote. The Town Crier," - , "realising how foolish it was to kill the Scapegoat, grants them this wish." - ] - -playerMustChooseAtLeastOneTargetMessage :: Text -> Message -playerMustChooseAtLeastOneTargetMessage to = - privateMessage to "You must choose at least 1 target!" - -playerCannotChooseJesterMessage :: Text -> Message -playerCannotChooseJesterMessage to = - privateMessage to "You cannot choose the Jester!" - -playerSeenMessage :: Text -> Player -> Message -playerSeenMessage to player = privateMessage to $ T.concat - [playerName, " is aligned with ", article, humanise allegiance', "."] - where - playerName = humanise player - allegiance' - | is alphaWolf player = Villagers - | is lycan player = Werewolves - | otherwise = player ^. role . allegiance - article = if allegiance' == NoOne then "" else "the " - -villageDrunkJoinedVillageMessage :: Text -> Message -villageDrunkJoinedVillageMessage to = privateMessage to $ T.unwords - [ "Somehow you managed to avoid getting killed while in your drunken stupor. Thank God for" - , "that, maybe now you can actually help the village." - ] - -villageDrunkJoinedPackMessages :: Text -> [Text] -> [Message] -villageDrunkJoinedPackMessages villageDrunksName werewolfNames = - privateMessage villageDrunksName (T.concat - [ "As you start to feel sober for the first time in days a new thirst begins to take hold." - , " The bloodthirst starts to bring back memories, memories of your true home with " - , concatList werewolfNames, "." - ]) - : groupMessages werewolfNames (T.unwords - [ villageDrunksName - , "the Village Drunk has finally sobered up and remembered their true home." - ]) - -playerMadeLynchVoteMessage :: Maybe Text -> Text -> Text -> Message -playerMadeLynchVoteMessage mTo voterName targetName = Message mTo $ T.concat - [ voterName, " voted to lynch ", targetName, "." - ] - -playerRescindedVoteMessage :: Text -> Text -> Message -playerRescindedVoteMessage to voterName = privateMessage to $ T.unwords - [ voterName, "rescinded their vote." - ] - -playerLynchedMessage :: Player -> Message -playerLynchedMessage player - | is simpleWerewolf player - || is alphaWolf player = publicMessage $ T.concat - [ playerName, " is tied up to a pyre and set alight. As they scream their body starts to " - , "contort and writhe, transforming into ", article playerRole, " " - , humanise playerRole, ".", " Thankfully they go limp before breaking free of their " - , "restraints." - ] - | otherwise = publicMessage $ T.concat - [ playerName, " is tied up to a pyre and set alight. Eventually the screams start to die " - , "and with their last breath, they reveal themselves as ", article playerRole, " " - , humanise playerRole, "." - ] - where - playerName = humanise player - playerRole = player ^. role - -noPlayerLynchedMessage :: Message -noPlayerLynchedMessage = publicMessage $ T.unwords - [ "Daylight is wasted as the townsfolk squabble over whom to tie up. Looks like no-one is being" - , "burned this day." - ] - -jesterLynchedMessage :: Text -> Message -jesterLynchedMessage name = publicMessage $ T.concat - [ "Just as the townsfolk tie ", name, " up to the pyre, a voice in the crowd yells out." - , " \"We can't burn ", name, "! He's the joke of the town!\" " - , name, " the Jester is quickly untied and apologised to." - ] - -scapegoatLynchedMessage :: Text -> Message -scapegoatLynchedMessage name = publicMessage $ T.unwords - [ "The townsfolk squabble over whom to tie up. Just as they are about to call it a day" - , "they notice that", name, "has been acting awfully suspicious." - , "Not wanting to take any chances,", name, "is promptly tied to a pyre and burned alive." - ] - -playerHasAlreadyVotedMessage :: Text -> Message -playerHasAlreadyVotedMessage to = privateMessage to "You've already voted!" - -playerHasNotVotedMessage :: Text -> Message -playerHasNotVotedMessage to = privateMessage to "You haven't voted yet!" - -playerMadeDevourVoteMessage :: Text -> Text -> Text -> Message -playerMadeDevourVoteMessage to voterName targetName = privateMessage to $ T.concat - [ voterName, " voted to devour ", targetName, "." - ] - -playerDevouredMessage :: Player -> Message -playerDevouredMessage player = publicMessage $ T.concat - [ "As you open them you notice a door broken down and " - , playerName, "'s guts half devoured and spilling out over the cobblestones." - , " From the look of their personal effects, you deduce they were " - , article playerRole, " ", humanise playerRole, "." - ] - where - playerName = humanise player - playerRole = player ^. role - -playerTurnedToStoneMessage :: Player -> Message -playerTurnedToStoneMessage player = publicMessage $ T.unwords - [ "Next to them you see a stone", playerRole, "statue, cold to the touch.", playerName - , "must have looked into the eyes of the Medusa at the very end." - ] - where - playerName = humanise player - playerRole = humanise $ player ^. role - -noPlayerDevouredMessage :: Message -noPlayerDevouredMessage = publicMessage $ T.unwords - [ "Surprisingly you see everyone present at the town square." - , "Perhaps the Werewolves have left Fougères?" - ] - -playerCannotDevourAnotherWerewolfMessage :: Text -> Message -playerCannotDevourAnotherWerewolfMessage to = privateMessage to "You cannot devour another Werewolf!" - -playerCannotChooseSelfMessage :: Text -> Message -playerCannotChooseSelfMessage to = privateMessage to "You cannot choose yourself!" - -playerPoisonedMessage :: Player -> Message -playerPoisonedMessage player = publicMessage $ T.unwords - [ "Upon further discovery, it looks like the Witch struck in the night." - , playerName, "the", playerRole, "is hanging over the side of their bed, poisoned." - ] - where - playerName = humanise player - playerRole = humanise $ player ^. role - -playerHasAlreadyHealedMessage :: Text -> Message -playerHasAlreadyHealedMessage to = privateMessage to "You've already healed someone!" - -playerHasAlreadyPoisonedMessage :: Text -> Message -playerHasAlreadyPoisonedMessage to = privateMessage to "You've already poisoned someone!" - -article :: Role -> Text -article role - | role `elem` restrictedRoles = "the" - | otherwise = "a" - -concatList :: [Text] -> Text -concatList [] = "" -concatList [word] = word -concatList words = T.unwords [T.intercalate ", " (init words), "and", last words] - -conjugateToBe :: Int -> Text -conjugateToBe 1 = "is" -conjugateToBe _ = "are" - -tryPlural :: Int -> Text -> Text -tryPlural 1 word = word -tryPlural _ word = T.snoc word 's' diff --git a/app/Game/Werewolf/Util.hs b/app/Game/Werewolf/Util.hs --- a/app/Game/Werewolf/Util.hs +++ b/app/Game/Werewolf/Util.hs @@ -50,13 +50,14 @@ import Data.Maybe import Data.Text (Text) -import Game.Werewolf.Game hiding (getAllowedVoters, getPendingVoters, hasAnyoneWon, - hasFallenAngelWon, hasVillagersWon, hasWerewolvesWon) -import qualified Game.Werewolf.Game as Game -import Game.Werewolf.Messages +import Game.Werewolf.Game hiding (getAllowedVoters, getPendingVoters, + hasAnyoneWon, hasFallenAngelWon, hasVillagersWon, + hasWerewolvesWon) +import qualified Game.Werewolf.Game as Game +import Game.Werewolf.Message.Engine import Game.Werewolf.Player import Game.Werewolf.Response -import Game.Werewolf.Role hiding (name) +import Game.Werewolf.Role hiding (name) import Prelude hiding (round) diff --git a/app/Game/Werewolf/Variant/NoRoleKnowledge/Command.hs b/app/Game/Werewolf/Variant/NoRoleKnowledge/Command.hs new file mode 100644 --- /dev/null +++ b/app/Game/Werewolf/Variant/NoRoleKnowledge/Command.hs @@ -0,0 +1,36 @@ +{-| +Module : Game.Werewolf.Variant.NoRoleKnowledge.Command +Description : Suite of command messages used throughout the game. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +A 'Message' is used to relay information back to either all players or a single player. This module +defines suite of command messages used throughout the werewolf game for the 'NoRoleKnowledge' +variant. +-} + +{-# LANGUAGE QuasiQuotes #-} + +module Game.Werewolf.Variant.NoRoleKnowledge.Command ( + -- * Ping + rolePingedText, werewolvesPingedText, + + -- * Status + currentTurnText, +) where + +import Data.String.Interpolate.Extra +import Data.Text (Text) + +import Game.Werewolf + +rolePingedText :: Role -> Text +rolePingedText _ = [iFile|variant/no-role-knowledge/command/ping/role-pinged.txt|] + +werewolvesPingedText :: Text +werewolvesPingedText = [iFile|variant/no-role-knowledge/command/ping/werewolves-pinged.txt|] + +currentTurnText :: Game -> Text +currentTurnText _ = [iFile|variant/no-role-knowledge/command/status/current-turn.txt|] diff --git a/app/Game/Werewolf/Variant/NoRoleKnowledge/Engine.hs b/app/Game/Werewolf/Variant/NoRoleKnowledge/Engine.hs new file mode 100644 --- /dev/null +++ b/app/Game/Werewolf/Variant/NoRoleKnowledge/Engine.hs @@ -0,0 +1,32 @@ +{-| +Module : Game.Werewolf.Variant.NoRoleKnowledge.Engine +Description : Suite of engine messages used throughout the game. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +A 'Message' is used to relay information back to either all players or a single player. This module +defines suite of engine messages used throughout the werewolf game for the 'NoRoleKnowledge' +variant. +-} + +{-# LANGUAGE QuasiQuotes #-} + +module Game.Werewolf.Variant.NoRoleKnowledge.Engine ( + -- * New game + rolesInGameText, +) where + +import Control.Lens + +import Data.String.Interpolate.Extra +import Data.Text (Text) +import qualified Data.Text as T + +import Game.Werewolf + +rolesInGameText :: Game -> Text +rolesInGameText game = [iFile|variant/no-role-knowledge/engine/new-game/roles-in-game.txt|] + where + totalBalance = sumOf (players . roles . balance) game diff --git a/app/Game/Werewolf/Variant/Standard/Command.hs b/app/Game/Werewolf/Variant/Standard/Command.hs new file mode 100644 --- /dev/null +++ b/app/Game/Werewolf/Variant/Standard/Command.hs @@ -0,0 +1,206 @@ +{-| +Module : Game.Werewolf.Variant.Standard.Command +Description : Suite of command messages used throughout the game. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +A 'Message' is used to relay information back to either all players or a single player. This module +defines suite of command messages used throughout the werewolf game for the 'Standard' variant. +-} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module Game.Werewolf.Variant.Standard.Command ( + -- * Boot + callerVotedBootText, + + -- * Circle + gameCircleText, + + -- * Choose + playerShotText, + + -- * End + gameEndedText, + + -- * Help + druidsTurnText, gameDescriptionText, gameRulesText, globalCommandsText, helpCommandsText, + hunterCommandsText, huntersTurnText, oracleCommandsText, oraclesTurnText, orphanCommandsText, + orphansTurnText, protectorCommandsText, protectorsTurnText, roleDescriptionText, + scapegoatCommandsText, scapegoatsTurnText, seerCommandsText, seersTurnText, + standardCommandsText, standardCycleText, statusCommandsText, sunriseText, sunsetText, + villageDrunksTurnText, villagesTurnText, werewolvesTurnText, winConditionText, + witchCommandsText, witchsTurnText, + + -- * Ping + playerPingedText, rolePingedText, villagePingedText, werewolvesPingedText, + + -- * Quit + callerQuitText, + + -- * Status + alivePlayersText, currentTurnText, deadPlayersText, gameOverText, + + -- * Unvote + callerRescindedVoteText, + + -- * Version + engineVersionText, + + -- * Vote + callerVotedDevourText, callerVotedLynchText, +) where + +import Control.Lens + +import Data.String.Humanise +import Data.String.Interpolate.Extra +import Data.Text (Text) +import qualified Data.Text as T +import Data.Version + +import Game.Werewolf +import Game.Werewolf.Message + +import Werewolf.Version + +callerVotedBootText :: Player -> Player -> Text +callerVotedBootText caller target = [iFile|variant/standard/command/boot/player-voted-boot.txt|] + +gameCircleText :: [Player] -> Text +gameCircleText players = [iFile|variant/standard/command/circle/game-circle.txt|] + +playerShotText :: Player -> Text +playerShotText player = [iFile|variant/standard/command/choose/player-shot.txt|] + +gameEndedText :: Text -> Text +gameEndedText callerName = [iFile|variant/standard/command/end/game-ended.txt|] + +druidsTurnText :: Text +druidsTurnText = [iFile|variant/standard/command/help/druids-turn.txt|] + +gameDescriptionText :: Text +gameDescriptionText = [iFile|variant/standard/command/help/game-description.txt|] + +gameRulesText :: Text +gameRulesText = [iFile|variant/standard/command/help/rules.txt|] + +globalCommandsText :: Text +globalCommandsText = [iFile|variant/standard/command/help/global-commands.txt|] + +helpCommandsText :: Text +helpCommandsText = [iFile|variant/standard/command/help/help-commands.txt|] + +hunterCommandsText :: Text +hunterCommandsText = [iFile|variant/standard/command/help/hunter-commands.txt|] + +huntersTurnText :: Text +huntersTurnText = [iFile|variant/standard/command/help/hunters-turn.txt|] + +oracleCommandsText :: Text +oracleCommandsText = [iFile|variant/standard/command/help/oracle-commands.txt|] + +oraclesTurnText :: Text +oraclesTurnText = [iFile|variant/standard/command/help/oracles-turn.txt|] + +orphanCommandsText :: Text +orphanCommandsText = [iFile|variant/standard/command/help/orphan-commands.txt|] + +orphansTurnText :: Text +orphansTurnText = [iFile|variant/standard/command/help/orphans-turn.txt|] + +protectorCommandsText :: Text +protectorCommandsText = [iFile|variant/standard/command/help/protector-commands.txt|] + +protectorsTurnText :: Text +protectorsTurnText = [iFile|variant/standard/command/help/protectors-turn.txt|] + +roleDescriptionText :: Role -> Text +roleDescriptionText role = [iFile|variant/standard/command/help/role.txt|] + +scapegoatCommandsText :: Text +scapegoatCommandsText = [iFile|variant/standard/command/help/scapegoat-commands.txt|] + +scapegoatsTurnText :: Text +scapegoatsTurnText = [iFile|variant/standard/command/help/scapegoats-turn.txt|] + +seerCommandsText :: Text +seerCommandsText = [iFile|variant/standard/command/help/seer-commands.txt|] + +seersTurnText :: Text +seersTurnText = [iFile|variant/standard/command/help/seers-turn.txt|] + +standardCommandsText :: Text +standardCommandsText = [iFile|variant/standard/command/help/standard-commands.txt|] + +standardCycleText :: Text +standardCycleText = [iFile|variant/standard/command/help/standard-cycle.txt|] + +statusCommandsText :: Text +statusCommandsText = [iFile|variant/standard/command/help/status-commands.txt|] + +sunriseText :: Text +sunriseText = [iFile|variant/standard/command/help/sunrise.txt|] + +sunsetText :: Text +sunsetText = [iFile|variant/standard/command/help/sunset.txt|] + +villageDrunksTurnText :: Text +villageDrunksTurnText = [iFile|variant/standard/command/help/village-drunks-turn.txt|] + +villagesTurnText :: Text +villagesTurnText = [iFile|variant/standard/command/help/villages-turn.txt|] + +werewolvesTurnText :: Text +werewolvesTurnText = [iFile|variant/standard/command/help/werewolves-turn.txt|] + +winConditionText :: Text +winConditionText = [iFile|variant/standard/command/help/win-condition.txt|] + +witchCommandsText :: Text +witchCommandsText = [iFile|variant/standard/command/help/witch-commands.txt|] + +witchsTurnText :: Text +witchsTurnText = [iFile|variant/standard/command/help/witchs-turn.txt|] + +playerPingedText :: Text +playerPingedText = [iFile|variant/standard/command/ping/player-pinged.txt|] + +rolePingedText :: Role -> Text +rolePingedText role = [iFile|variant/standard/command/ping/role-pinged.txt|] + +villagePingedText :: Text +villagePingedText = [iFile|variant/standard/command/ping/village-pinged.txt|] + +werewolvesPingedText :: Text +werewolvesPingedText = [iFile|variant/standard/command/ping/werewolves-pinged.txt|] + +callerQuitText :: Player -> Text +callerQuitText caller = [iFile|variant/standard/command/quit/caller-quit.txt|] + +alivePlayersText :: Game -> Text +alivePlayersText game = [iFile|variant/standard/command/status/alive-players.txt|] + +currentTurnText :: Game -> Text +currentTurnText game = [iFile|variant/standard/command/status/current-turn.txt|] + +deadPlayersText :: Game -> Text +deadPlayersText game = [iFile|variant/standard/command/status/dead-players.txt|] + +gameOverText :: Text +gameOverText = [iFile|variant/standard/command/status/game-over.txt|] + +callerRescindedVoteText :: Player -> Text +callerRescindedVoteText caller = [iFile|variant/standard/command/unvote/player-rescinded-vote.txt|] + +engineVersionText :: Text +engineVersionText = [iFile|variant/standard/command/version/engine-version.txt|] + +callerVotedDevourText :: Player -> Player -> Text +callerVotedDevourText caller target = [iFile|variant/standard/command/vote/player-made-devour-vote.txt|] + +callerVotedLynchText :: Player -> Player -> Text +callerVotedLynchText caller target = [iFile|variant/standard/command/vote/player-made-lynch-vote.txt|] diff --git a/app/Game/Werewolf/Variant/Standard/Engine.hs b/app/Game/Werewolf/Variant/Standard/Engine.hs new file mode 100644 --- /dev/null +++ b/app/Game/Werewolf/Variant/Standard/Engine.hs @@ -0,0 +1,289 @@ +{-| +Module : Game.Werewolf.Variant.Standard.Engine +Description : Suite of engine messages used throughout the game. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +A 'Message' is used to relay information back to either all players or a single player. This module +defines suite of engine messages used throughout the werewolf game for the 'Standard' variant. +-} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module Game.Werewolf.Variant.Standard.Engine ( + -- * Druid's turn + druidsTurnText, + + -- * General + playerBootedText, playerKilledText, + + -- * Game over + allegianceWonText, fallenAngelWonText, playerContributedText, playerLostText, playerRolesText, + playerWonText, + + -- * Hunter's turn + huntersTurnPrivateText, huntersTurnPublicText, + + -- * Lynching + jesterLynchedText, noPlayerLynchedText, playerLynchedText, scapegoatLynchedText, + werewolfLynchedText, + + -- * New game + beholderText, fallenAngelText, newPlayerText, playersInGameText, rolesInGameText, + spitefulGhostText, trueVillagerText, + + -- * Oracle's turn + oraclesTurnPrivateText, oraclesTurnPublicText, + + -- * Orphan's turn + orphanJoinedWerewolvesGroupText, orphanJoinedWerewolvesPrivateText, orphansTurnPrivateText, + orphansTurnPublicText, + + -- * Protector's turn + protectorsTurnPrivateText, protectorsTurnPublicText, + + -- * Scapegoat's turn + scapegoatsTurnText, scapegoatsTurnEndedText, + + -- * Seer's turn + seersTurnPrivateText, seersTurnPublicText, alphaWolfSeenText, lycanSeenText, + + -- * Sunrise + noPlayerDevouredText, playerDevouredText, playerDivinedText, playerPoisonedText, playerSeenText, + sunriseText, playerTurnedToStoneText, + + -- * Sunset + sunsetText, + + -- * Village Drunk's turn + villageDrunkJoinedVillageText, villageDrunkJoinedWerewolvesGroupText, + villageDrunkJoinedWerewolvesPrivateText, villageDrunksTurnText, + + -- * Village's turn + villagesTurnText, + + -- * Werewolves' turn + firstWerewolvesTurnText, werewolvesTurnPrivateText, werewolvesTurnPublicText, + + -- * Witch's turn + healText, passText, poisonText, witchsTurnText, +) where + +import Control.Arrow +import Control.Lens hiding (isn't) +import Control.Lens.Extra + +import Data.List.Extra +import Data.String.Humanise +import Data.String.Interpolate.Extra +import Data.Text (Text) +import qualified Data.Text as T + +import Game.Werewolf +import Game.Werewolf.Message + +druidsTurnText :: Text +druidsTurnText = [iFile|variant/standard/engine/druids-turn/start.txt|] + +playerBootedText :: Player -> Text +playerBootedText player = [iFile|variant/standard/engine/general/player-booted.txt|] + +playerKilledText :: Text +playerKilledText = [iFile|variant/standard/engine/general/player-killed.txt|] + +allegianceWonText :: Allegiance -> Text +allegianceWonText allegiance = [iFile|variant/standard/engine/game-over/allegiance-won.txt|] + +fallenAngelWonText :: Text +fallenAngelWonText = [iFile|variant/standard/engine/game-over/fallen-angel-won.txt|] + +playerContributedText :: Text +playerContributedText = [iFile|variant/standard/engine/game-over/player-contributed.txt|] + +playerLostText :: Text +playerLostText = [iFile|variant/standard/engine/game-over/player-lost.txt|] + +playerRolesText :: Game -> Text +playerRolesText game = [iFile|variant/standard/engine/game-over/player-roles.txt|] + +playerWonText :: Text +playerWonText = [iFile|variant/standard/engine/game-over/player-won.txt|] + +huntersTurnPrivateText :: Text +huntersTurnPrivateText = [iFile|variant/standard/engine/hunters-turn/start-private.txt|] + +huntersTurnPublicText :: Game -> Text +huntersTurnPublicText game = [iFile|variant/standard/engine/hunters-turn/start-public.txt|] + where + hunter = game ^?! players . hunters + +jesterLynchedText :: Game -> Text +jesterLynchedText game = [iFile|variant/standard/engine/lynching/jester-lynched.txt|] + where + jester = game ^?! players . jesters + +noPlayerLynchedText :: Text +noPlayerLynchedText = [iFile|variant/standard/engine/lynching/no-player-lynched.txt|] + +playerLynchedText :: Player -> Text +playerLynchedText player = [iFile|variant/standard/engine/lynching/player-lynched.txt|] + +scapegoatLynchedText :: Game -> Text +scapegoatLynchedText game = [iFile|variant/standard/engine/lynching/scapegoat-lynched.txt|] + where + scapegoat = game ^?! players . scapegoats + +werewolfLynchedText :: Player -> Text +werewolfLynchedText werewolf = [iFile|variant/standard/engine/lynching/werewolf-lynched.txt|] + +beholderText :: Game -> Text +beholderText game = [iFile|variant/standard/engine/new-game/beholder.txt|] + where + seer = game ^?! players . seers + +fallenAngelText :: Text +fallenAngelText = [iFile|variant/standard/engine/new-game/fallen-angel.txt|] + +newPlayerText :: Player -> Text +newPlayerText player = [iFile|variant/standard/engine/new-game/new-player.txt|] + +playersInGameText :: Game -> Text +playersInGameText game = [iFile|variant/standard/engine/new-game/players-in-game.txt|] + +rolesInGameText :: Game -> Text +rolesInGameText game = [iFile|variant/standard/engine/new-game/roles-in-game.txt|] + where + roles = game ^.. players . traverse . role + roleCounts = map (head &&& length) (groupSortOn humanise roles) + totalBalance = sumOf (traverse . balance) roles + +spitefulGhostText :: Game -> Text +spitefulGhostText game = [iFile|variant/standard/engine/new-game/spiteful-ghost.txt|] + +trueVillagerText :: Game -> Text +trueVillagerText game = [iFile|variant/standard/engine/new-game/true-villager.txt|] + where + trueVillager = game ^?! players . trueVillagers + +oraclesTurnPrivateText :: Text +oraclesTurnPrivateText = [iFile|variant/standard/engine/oracles-turn/start-private.txt|] + +oraclesTurnPublicText :: Text +oraclesTurnPublicText = [iFile|variant/standard/engine/oracles-turn/start-public.txt|] + +orphanJoinedWerewolvesGroupText :: Game -> Text +orphanJoinedWerewolvesGroupText game = [iFile|variant/standard/engine/orphans-turn/player-joined-werewolves-group.txt|] + where + orphan = game ^?! players . orphans + +orphanJoinedWerewolvesPrivateText :: Game -> Text +orphanJoinedWerewolvesPrivateText game = [iFile|variant/standard/engine/orphans-turn/player-joined-werewolves-private.txt|] + where + orphan = game ^?! players . orphans + werewolves = game ^.. players . traverse . alive . filtered (is werewolf) \\ [orphan] + +orphansTurnPrivateText :: Text +orphansTurnPrivateText = [iFile|variant/standard/engine/orphans-turn/start-private.txt|] + +orphansTurnPublicText :: Text +orphansTurnPublicText = [iFile|variant/standard/engine/orphans-turn/start-public.txt|] + +protectorsTurnPrivateText :: Text +protectorsTurnPrivateText = [iFile|variant/standard/engine/protectors-turn/start-private.txt|] + +protectorsTurnPublicText :: Text +protectorsTurnPublicText = [iFile|variant/standard/engine/protectors-turn/start-public.txt|] + +scapegoatsTurnText :: Game -> Text +scapegoatsTurnText game = [iFile|variant/standard/engine/scapegoats-turn/start.txt|] + where + scapegoat = game ^?! players . scapegoats + +scapegoatsTurnEndedText :: Game -> Text +scapegoatsTurnEndedText game = [iFile|variant/standard/engine/scapegoats-turn/end.txt|] + +seersTurnPrivateText :: Text +seersTurnPrivateText = [iFile|variant/standard/engine/seers-turn/start-private.txt|] + +seersTurnPublicText :: Text +seersTurnPublicText = [iFile|variant/standard/engine/seers-turn/start-public.txt|] + +alphaWolfSeenText :: Player -> Text +alphaWolfSeenText alphaWolf = [iFile|variant/standard/engine/sunrise/alpha-wolf-seen.txt|] + +lycanSeenText :: Player -> Text +lycanSeenText lycan = [iFile|variant/standard/engine/sunrise/lycan-seen.txt|] + +noPlayerDevouredText :: Text +noPlayerDevouredText = [iFile|variant/standard/engine/sunrise/no-player-devoured.txt|] + +playerDevouredText :: Player -> Text +playerDevouredText player = [iFile|variant/standard/engine/sunrise/player-devoured.txt|] + +playerDivinedText :: Player -> Text +playerDivinedText player = [iFile|variant/standard/engine/sunrise/player-divined.txt|] + +playerPoisonedText :: Player -> Text +playerPoisonedText player = [iFile|variant/standard/engine/sunrise/player-poisoned.txt|] + +playerSeenText :: Player -> Text +playerSeenText player = [iFile|variant/standard/engine/sunrise/player-seen.txt|] + where + article = if is loner player then "" else "the " :: Text + +sunriseText :: Text +sunriseText = [iFile|variant/standard/engine/sunrise/start.txt|] + +playerTurnedToStoneText :: Player -> Text +playerTurnedToStoneText player = [iFile|variant/standard/engine/sunrise/player-turned-to-stone.txt|] + +sunsetText :: Text +sunsetText = [iFile|variant/standard/engine/sunset/start.txt|] + +villageDrunkJoinedVillageText :: Text +villageDrunkJoinedVillageText = [iFile|variant/standard/engine/village-drunks-turn/player-joined-village.txt|] + +villageDrunkJoinedWerewolvesGroupText :: Game -> Text +villageDrunkJoinedWerewolvesGroupText game = [iFile|variant/standard/engine/village-drunks-turn/player-joined-werewolves-group.txt|] + where + villageDrunk = game ^?! players . villageDrunks + +villageDrunkJoinedWerewolvesPrivateText :: Game -> Text +villageDrunkJoinedWerewolvesPrivateText game = [iFile|variant/standard/engine/village-drunks-turn/player-joined-werewolves-private.txt|] + where + villageDrunk = game ^?! players . villageDrunks + werewolves = game ^.. players . traverse . alive . filtered (is werewolf) \\ [villageDrunk] + +villageDrunksTurnText :: Text +villageDrunksTurnText = [iFile|variant/standard/engine/village-drunks-turn/start.txt|] + +villagesTurnText :: Text +villagesTurnText = [iFile|variant/standard/engine/villages-turn/start.txt|] + +firstWerewolvesTurnText :: Player -> Game -> Text +firstWerewolvesTurnText player game = [iFile|variant/standard/engine/werewolves-turn/start-first-round-private.txt|] + where + werewolves = game ^.. players . traverse . alive . filtered (is werewolf) + +werewolvesTurnPrivateText :: Text +werewolvesTurnPrivateText = [iFile|variant/standard/engine/werewolves-turn/start-private.txt|] + +werewolvesTurnPublicText :: Text +werewolvesTurnPublicText = [iFile|variant/standard/engine/werewolves-turn/start-public.txt|] + +healText :: Game -> Text +healText game = [iFile|variant/standard/engine/witchs-turn/heal.txt|] + where + victim = game ^?! votee + +passText :: Text +passText = [iFile|variant/standard/engine/witchs-turn/pass.txt|] + +poisonText :: Text +poisonText = [iFile|variant/standard/engine/witchs-turn/poison.txt|] + +witchsTurnText :: Text +witchsTurnText = [iFile|variant/standard/engine/witchs-turn/start.txt|] diff --git a/app/Game/Werewolf/Variant/Standard/Error.hs b/app/Game/Werewolf/Variant/Standard/Error.hs new file mode 100644 --- /dev/null +++ b/app/Game/Werewolf/Variant/Standard/Error.hs @@ -0,0 +1,115 @@ +{-| +Module : Game.Werewolf.Variant.Standard.Error +Description : Suite of error messages used throughout the game. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +A 'Message' is used to relay information back to either all players or a single player. This module +defines suite of error messages used throughout the werewolf game for the 'Standard' variant. +-} + +{-# LANGUAGE QuasiQuotes #-} + +module Game.Werewolf.Variant.Standard.Error ( + -- * Command + + -- ** Boot + callerAlreadyVotedBootText, + + -- ** Choose + callerCannotChooseJesterText, callerCannotChooseSelfText, noTargetText, + + -- ** General + callerCannotDoThatText, callerCannotDoThatRightNowText, callerDeadText, noGameRunningText, + playerDoesNotExistText, targetDeadText, + + -- ** Heal + callerAlreadyHealedText, + + -- ** Poison + callerAlreadyPoisonedText, + + -- ** Protect + callerCannotProtectSamePlayerText, + + -- ** Start + gameAlreadyRunningText, playerCountTooLowText, playerNamesNotUniqueText, + roleCountRestrictedText, roleDoesNotExistText, + + -- ** Unvote + callerNotVotedText, + + -- ** Vote + callerAlreadyVotedText, callerCannotDevourAnotherWerewolfText, +) where + +import Data.String.Humanise +import Data.String.Interpolate.Extra +import Data.Text (Text) + +import Game.Werewolf + +callerAlreadyVotedBootText :: Player -> Text +callerAlreadyVotedBootText target = [iFile|variant/standard/error/command/boot/caller-already-voted-boot.txt|] + +callerCannotChooseJesterText :: Text +callerCannotChooseJesterText = [iFile|variant/standard/error/command/choose/caller-cannot-choose-jester.txt|] + +callerCannotChooseSelfText :: Text +callerCannotChooseSelfText = [iFile|variant/standard/error/command/choose/caller-cannot-choose-self.txt|] + +noTargetText :: Text +noTargetText = [iFile|variant/standard/error/command/choose/no-target.txt|] + +callerCannotDoThatText :: Text +callerCannotDoThatText = [iFile|variant/standard/error/command/general/caller-cannot-do-that.txt|] + +callerCannotDoThatRightNowText :: Text +callerCannotDoThatRightNowText = [iFile|variant/standard/error/command/general/caller-cannot-do-that-right-now.txt|] + +callerDeadText :: Text +callerDeadText = [iFile|variant/standard/error/command/general/caller-dead.txt|] + +noGameRunningText :: Text +noGameRunningText = [iFile|variant/standard/error/command/general/no-game-running.txt|] + +playerDoesNotExistText :: Text -> Text +playerDoesNotExistText name = [iFile|variant/standard/error/command/general/player-does-not-exist.txt|] + +targetDeadText :: Player -> Text +targetDeadText target = [iFile|variant/standard/error/command/general/target-dead.txt|] + +callerAlreadyHealedText :: Text +callerAlreadyHealedText = [iFile|variant/standard/error/command/heal/caller-already-healed.txt|] + +callerAlreadyPoisonedText :: Text +callerAlreadyPoisonedText = [iFile|variant/standard/error/command/poison/caller-already-poisoned.txt|] + +callerCannotProtectSamePlayerText :: Text +callerCannotProtectSamePlayerText = [iFile|variant/standard/error/command/protect/caller-cannot-protect-same-player.txt|] + +gameAlreadyRunningText :: Text +gameAlreadyRunningText = [iFile|variant/standard/error/command/start/game-already-running.txt|] + +playerCountTooLowText :: Text +playerCountTooLowText = [iFile|variant/standard/error/command/start/player-count-too-low.txt|] + +playerNamesNotUniqueText :: Text +playerNamesNotUniqueText = [iFile|variant/standard/error/command/start/player-names-not-unique.txt|] + +roleCountRestrictedText :: Role -> Text +roleCountRestrictedText role = [iFile|variant/standard/error/command/start/role-count-restricted.txt|] + +roleDoesNotExistText :: Text -> Text +roleDoesNotExistText roleName = [iFile|variant/standard/error/command/start/role-does-not-exist.txt|] + +callerNotVotedText :: Text +callerNotVotedText = [iFile|variant/standard/error/command/unvote/caller-not-voted.txt|] + +callerAlreadyVotedText :: Text +callerAlreadyVotedText = [iFile|variant/standard/error/command/vote/caller-already-voted.txt|] + +callerCannotDevourAnotherWerewolfText :: Text +callerCannotDevourAnotherWerewolfText = [iFile|variant/standard/error/command/vote/caller-cannot-devour-werewolf.txt|] diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -61,7 +61,7 @@ Boot options -> Boot.handle callerName tag options Circle options -> Circle.handle callerName tag options Divine options -> Divine.handle callerName tag options - End options -> End.handle callerName tag options + End -> End.handle callerName tag Heal -> Heal.handle callerName tag Help options -> Help.handle callerName tag options Interpret (Interpret.Options args) -> interpret callerName tag args diff --git a/app/Werewolf/Command/Boot.hs b/app/Werewolf/Command/Boot.hs --- a/app/Werewolf/Command/Boot.hs +++ b/app/Werewolf/Command/Boot.hs @@ -29,8 +29,8 @@ import Game.Werewolf.Command import Game.Werewolf.Command.Global import Game.Werewolf.Engine +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System data Options = Options diff --git a/app/Werewolf/Command/Choose.hs b/app/Werewolf/Command/Choose.hs --- a/app/Werewolf/Command/Choose.hs +++ b/app/Werewolf/Command/Choose.hs @@ -9,8 +9,6 @@ Options and handler for the choose subcommand. -} -{-# LANGUAGE OverloadedStrings #-} - module Werewolf.Command.Choose ( -- * Options Options(..), @@ -34,9 +32,8 @@ import Game.Werewolf.Command.Orphan as Orphan import Game.Werewolf.Command.Scapegoat as Scapegoat import Game.Werewolf.Engine -import Game.Werewolf.Messages +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System data Options = Options diff --git a/app/Werewolf/Command/Circle.hs b/app/Werewolf/Command/Circle.hs --- a/app/Werewolf/Command/Circle.hs +++ b/app/Werewolf/Command/Circle.hs @@ -27,8 +27,8 @@ import Game.Werewolf import Game.Werewolf.Command import Game.Werewolf.Command.Status +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System data Options = Options diff --git a/app/Werewolf/Command/Divine.hs b/app/Werewolf/Command/Divine.hs --- a/app/Werewolf/Command/Divine.hs +++ b/app/Werewolf/Command/Divine.hs @@ -29,8 +29,8 @@ import Game.Werewolf.Command import Game.Werewolf.Command.Oracle import Game.Werewolf.Engine +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System data Options = Options diff --git a/app/Werewolf/Command/End.hs b/app/Werewolf/Command/End.hs --- a/app/Werewolf/Command/End.hs +++ b/app/Werewolf/Command/End.hs @@ -1,20 +1,15 @@ {-| Module : Werewolf.Command.End -Description : Options and handler for the end subcommand. +Description : Handler for the end subcommand. Copyright : (c) Henry J. Wylde, 2016 License : BSD3 Maintainer : public@hjwylde.com -Options and handler for the end subcommand. +Handler for the end subcommand. -} -{-# LANGUAGE OverloadedStrings #-} - module Werewolf.Command.End ( - -- * Options - Options(..), - -- * Handle handle, ) where @@ -23,32 +18,23 @@ import Control.Monad.Extra import Control.Monad.IO.Class -import Data.Text (Text) -import qualified Data.Text as T +import Data.Text (Text) import Game.Werewolf -import Game.Werewolf.Messages +import Game.Werewolf.Message.Command +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System -data Options = Options - { optForce :: Bool - } deriving (Eq, Show) - -handle :: MonadIO m => Text -> Text -> Options -> m () -handle callerName tag (Options force) = do +handle :: MonadIO m => Text -> Text -> m () +handle callerName tag = do unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - unless force $ do - game <- readGame tag + game <- readGame tag - unless (has (players . traverse . named callerName) game) $ - exitWith failure { messages = [playerCannotDoThatMessage callerName] } + unless (has (players . traverse . named callerName) game) $ + exitWith failure { messages = [playerCannotDoThatMessage callerName] } deleteGame tag - exitWith success { messages = [gameEndedMessage] } - where - -- TODO (hjw): move this to Messages - gameEndedMessage = publicMessage $ T.concat ["Game ended by ", callerName, "."] + exitWith success { messages = [gameEndedMessage callerName] } diff --git a/app/Werewolf/Command/Heal.hs b/app/Werewolf/Command/Heal.hs --- a/app/Werewolf/Command/Heal.hs +++ b/app/Werewolf/Command/Heal.hs @@ -9,8 +9,6 @@ Handler for the heal subcommand. -} -{-# LANGUAGE OverloadedStrings #-} - module Werewolf.Command.Heal ( -- * Handle handle, @@ -28,8 +26,8 @@ import Game.Werewolf.Command import Game.Werewolf.Command.Witch import Game.Werewolf.Engine +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System handle :: (MonadIO m, MonadRandom m) => Text -> Text -> m () diff --git a/app/Werewolf/Command/Help.hs b/app/Werewolf/Command/Help.hs --- a/app/Werewolf/Command/Help.hs +++ b/app/Werewolf/Command/Help.hs @@ -9,8 +9,6 @@ Options and handler for the help subcommand. -} -{-# LANGUAGE OverloadedStrings #-} - module Werewolf.Command.Help ( -- * Options Options(..), Command(..), @@ -20,16 +18,16 @@ ) where import Control.Lens -import Control.Monad.Extra import Control.Monad.IO.Class -import Data.Function -import Data.List -import Data.Text (Text) -import qualified Data.Text as T +import Data.Function +import Data.List +import Data.Maybe +import Data.String.Humanise +import Data.Text (Text) -import Game.Werewolf -import qualified Game.Werewolf.Role as Role +import Game.Werewolf +import Game.Werewolf.Message.Command import Werewolf.System @@ -47,173 +45,69 @@ handle :: MonadIO m => Text -> Text -> Options -> m () handle callerName tag (Options (Just (Commands optAll))) = do - mGame <- ifM (doesGameExist tag &&^ return (not optAll)) (Just <$> readGame tag) (return Nothing) + mGame <- getGame tag optAll exitWith success - { messages = map (privateMessage callerName) (commandsMessages callerName mGame) + { messages = commandsMessages callerName mGame } handle callerName tag (Options (Just (Roles optAll))) = do - roles <- (sortBy (compare `on` view Role.name) . nub) <$> ifM (doesGameExist tag &&^ return (not optAll)) - (toListOf (players . roles) <$> readGame tag) - (return allRoles) + mGame <- getGame tag optAll + let roles' = sortBy (compare `on` humanise) . nub $ case mGame of + Just game -> game ^.. players . roles + Nothing -> allRoles + exitWith success - { messages = map (privateMessage callerName . roleMessage) roles + { messages = map (roleMessage callerName) roles' } handle callerName tag (Options (Just (Rules optAll))) = do - mGame <- ifM (doesGameExist tag &&^ return (not optAll)) (Just <$> readGame tag) (return Nothing) + mGame <- getGame tag optAll exitWith success - { messages = map (privateMessage callerName) (rulesMessages mGame) + { messages = rulesMessages callerName mGame } handle callerName _ (Options Nothing) = exitWith success - { messages = map (privateMessage callerName) helpMessages + { messages = helpMessages callerName } -commandsMessages :: Text -> Maybe Game -> [Text] -commandsMessages callerName mGame = map (T.intercalate "\n") $ filter (/= []) - [ [ "Global commands:" - , "- `start ([-e|--extra-roles ROLE,...] | [-r|--random-extra-roles]) [--include-seer] PLAYER...`" - , "- `end`" - , "- `boot PLAYER`" - , "- `quit`" - , "- `version`" - ] - , [ "Status commands:" - , "- `ping` ping the status of the current game publicly" - , "- `status` get the status of the current game privately" - , "- `circle [-a|--include-dead]` get the game circle" - ] - , [ "Standard commands:" - , "- `vote PLAYER`" - , "- `unvote`" - ] - , whenPlayerHasRole callerName mGame hunterRole - [ "Hunter commands:" - , "- `choose PLAYER`" - ] - , whenPlayerHasRole callerName mGame oracleRole - [ "Oracle commands:" - , "- `divine PLAYER`" - ] - , whenPlayerHasRole callerName mGame orphanRole - [ "Orphan commands:" - , "- `choose PLAYER`" - ] - , whenPlayerHasRole callerName mGame protectorRole - [ "Protector commands:" - , "- `protect PLAYER`" - ] - , whenPlayerHasRole callerName mGame scapegoatRole - [ "Scapegoat commands:" - , "- `choose PLAYER...`" - ] - , whenPlayerHasRole callerName mGame seerRole - [ "Seer commands:" - , "- `see PLAYER`" - ] - , whenPlayerHasRole callerName mGame witchRole - [ "Witch commands:" - , "- `heal`" - , "- `poison PLAYER`" - , "- `pass`" - ] - ] - -roleMessage :: Role -> Text -roleMessage role = T.intercalate "\n" - [ T.concat [role ^. Role.name, " (", T.pack . show $ role ^. balance, "):"] - , role ^. description - , role ^. rules +commandsMessages :: Text -> Maybe Game -> [Message] +commandsMessages callerName mGame = + [ globalCommandsMessage callerName + , statusCommandsMessage callerName + , standardCommandsMessage callerName + ] ++ [ hunterCommandsMessage callerName + | isNothing mGame || has (players . hunters . named callerName) (fromJust mGame) + ] ++ [ oracleCommandsMessage callerName + | isNothing mGame || has (players . oracles . named callerName) (fromJust mGame) + ] ++ [ orphanCommandsMessage callerName + | isNothing mGame || has (players . orphans . named callerName) (fromJust mGame) + ] ++ [ protectorCommandsMessage callerName + | isNothing mGame || has (players . protectors . named callerName) (fromJust mGame) + ] ++ [ scapegoatCommandsMessage callerName + | isNothing mGame || has (players . scapegoats . named callerName) (fromJust mGame) + ] ++ [ seerCommandsMessage callerName + | isNothing mGame || has (players . seers . named callerName) (fromJust mGame) + ] ++ [ witchCommandsMessage callerName + | isNothing mGame || has (players . witches . named callerName) (fromJust mGame) ] -rulesMessages :: Maybe Game -> [Text] -rulesMessages mGame = map (T.intercalate "\n") - [ [ T.unwords - [ "Each player is informed of their role (see `help roles` for a list) at the start of the" - , "game." - ] - , T.unwords - [ "Each night, the Werewolves transform and subsequently assault and devour one Villager." - , "After feasting, their lycanthropic form subsides and they once again hide in plain" - , "sight." - ] - , T.unwords - [ "Each day, after discovering the victim, the village gathers in the town square. In a" - , "democratic fashion they then vote for whom they believe to be a Werewolf. The votee is" - , "immediately tied to a pyre and burned alive in an attempt to rid Fougères of all" - , "lupines." - ] - ] - , filter (/= "") - [ "A game begins at night and follows a standard cycle." - , "- The village falls asleep." - , whenRoleInPlay mGame orphanRole - "- (First round only) the Orphan wakes up and chooses a role model." - , whenRoleInPlay mGame villageDrunkRole - "- (Third round only) the Village Drunk sobers up and remembers their allegiance." - , whenRoleInPlay mGame seerRole - "- The Seer wakes up and sees someone's allegiance." - , whenRoleInPlay mGame oracleRole - "- The Oracle wakes up and divines someone's role." - , whenRoleInPlay mGame protectorRole - "- The Protector wakes up and protects someone." - , "- The Werewolves wake up and vote to devour a victim." - , whenRoleInPlay mGame witchRole - "- The Witch wakes up and may heal the victim and/or poison someone." - , "- The village wakes up and find the victim." - , whenRoleInPlay mGame hunterRole - "- (When the Hunter is killed) the Hunter chooses someone to shoot." - , whenRoleInPlay mGame druidRole - "- Ferina grunts if the Druid is next to a Werewolf." - , "- The village votes to lynch a suspect." - , whenRoleInPlay mGame hunterRole - "- (When the Hunter is killed) the Hunter chooses someone to shoot." - , whenRoleInPlay mGame scapegoatRole - "- (When the Scapegoat is blamed) the Scapegoat chooses whom may vote on the next day." - , T.concat - [ "The game is over when only Villagers or Werewolves are left alive" - , ifRoleInPlay mGame fallenAngelRole - ", or when one of the Loners completes their own objective." - "." - ] - ] +rulesMessages :: Text -> Maybe Game -> [Message] +rulesMessages callerName mGame = + [ rulesMessage callerName + , stagesMessage callerName mGame ] -helpMessages :: [Text] -helpMessages = map (T.intercalate "\n") - [ [ T.unwords - [ "Long has the woods been home to wild creatures, both kind and cruel. Most have faces and" - , "are known to the inhabitants of Fougères in Brittany, France; but no-one from the" - , "village has yet to lay eyes on the merciless Werewolf." - ] - , T.unwords - [ "Each night Werewolves attack the village and devour the innocent. For centuries no-one" - , "knew how to fight this scourge, however recently a theory has taken ahold that mayhaps" - , "the Werewolves walk among the Villagers themselves..." - ] - ] - , [ "Help commands:" - , "- `help commands [-a | --all]`" - , "- `help roles [-a | --all]`" - , "- `help rules [-a | --all]`" - ] +helpMessages :: Text -> [Message] +helpMessages callerName = + [ gameDescriptionMessage callerName + , helpCommandsMessage callerName ] -whenPlayerHasRole :: Monoid m => Text -> Maybe Game -> Role -> m -> m -whenPlayerHasRole _ Nothing _ m = m -whenPlayerHasRole callerName (Just game) role' m - | hasn't (players . traverse . named callerName) game = mempty - | hasn't (role . only role') player = mempty - | otherwise = m - where - player = game ^?! players . traverse . named callerName - -ifRoleInPlay :: Maybe Game -> Role -> a -> a -> a -ifRoleInPlay Nothing _ true _ = true -ifRoleInPlay (Just game) role' true false - | has (players . roles . only role') game = true - | otherwise = false +getGame :: MonadIO m => Text -> Bool -> m (Maybe Game) +getGame _ True = return Nothing +getGame tag _ = do + game <- readGame tag -whenRoleInPlay :: Monoid m => Maybe Game -> Role -> m -> m -whenRoleInPlay mGame role m = ifRoleInPlay mGame role m mempty + return $ case game ^. variant of + NoRoleKnowledge -> Nothing + _ -> Just game diff --git a/app/Werewolf/Command/Pass.hs b/app/Werewolf/Command/Pass.hs --- a/app/Werewolf/Command/Pass.hs +++ b/app/Werewolf/Command/Pass.hs @@ -26,8 +26,8 @@ import Game.Werewolf.Command import Game.Werewolf.Command.Witch import Game.Werewolf.Engine +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System handle :: (MonadIO m, MonadRandom m) => Text -> Text -> m () diff --git a/app/Werewolf/Command/Ping.hs b/app/Werewolf/Command/Ping.hs --- a/app/Werewolf/Command/Ping.hs +++ b/app/Werewolf/Command/Ping.hs @@ -24,8 +24,8 @@ import Game.Werewolf import Game.Werewolf.Command import Game.Werewolf.Command.Status +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System handle :: MonadIO m => Text -> Text -> m () diff --git a/app/Werewolf/Command/Poison.hs b/app/Werewolf/Command/Poison.hs --- a/app/Werewolf/Command/Poison.hs +++ b/app/Werewolf/Command/Poison.hs @@ -29,8 +29,8 @@ import Game.Werewolf.Command import Game.Werewolf.Command.Witch import Game.Werewolf.Engine +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System data Options = Options diff --git a/app/Werewolf/Command/Protect.hs b/app/Werewolf/Command/Protect.hs --- a/app/Werewolf/Command/Protect.hs +++ b/app/Werewolf/Command/Protect.hs @@ -29,8 +29,8 @@ import Game.Werewolf.Command import Game.Werewolf.Command.Protector import Game.Werewolf.Engine +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System data Options = Options diff --git a/app/Werewolf/Command/Quit.hs b/app/Werewolf/Command/Quit.hs --- a/app/Werewolf/Command/Quit.hs +++ b/app/Werewolf/Command/Quit.hs @@ -26,8 +26,8 @@ import Game.Werewolf.Command import Game.Werewolf.Command.Global import Game.Werewolf.Engine +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System handle :: (MonadIO m, MonadRandom m) => Text -> Text -> m () diff --git a/app/Werewolf/Command/See.hs b/app/Werewolf/Command/See.hs --- a/app/Werewolf/Command/See.hs +++ b/app/Werewolf/Command/See.hs @@ -29,8 +29,8 @@ import Game.Werewolf.Command import Game.Werewolf.Command.Seer import Game.Werewolf.Engine +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System data Options = Options diff --git a/app/Werewolf/Command/Start.hs b/app/Werewolf/Command/Start.hs --- a/app/Werewolf/Command/Start.hs +++ b/app/Werewolf/Command/Start.hs @@ -11,7 +11,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} module Werewolf.Command.Start ( -- * Options @@ -22,36 +21,34 @@ ) where import Control.Lens +import Control.Lens.Extra import Control.Monad.Except import Control.Monad.Extra import Control.Monad.Random import Control.Monad.State import Control.Monad.Writer -import Data.List -import Data.Text (Text) -import qualified Data.Text as T +import Data.Text (Text) import Game.Werewolf import Game.Werewolf.Engine -import Game.Werewolf.Role as Role +import Game.Werewolf.Message.Error import System.Random.Shuffle -import Werewolf.Messages import Werewolf.System data Options = Options - { optExtraRoles :: ExtraRoles - , optIncludeSeer :: Bool - , argPlayers :: [Text] + { optExtraRoles :: ExtraRoles + , optVariant :: Variant + , argPlayers :: [Text] } deriving (Eq, Show) data ExtraRoles = None | Random | Use [Text] deriving (Eq, Show) handle :: (MonadIO m, MonadRandom m) => Text -> Text -> Options -> m () -handle callerName tag (Options extraRoles includeSeer playerNames) = do +handle callerName tag (Options extraRoles variant playerNames) = do whenM (doesGameExist tag &&^ (hasn't (stage . _GameOver) <$> readGame tag)) $ exitWith failure { messages = [gameAlreadyRunningMessage callerName] } @@ -62,12 +59,11 @@ Random -> randomExtraRoles $ length playerNames Use roleNames -> useExtraRoles callerName roleNames - let extraRoles'' = if includeSeer then nub (seerRole:extraRoles') else extraRoles' - let roles = padRoles extraRoles'' (length playerNames + 1) + let roles = padRoles extraRoles' (length playerNames + 1) players <- createPlayers (callerName:playerNames) <$> shuffleM roles - runWriterT $ startGame callerName players >>= execStateT checkStage + runWriterT $ startGame callerName variant players >>= execStateT checkStage case result of Left errorMessages -> exitWith failure { messages = errorMessages } @@ -83,14 +79,12 @@ take count <$> shuffleM restrictedRoles useExtraRoles :: MonadError [Message] m => Text -> [Text] -> m [Role] -useExtraRoles callerName roleNames = forM roleNames $ \roleName -> case findByName roleName of +useExtraRoles callerName roleNames = forM roleNames $ \roleName -> case findByTag roleName of Just role -> return role Nothing -> throwError [roleDoesNotExistMessage callerName roleName] -findByName :: Text -> Maybe Role -findByName name' = restrictedRoles ^? traverse . filtered ((sanitise name' ==) . T.toLower . sanitise . view Role.name) - where - sanitise = T.replace " " "-" +findByTag :: Text -> Maybe Role +findByTag tag' = restrictedRoles ^? traverse . filteredBy tag tag' padRoles :: [Role] -> Int -> [Role] padRoles roles n = roles ++ simpleVillagerRoles ++ simpleWerewolfRoles diff --git a/app/Werewolf/Command/Status.hs b/app/Werewolf/Command/Status.hs --- a/app/Werewolf/Command/Status.hs +++ b/app/Werewolf/Command/Status.hs @@ -24,8 +24,8 @@ import Game.Werewolf import Game.Werewolf.Command import Game.Werewolf.Command.Status +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System handle :: MonadIO m => Text -> Text -> m () diff --git a/app/Werewolf/Command/Unvote.hs b/app/Werewolf/Command/Unvote.hs --- a/app/Werewolf/Command/Unvote.hs +++ b/app/Werewolf/Command/Unvote.hs @@ -28,9 +28,8 @@ import Game.Werewolf.Command.Villager as Villager import Game.Werewolf.Command.Werewolf as Werewolf import Game.Werewolf.Engine -import Game.Werewolf.Messages +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System handle :: (MonadIO m, MonadRandom m) => Text -> Text -> m () diff --git a/app/Werewolf/Command/Version.hs b/app/Werewolf/Command/Version.hs --- a/app/Werewolf/Command/Version.hs +++ b/app/Werewolf/Command/Version.hs @@ -19,9 +19,7 @@ import Data.Text (Text) import Game.Werewolf - -import Werewolf.Messages -import Werewolf.Version +import Game.Werewolf.Message.Command handle :: MonadIO m => Text -> m () -handle callerName = exitWith success { messages = [engineVersionMessage callerName version] } +handle callerName = exitWith success { messages = [engineVersionMessage callerName] } diff --git a/app/Werewolf/Command/Vote.hs b/app/Werewolf/Command/Vote.hs --- a/app/Werewolf/Command/Vote.hs +++ b/app/Werewolf/Command/Vote.hs @@ -31,9 +31,8 @@ import Game.Werewolf.Command.Villager as Villager import Game.Werewolf.Command.Werewolf as Werewolf import Game.Werewolf.Engine -import Game.Werewolf.Messages +import Game.Werewolf.Message.Error -import Werewolf.Messages import Werewolf.System data Options = Options diff --git a/app/Werewolf/Messages.hs b/app/Werewolf/Messages.hs deleted file mode 100644 --- a/app/Werewolf/Messages.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-| -Module : Werewolf.Messages -Description : Suite of messages used when calling the binary. - -Copyright : (c) Henry J. Wylde, 2016 -License : BSD3 -Maintainer : public@hjwylde.com - -Suite of messages used when calling the binary. --} - -{-# LANGUAGE OverloadedStrings #-} - -module Werewolf.Messages ( - -- * Binary messages - engineVersionMessage, - - -- ** Error messages - noGameRunningMessage, gameAlreadyRunningMessage, roleDoesNotExistMessage, -) where - -import Data.Text (Text) -import qualified Data.Text as T -import Data.Version - -import Game.Werewolf - -engineVersionMessage :: Text -> Version -> Message -engineVersionMessage to version = - privateMessage to $ T.unwords ["Version", T.pack $ showVersion version] - -noGameRunningMessage :: Text -> Message -noGameRunningMessage to = privateMessage to "No game is running." - -gameAlreadyRunningMessage :: Text -> Message -gameAlreadyRunningMessage to = privateMessage to "A game is already running." - -roleDoesNotExistMessage :: Text -> Text -> Message -roleDoesNotExistMessage to name = privateMessage to $ T.unwords ["Role", name, "does not exist."] diff --git a/app/Werewolf/Options.hs b/app/Werewolf/Options.hs --- a/app/Werewolf/Options.hs +++ b/app/Werewolf/Options.hs @@ -23,11 +23,15 @@ import qualified Data.Text as T import Data.Version (showVersion) +import Game.Werewolf (Variant (..)) + +import Options.Applicative +import Options.Applicative.Types + 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.Divine as Divine -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 @@ -37,8 +41,6 @@ import qualified Werewolf.Command.Vote as Vote import qualified Werewolf.Version as This -import Options.Applicative - data Options = Options { optCaller :: Text , optTag :: Text @@ -50,7 +52,7 @@ | Choose Choose.Options | Circle Circle.Options | Divine Divine.Options - | End End.Options + | End | Heal | Help Help.Options | Interpret Interpret.Options @@ -134,11 +136,7 @@ divine = Divine . Divine.Options <$> playerArgument end :: Parser Command -end = End . End.Options - <$> switch (mconcat - [ long "force", short 'f' - , help "Force the game to end" - ]) +end = pure End heal :: Parser Command heal = pure Heal @@ -178,12 +176,18 @@ start :: Parser Command start = fmap Start $ Start.Options <$> (extraRolesOption <|> randomExtraRolesOption) - <*> switch (mconcat - [ long "include-seer" - , help "Always include the Seer" + <*> variantOption (mconcat [ + long "variant", short 'v', metavar "VARIANT", + value Standard, showDefaultWith $ const "standard", + help "Specify the game variant" ]) <*> some (T.pack <$> strArgument (metavar "PLAYER...")) where + variantOption = option $ readerAsk >>= \opt -> case opt of + "standard" -> return Standard + "no-role-knowledge" -> return NoRoleKnowledge + _ -> readerError $ "unrecognised variant `" ++ opt ++ "'" + extraRolesOption = fmap (Start.Use . filter (/= T.empty) . T.splitOn "," . T.pack) (strOption $ mconcat [ long "extra-roles", short 'e', metavar "ROLE,..." , value [] diff --git a/app/Werewolf/System.hs b/app/Werewolf/System.hs --- a/app/Werewolf/System.hs +++ b/app/Werewolf/System.hs @@ -11,7 +11,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} module Werewolf.System ( -- * Game @@ -24,7 +23,6 @@ ) where import Control.Lens hiding (cons) -import Control.Lens.Extra import Control.Monad.Except import Control.Monad.Writer @@ -33,24 +31,23 @@ import qualified Data.Text as T import Game.Werewolf -import Game.Werewolf.Messages -import Game.Werewolf.Role as Role +import Game.Werewolf.Message.Engine +import Game.Werewolf.Message.Error import Prelude hiding (round) import System.Directory import System.FilePath -startGame :: (MonadError [Message] m, MonadWriter [Message] m) => Text -> [Player] -> m Game -startGame callerName players = do - -- TODO (hjw): move the messages to Messages - when (playerNames /= nub playerNames) $ throwError [privateMessage callerName "Player names must be unique."] - when (length players < 7) $ throwError [privateMessage callerName "Must have at least 7 players."] - forM_ restrictedRoles $ \role' -> - when (length (players ^.. traverse . filteredBy role role') > 1) $ - throwError [privateMessage callerName $ T.concat ["Cannot have more than 1 ", role' ^. Role.name, "."]] +startGame :: (MonadError [Message] m, MonadWriter [Message] m) => Text -> Variant -> [Player] -> m Game +startGame callerName variant players = do + when (playerNames /= nub playerNames) $ throwError [playerNamesMustBeUniqueMessage callerName] + when (length players < 7) $ throwError [mustHaveAtLeast7PlayersMessage callerName] + forM_ restrictedRoles $ \role -> + when (length (players ^.. roles . only role) > 1) $ + throwError [roleCountRestrictedMessage callerName role] - let game = newGame players + let game = newGame variant players tell $ newGameMessages game diff --git a/src/Data/String/Humanise.hs b/src/Data/String/Humanise.hs --- a/src/Data/String/Humanise.hs +++ b/src/Data/String/Humanise.hs @@ -9,12 +9,23 @@ Humanise type class for displaying data structures to a human. -} +{-# LANGUAGE OverloadedStrings #-} + module Data.String.Humanise ( -- * Humanise Humanise(..), ) where -import Data.String +import Data.Text (Text) +import qualified Data.Text as T class Humanise a where - humanise :: IsString b => a -> b + humanise :: a -> Text + +instance Humanise Text where + humanise = id + +instance Humanise a => Humanise [a] where + humanise [] = "" + humanise [word] = humanise word + humanise words = T.unwords [T.intercalate ", " (map humanise $ init words), "and", humanise $ last words] diff --git a/src/Data/String/Interpolate/Extra.hs b/src/Data/String/Interpolate/Extra.hs new file mode 100644 --- /dev/null +++ b/src/Data/String/Interpolate/Extra.hs @@ -0,0 +1,22 @@ +{-| +Module : Data.String.Interpolate.Extra +Description : Extra utility functions for working with the interpolate Quasi Quoter. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +Extra utility functions for working with the interpolate Quasi Quoter. +-} + +module Data.String.Interpolate.Extra ( + -- * Quasi Quoters + iFile, +) where + +import Data.String.Interpolate.IsString + +import Language.Haskell.TH.Quote + +iFile :: QuasiQuoter +iFile = quoteFile i diff --git a/src/Game/Werewolf/Game.hs b/src/Game/Werewolf/Game.hs --- a/src/Game/Werewolf/Game.hs +++ b/src/Game/Werewolf/Game.hs @@ -10,18 +10,22 @@ structure and any fields required to keep track of the current state. -} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TemplateHaskell #-} module Game.Werewolf.Game ( -- * Game Game, - stage, round, players, boots, allowedVoters, divine, fallenAngelLynched, healUsed, + variant, stage, round, players, boots, allowedVoters, divine, fallenAngelLynched, healUsed, hunterRetaliated, jesterRevealed, passed, poison, poisonUsed, priorProtect, protect, roleModel, scapegoatBlamed, see, votes, + Variant(..), + _Standard, _NoRoleKnowledge, + Stage(..), - _FerinasGrunt, _GameOver, _HuntersTurn1, _HuntersTurn2, _Lynching, _OraclesTurn, _OrphansTurn, + _DruidsTurn, _GameOver, _HuntersTurn1, _HuntersTurn2, _Lynching, _OraclesTurn, _OrphansTurn, _ProtectorsTurn, _ScapegoatsTurn, _SeersTurn, _Sunrise, _Sunset, _VillageDrunksTurn, _VillagesTurn, _WerewolvesTurn, _WitchsTurn, @@ -50,7 +54,6 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe -import Data.String import Data.String.Humanise import Data.Text (Text) @@ -68,7 +71,8 @@ -- Some of the additional fields are reset each round (e.g., the Seer's 'see') while others are -- kept around for the whole game (e.g., the Orphan's 'roleModel'). data Game = Game - { _stage :: Stage + { _variant :: Variant + , _stage :: Stage , _round :: Int , _players :: [Player] , _boots :: Map Text [Text] @@ -89,37 +93,46 @@ , _votes :: Map Text Text -- ^ Villagers and Werewolves } deriving (Eq, Read, Show) +data Variant = Standard | NoRoleKnowledge + deriving (Eq, Read, Show) + +instance Humanise Variant where + humanise Standard = "standard" + humanise NoRoleKnowledge = "no role knowledge" + -- | Most of these are fairly self-explainable (the turn stages). 'Sunrise' and 'Sunset' are -- provided as meaningful breaks between the day and night as, for example, a 'VillagesTurn' may -- not always be available (curse that retched Scapegoat). -- -- Once the game reaches a turn stage, it requires a /command/ to help push it past. Often only -- certain roles and commands may be performed at any given stage. -data Stage = FerinasGrunt | GameOver | HuntersTurn1 | HuntersTurn2 | Lynching | OraclesTurn +data Stage = DruidsTurn | GameOver | HuntersTurn1 | HuntersTurn2 | Lynching | OraclesTurn | OrphansTurn | ProtectorsTurn | ScapegoatsTurn | SeersTurn | Sunrise | Sunset | VillageDrunksTurn | VillagesTurn | WerewolvesTurn | WitchsTurn deriving (Eq, Read, Show) instance Humanise Stage where - humanise FerinasGrunt = fromString "Ferina's Grunt" - humanise GameOver = fromString "Game over" - humanise HuntersTurn1 = fromString "Hunter's turn" - humanise HuntersTurn2 = fromString "Hunter's turn" - humanise Lynching = fromString "Lynching" - humanise OraclesTurn = fromString "Oracle's turn" - humanise OrphansTurn = fromString "Orphan's turn" - humanise ProtectorsTurn = fromString "Protector's turn" - humanise ScapegoatsTurn = fromString "Scapegoat's turn" - humanise SeersTurn = fromString "Seer's turn" - humanise Sunrise = fromString "Sunrise" - humanise Sunset = fromString "Sunset" - humanise VillageDrunksTurn = fromString "Village Drunk's turn" - humanise VillagesTurn = fromString "village's turn" - humanise WerewolvesTurn = fromString "Werewolves' turn" - humanise WitchsTurn = fromString "Witch's turn" + humanise DruidsTurn = "Druid's turn" + humanise GameOver = "Game over" + humanise HuntersTurn1 = "Hunter's turn" + humanise HuntersTurn2 = "Hunter's turn" + humanise Lynching = "Lynching" + humanise OraclesTurn = "Oracle's turn" + humanise OrphansTurn = "Orphan's turn" + humanise ProtectorsTurn = "Protector's turn" + humanise ScapegoatsTurn = "Scapegoat's turn" + humanise SeersTurn = "Seer's turn" + humanise Sunrise = "Sunrise" + humanise Sunset = "Sunset" + humanise VillageDrunksTurn = "Village Drunk's turn" + humanise VillagesTurn = "village's turn" + humanise WerewolvesTurn = "Werewolves' turn" + humanise WitchsTurn = "Witch's turn" makeLenses ''Game +makePrisms ''Variant + makePrisms ''Stage -- | All of the 'Stage's in the order that they should occur. @@ -135,7 +148,7 @@ , WitchsTurn , Sunrise , HuntersTurn2 - , FerinasGrunt + , DruidsTurn , VillagesTurn , Lynching , HuntersTurn1 @@ -153,7 +166,7 @@ -- One of the more complex checks here is for the 'VillagesTurn'. If the Fallen Angel is in play, -- then the 'VillagesTurn' is available on the first day rather than only after the first night. stageAvailable :: Game -> Stage -> Bool -stageAvailable game FerinasGrunt = has (players . druids . alive) game +stageAvailable game DruidsTurn = has (players . druids . alive) game stageAvailable _ GameOver = False stageAvailable game HuntersTurn1 = has (players . hunters . dead) game @@ -182,9 +195,10 @@ -- | Creates a new 'Game' with the given players. No validations are performed here, those are left -- to the binary. -newGame :: [Player] -> Game -newGame players = Game - { _stage = head stageCycle +newGame :: Variant -> [Player] -> Game +newGame variant players = Game + { _variant = variant + , _stage = head stageCycle , _round = 0 , _players = players , _boots = Map.empty diff --git a/src/Game/Werewolf/Player.hs b/src/Game/Werewolf/Player.hs --- a/src/Game/Werewolf/Player.hs +++ b/src/Game/Werewolf/Player.hs @@ -27,7 +27,7 @@ alphaWolf, beholder, crookedSenator, druid, fallenAngel, hunter, jester, lycan, medusa, oracle, orphan, protector, scapegoat, seer, simpleVillager, simpleWerewolf, spitefulGhost, trueVillager, villageDrunk, witch, - villager, werewolf, + loner, villager, werewolf, -- | The following traversals are provided just as a bit of sugar to avoid continually writing -- @'traverse' .@. @@ -38,7 +38,7 @@ alphaWolves, beholders, crookedSenators, druids, fallenAngels, hunters, jesters, lycans, medusas, oracles, orphans, protectors, scapegoats, seers, simpleVillagers, simpleWerewolves, spitefulGhosts, trueVillagers, villageDrunks, witches, - villagers, werewolves, + loners, villagers, werewolves, alive, dead, ) where @@ -46,7 +46,6 @@ import Control.Lens.Extra import Data.Function -import Data.String import Data.String.Humanise import Data.Text as T @@ -72,7 +71,7 @@ (==) = (==) `on` view name instance Humanise Player where - humanise player = fromString . T.unpack $ player ^. name + humanise = view name makePrisms ''State @@ -242,6 +241,14 @@ witch :: Traversal' Player () witch = role . only witchRole +-- | The traversal of 'Player's aligned with 'NoOne'. +-- +-- @ +-- 'loner' = 'role' . 'allegiance' . '_NoOne' +-- @ +loner :: Traversal' Player () +loner = role . allegiance . _NoOne + -- | The traversal of 'Player's aligned with the 'Villagers'. -- -- @ @@ -449,6 +456,14 @@ -- @ witches :: Traversable t => Traversal' (t Player) Player witches = traverse . filtered (is witch) + +-- | This 'Traversal' provides the traversal of 'loner' 'Player's. +-- +-- @ +-- 'loners' = 'traverse' . 'filtered' . ('is' 'loner') +-- @ +loners :: Traversable t => Traversal' (t Player) Player +loners = traverse . filtered (is loner) -- | This 'Traversal' provides the traversal of 'villager' 'Player's. -- diff --git a/src/Game/Werewolf/Role.hs b/src/Game/Werewolf/Role.hs --- a/src/Game/Werewolf/Role.hs +++ b/src/Game/Werewolf/Role.hs @@ -15,13 +15,13 @@ -} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} module Game.Werewolf.Role ( -- * Role Role, - name, allegiance, balance, description, rules, + tag, name, allegiance, balance, description, rules, Allegiance(..), _NoOne, _Villagers, _Werewolves, @@ -60,12 +60,11 @@ import Control.Lens -import Data.Function -import Data.List -import Data.String -import Data.String.Humanise -import Data.Text (Text) -import qualified Data.Text as T +import Data.Function +import Data.List +import Data.String.Humanise +import Data.String.Interpolate.Extra +import Data.Text as T -- | Role definitions require only a few pieces of information. -- @@ -73,10 +72,11 @@ -- Werewolf has a balance of -4 while the Seer has a balance of 2. A balance of 0 means it favours -- neither allegiance. -- --- N.B., role equality is defined on just the 'name' as a role's 'allegiance' may change --- throughout the game. +-- N.B., role equality is defined on just the 'tag' as a role's 'allegiance' may change throughout +-- the game. data Role = Role - { _name :: Text + { _tag :: Text + , _name :: Text , _allegiance :: Allegiance , _balance :: Int , _description :: Text @@ -89,17 +89,17 @@ deriving (Eq, Read, Show) instance Humanise Allegiance where - humanise NoOne = fromString "no-one" - humanise Villagers = fromString "Villagers" - humanise Werewolves = fromString "Werewolves" + humanise NoOne = "no-one" + humanise Villagers = "Villagers" + humanise Werewolves = "Werewolves" makeLenses ''Role instance Eq Role where - (==) = (==) `on` view name + (==) = (==) `on` view tag instance Humanise Role where - humanise role = fromString . T.unpack $ role ^. name + humanise = view name makePrisms ''Allegiance @@ -148,23 +148,12 @@ -- Orphan becomes a Werewolf. orphanRole :: Role orphanRole = Role - { _name = "Orphan" + { _tag = "orphan" + , _name = T.strip [iFile|variant/standard/role/orphan/name.txt|] , _allegiance = Villagers , _balance = -1 - , _description = T.unwords - [ "Abandoned by their parents as a child, with no-one wanting to look after another mouth" - , "to feed, the Orphan was left to fend for themself. No-one looked twice at the Orphan and" - , "even fewer showed kindness towards the lonely child. One day however, one townsperson" - , "changed all this. He offered the Orphan food, water and a roof over their head. Grateful" - , "for his chairty and affection, the Orphan made him their role model. Pray that no ill" - , "should befall their role model, for they are the only one conforming the Orphan as a" - , "Villager." - ] - , _rules = T.unwords - [ "On the first night, the Orphan chooses a player to become their role model. So long as" - , "the role model is alive, the Orphan is a Villager. If however the role model is" - , "eliminated, then the Orphan becomes a Werewolf." - ] + , _description = T.strip [iFile|variant/standard/role/orphan/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/orphan/rules.txt|] } -- | /Hah, maybe not as liked as the Jester, but the Drunk sure does their fair share of stupid/ @@ -179,23 +168,12 @@ -- Villagers or Werewolves. villageDrunkRole :: Role villageDrunkRole = Role - { _name = "Village Drunk" + { _tag = "village-drunk" + , _name = T.strip [iFile|variant/standard/role/village-drunk/name.txt|] , _allegiance = Villagers , _balance = -1 - , _description = T.unwords - [ "Hah, maybe not as liked as the Jester, but the Drunk sure does their fair share of" - , "stupid things in the night! No-one knows if they even actually make it home; sometimes" - , "people see them sleeping outside the Blacksmith's home, others say they see them" - , "wandering towards the woods. It's pointless quizzing the Village Drunk in the morning" - , "about their doings; they can never remember what they did!" - ] - , _rules = T.intercalate "\n" - [ "The Village Drunk is initially aligned with the Villagers." - , T.unwords - [ "On the third night the Village Drunk sobers up and is randomly assigned a new" - , "alignment, either Villagers or Werewolves." - ] - ] + , _description = T.strip [iFile|variant/standard/role/village-drunk/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/village-drunk/rules.txt|] } -- | /Long ago during the War in Heaven, angels fell from the sky as one by one those that followed/ @@ -208,20 +186,12 @@ -- game. fallenAngelRole :: Role fallenAngelRole = Role - { _name = "Fallen Angel" + { _tag = "fallen-angel" + , _name = T.strip [iFile|variant/standard/role/fallen-angel/name.txt|] , _allegiance = NoOne , _balance = 0 - , _description = T.unwords - [ "Long ago during the War in Heaven, angels fell from the sky as one by one those that" - , "followed Lucifer were defeated. For centuries they lived amongst mortal Villagers as" - , "punishment for their sins and wrongdoings. The Fallen Angel was one such being and is" - , "now one of the few angels left on Earth. Nothing is worse punishment for them, the" - , "Fallen Angel yearns for death to once again be free!" - ] - , _rules = T.unwords - [ "The Fallen Angel wins if they manage to get lynched by the Villagers before the end of" - , "the game." - ] + , _description = T.strip [iFile|variant/standard/role/fallen-angel/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/fallen-angel/rules.txt|] } -- | /In this time of turmoil, it would seem unlikely for the Villagers of Fougères to unanimously/ @@ -233,20 +203,12 @@ -- may haunt the village as they wish. spitefulGhostRole :: Role spitefulGhostRole = Role - { _name = "Spiteful Ghost" + { _tag = "spiteful-ghost" + , _name = T.strip [iFile|variant/standard/role/spiteful-ghost/name.txt|] , _allegiance = NoOne , _balance = 0 - , _description = T.unwords - [ "In this time of turmoil, it would seem unlikely for the Villagers of Fougères to" - , "unanimously agree on anything. Yet this is not so, for they all agree the village is" - , "haunted by a ghost. The vindictive Spiteful Ghost never moved on, rather they remain" - , "with the sole purpose of haunting the village and ensuring that the Villagers never" - , "forget what they have done." - ] - , _rules = T.unwords - [ "The Spiteful ghost is dead and cannot win, however they know the game's role allocations" - , "and may haunt the village as they wish." - ] + , _description = T.strip [iFile|variant/standard/role/spiteful-ghost/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/spiteful-ghost/rules.txt|] } -- | /Awareness comes easy to the Beholder. They listen to their senses and trust their hunches./ @@ -257,16 +219,12 @@ -- At the start of the game the Beholder is informed the Seer's identity. beholderRole :: Role beholderRole = Role - { _name = "Beholder" + { _tag = "beholder" + , _name = T.strip [iFile|variant/standard/role/beholder/name.txt|] , _allegiance = Villagers , _balance = 1 - , _description = T.unwords - [ "Awareness comes easy to the Beholder. They listen to their senses and trust their" - , "hunches. Over the years the Beholder has grown to know a certain few of the village just" - , "by paying attention. Little cues here and there, the way someone talks, the way they" - , "move - it all gives clues as to their true nature and role." - ] - , _rules = "At the start of the game the Beholder is informed the Seer's identity." + , _description = T.strip [iFile|variant/standard/role/beholder/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/beholder/rules.txt|] } -- | /Never trust a politician. Nor a Crooked Senator for that matter. The Crooked Senator may seem/ @@ -277,16 +235,12 @@ -- The Crooked Senator looks at the village votes as they come in. crookedSenatorRole :: Role crookedSenatorRole = Role - { _name = "Crooked Senator" + { _tag = "crooked-senator" + , _name = T.strip [iFile|variant/standard/role/crooked-senator/name.txt|] , _allegiance = Villagers - , _balance = 1 - , _description = T.unwords - [ "Never trust a politician. Nor a Crooked Senator for that matter. The Crooked Senator may" - , "seem like he has the village's best interests at heart, but let's be honest, when put in" - , "a tough situation he looks after no-one but himself. Even when safe, the Crooked Senator" - , "may decide to toy with the Villagers' emotions and try pit them against one another." - ] - , _rules = "The Crooked Senator looks at the village votes as they come in." + , _balance = 2 + , _description = T.strip [iFile|variant/standard/role/crooked-senator/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/crooked-senator/rules.txt|] } -- | /How honoured we are to be in the presence of such a noble leader. The return of the Druid/ @@ -299,21 +253,12 @@ -- next to a Werewolf in the player `circle` then Ferina will grunt in warning. druidRole :: Role druidRole = Role - { _name = "Druid" + { _tag = "druid" + , _name = T.strip [iFile|variant/standard/role/druid/name.txt|] , _allegiance = Villagers , _balance = 3 - , _description = T.unwords - [ "How honoured we are to be in the presence of such a noble leader. The return of the" - , "Druid marks an exceptional time in Fougères's history! Friend of the woodland creatures," - , "practiced philosopher and now, with the help of Ferina their companion, a bane to the" - , "Werewolves themselves! My does she have a nose on her, strong enough to sniff out" - , "lycanthropes in close proximity! Listen for her grunt and heed her warning for she will" - , "not let you down." - ] - , _rules = T.unwords - [ "Each morning when Ferina wakes from her slumber she will be alert and cautious. If the" - , "Druid is next to a Werewolf in the player `circle` then Ferina will grunt in warning." - ] + , _description = T.strip [iFile|variant/standard/role/druid/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/druid/rules.txt|] } -- | /A skilled marksman with quick reflexes. In the unfortunate situation that they are jumped and/ @@ -324,18 +269,12 @@ -- immediately. hunterRole :: Role hunterRole = Role - { _name = "Hunter" + { _tag = "hunter" + , _name = T.strip [iFile|variant/standard/role/hunter/name.txt|] , _allegiance = Villagers , _balance = 2 - , _description = T.unwords - [ "A skilled marksman with quick reflexes. In the unfortunate situation that they are" - , "jumped and killed unjustly, they let off a shot at their attacker, killing them" - , "instantly. The Hunter never misses." - ] - , _rules = T.unwords - [ "If the Hunter is killed they choose one player, believed to be an attacker, to kill" - , "immediately." - ] + , _description = T.strip [iFile|variant/standard/role/hunter/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/hunter/rules.txt|] } -- | /Every village needs a Jester; they're so stupid, but provide so much entertainment! The/ @@ -348,21 +287,12 @@ -- The Jester continues to play but may no longer vote as no-one can take them seriously. jesterRole :: Role jesterRole = Role - { _name = "Jester" + { _tag = "jester" + , _name = T.strip [iFile|variant/standard/role/jester/name.txt|] , _allegiance = Villagers , _balance = 0 - , _description = T.unwords - [ "Every village needs a Jester; they're so stupid, but provide so much entertainment! The" - , "Jester may not have any special abilities, but at least no-one in the village wants to" - , "hurt them." - ] - , _rules = T.intercalate "\n" - [ T.unwords - [ "If the village votes to lynch the Jester, their identity is revealed. The village" - , "realise there's no point in burning them and so they are set free." - ] - , "The Jester continues to play but may no longer vote as no-one can take them seriously." - ] + , _description = T.strip [iFile|variant/standard/role/jester/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/jester/rules.txt|] } -- | /Traditionally a Werewolf once transformed loses all memories and personality. Over years of/ @@ -374,19 +304,12 @@ -- a Werewolf. lycanRole :: Role lycanRole = Role - { _name = "Lycan" + { _tag = "lycan" + , _name = T.strip [iFile|variant/standard/role/lycan/name.txt|] , _allegiance = Villagers , _balance = 0 - , _description = T.unwords - [ "Traditionally a Werewolf once transformed loses all memories and personality. Over years" - , "of transforming, the Lycan has slowly evolved and learnt how to retain themself. Night" - , "after night of devouring with the other Werewolves took its toll. The screams alone were" - , "enough to turn the Lycan and make them question their true nature." - ] - , _rules = T.unwords - [ "The Lycan is aligned with the Villagers, but appears to nature-seeing roles (e.g., the" - , "Seer) as a Werewolf." - ] + , _description = T.strip [iFile|variant/standard/role/lycan/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/lycan/rules.txt|] } -- | /A beautiful flirt, the Medusa is aligned with the Villagers but harbours a terrifying secret./ @@ -400,22 +323,12 @@ -- instantly killing the lupine predator. medusaRole :: Role medusaRole = Role - { _name = "Medusa" + { _tag = "medusa" + , _name = T.strip [iFile|variant/standard/role/medusa/name.txt|] , _allegiance = Villagers , _balance = 3 - , _description = T.unwords - [ "A beautiful flirt, the Medusa is aligned with the Villagers but harbours a terrifying" - , "secret. During the day they are well known in the village of Fougères for their stunning" - , "appearance which captures the eye and love of all the townsfolk. However when their" - , "secret takes ahold at sundown, their true self is revealed. Any who gaze upon her true" - , "form would see live snakes for hair and the few that further look into her eyes are" - , "turned to stone." - ] - , _rules = T.unwords - [ "If Medusa attracts the attention of a Werewolf during the night and is devoured, the" - , "first Werewolf to their left in the player `circle` will catch their gaze and turn to" - , "stone, instantly killing the lupine predator." - ] + , _description = T.strip [iFile|variant/standard/role/medusa/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/medusa/rules.txt|] } -- | /Originally rejected by the townsfolk, the Oracle's prophetic divinations has earned trust/ @@ -426,19 +339,12 @@ -- the following morning. This wisdom is for the Oracle to use to ensure the future of Fougères. oracleRole :: Role oracleRole = Role - { _name = "Oracle" + { _tag = "oracle" + , _name = T.strip [iFile|variant/standard/role/oracle/name.txt|] , _allegiance = Villagers , _balance = 2 - , _description = T.unwords - [ "Originally rejected by the townsfolk, the Oracle's prophetic divinations has earned" - , "trust within the village. With constant precognition - and concern for the future - the" - , "Oracle knows the village will only live if they work together." - ] - , _rules = T.unwords - [ "Each night the Oracle chooses a player to divine. They are then informed of the player's" - , "role the following morning. This wisdom is for the Oracle to use to ensure the future of" - , "Fougères." - ] + , _description = T.strip [iFile|variant/standard/role/oracle/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/oracle/rules.txt|] } -- | /The Protector is one of the few pure of heart and altruistic Villagers; they are forever/ @@ -451,21 +357,12 @@ -- The Protector may not protect the same player two nights in a row. protectorRole :: Role protectorRole = Role - { _name = "Protector" + { _tag = "protector" + , _name = T.strip [iFile|variant/standard/role/protector/name.txt|] , _allegiance = Villagers , _balance = 2 - , _description = T.unwords - [ "The Protector is one of the few pure of heart and altruistic Villagers; they are forever" - , "putting others needs above their own. Each night they fight against the Werewolves with" - , "naught but a sword and shield, potentially saving an innocents life." - ] - , _rules = T.intercalate "\n" - [ T.unwords - [ "Each night the Protector chooses a player deemed worthy of their protection. That" - , "player is safe for that night (and only that night) against the Werewolves." - ] - , "The Protector may not protect the same player two nights in a row." - ] + , _description = T.strip [iFile|variant/standard/role/protector/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/protector/rules.txt|] } -- | /Werewolves don't just spring up out of the ground! That's where dwarves come from. Clearly/ @@ -478,25 +375,12 @@ -- to vote or not on the next day. scapegoatRole :: Role scapegoatRole = Role - { _name = "Scapegoat" + { _tag = "scapegoat" + , _name = T.strip [iFile|variant/standard/role/scapegoat/name.txt|] , _allegiance = Villagers , _balance = 0 - , _description = T.unwords - [ "Werewolves don't just spring up out of the ground! That's where dwarves come from." - , "Clearly someone is to blame for this affliction to Fougères. Unluckily for the" - , "Scapegoat, since no-one actually knows who brought them here, the blame is always laid" - , "upon them!" - ] - , _rules = T.intercalate "\n" - [ T.unwords - [ "If the village's vote ends in a tie, it's the Scapegoat who is eliminated instead of" - , "no-one." - ] - , T.unwords - [ "In this event, the Scapegoat has one last task to complete: they must choose whom is" - , "permitted to vote or not on the next day." - ] - ] + , _description = T.strip [iFile|variant/standard/role/scapegoat/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/scapegoat/rules.txt|] } -- | /The Seer has the ability to see into fellow townsfolk and determine their true nature. This/ @@ -506,19 +390,12 @@ -- Each night the Seer sees the allegiance of one player of their choice. seerRole :: Role seerRole = Role - { _name = "Seer" + { _tag = "seer" + , _name = T.strip [iFile|variant/standard/role/seer/name.txt|] , _allegiance = Villagers , _balance = 2 - , _description = T.unwords - [ "The Seer has the ability to see into fellow townsfolk and determine their true nature." - , "This ability to see is not given out lightly, for certain it is a gift! The visions will" - , "always be true, but only for the present as not even the Seer knows what the future" - , "holds." - ] - , _rules = T.unwords - [ "Each night the Seer chooses a player to see. They are then informed of the player's" - , "allegiance the following morning." - ] + , _description = T.strip [iFile|variant/standard/role/seer/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/seer/rules.txt|] } -- | /A simple, ordinary townsperson in every way. Some may be cobblers, others bakers or even/ @@ -529,18 +406,12 @@ -- them is not who they say they are. simpleVillagerRole :: Role simpleVillagerRole = Role - { _name = "Simple Villager" + { _tag = "simple-villager" + , _name = T.strip [iFile|variant/standard/role/simple-villager/name.txt|] , _allegiance = Villagers , _balance = 1 - , _description = T.unwords - [ "A simple, ordinary townsperson in every way. Some may be cobblers, others bakers or even" - , "nobles. No matter their differences though, the plight of Werewolves in Fougères unites" - , "all the Villagers in this unfortunate time." - ] - , _rules = T.unwords - [ "The Simple Villager has no special abilities, they must use their guile to determine" - , "whom among them is not who they say they are." - ] + , _description = T.strip [iFile|variant/standard/role/simple-villager/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/simple-villager/rules.txt|] } -- | /The True Villager has a heart and soul as clear as day! Their allegiance and devotion to the/ @@ -550,15 +421,12 @@ -- At the start of the game the True Villager's identity is revealed. trueVillagerRole :: Role trueVillagerRole = Role - { _name = "True Villager" + { _tag = "true-villager" + , _name = T.strip [iFile|variant/standard/role/true-villager/name.txt|] , _allegiance = Villagers , _balance = 2 - , _description = T.unwords - [ "The True Villager has a heart and soul as clear as day! Their allegiance and devotion to" - , "the village are beyond reproach. If there is one person whom you should confide in," - , "listen to and trust, it is the True Villager." - ] - , _rules = "At the start of the game the True Villager's identity is revealed." + , _description = T.strip [iFile|variant/standard/role/true-villager/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/true-villager/rules.txt|] } -- | /Somehow forgotten with the coming of the Werewolves, the Witch has a chance to prove themself/ @@ -570,21 +438,12 @@ -- There is no restriction on using both potions in one night or on healing themself. witchRole :: Role witchRole = Role - { _name = "Witch" + { _tag = "witch" + , _name = T.strip [iFile|variant/standard/role/witch/name.txt|] , _allegiance = Villagers , _balance = 3 - , _description = T.unwords - [ "Somehow forgotten with the coming of the Werewolves, the Witch has a chance to prove" - , "themself valuable to the village and maybe abolish the absurd pastime of burning and" - , "drowning their cult. The Witch is blessed (or maybe cursed) with the ability to make two" - , "powerful potions; one of which heals a victim of the Werewolves, the other poisons a" - , "player." - ] - , _rules = T.unwords - [ "The Witch is called after the Werewolves. They are able to heal and poison one player" - , "per game. There is no restriction on using both potions in one night or on healing" - , "themself." - ] + , _description = T.strip [iFile|variant/standard/role/witch/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/witch/rules.txt|] } -- | /The Alpha Wolf leads the Werewolves in the raids against Fougères each night and not even the/ @@ -595,17 +454,12 @@ -- The Alpha Wolf appears to nature-seeing roles (e.g., the Seer) as a Villager. alphaWolfRole :: Role alphaWolfRole = Role - { _name = "Alpha Wolf" + { _tag = "alpha-wolf" + , _name = T.strip [iFile|variant/standard/role/alpha-wolf/name.txt|] , _allegiance = Werewolves , _balance = -5 - , _description = T.unwords - [ "The Alpha Wolf leads the Werewolves in the raids against Fougères each night and not" - , "even the Seer can see them coming. If the Werewolves caused the Villagers to question" - , "and accuse one another beforehand, the Alpha Wolf eliminates any shred of humanity left." - , "No-one can be trusted anymore and no-one knows the truth." - ] - , _rules = - "The Alpha Wolf appears to nature-seeing roles (e.g., the Seer) as a Villager." + , _description = T.strip [iFile|variant/standard/role/alpha-wolf/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/alpha-wolf/rules.txt|] } -- | /The Simple Werewolf is a fearsome lupine, cunning like no other creature that roams the/ @@ -616,15 +470,10 @@ -- A Werewolf may never devour another Werewolf. simpleWerewolfRole :: Role simpleWerewolfRole = Role - { _name = "Simple Werewolf" + { _tag = "simple-werewolf" + , _name = T.strip [iFile|variant/standard/role/simple-werewolf/name.txt|] , _allegiance = Werewolves , _balance = -4 - , _description = T.unwords - [ "The Simple Werewolf is a fearsome lupine, cunning like no other creature that roams the" - , "forest. Their origin is unknown, but that matters little, for they present a grave" - , "threat to Fougères. While each day they hide in plain sight as an ordinary Villager," - , "each night they transform and devour an innocent. There is little hope left for the" - , "village." - ] - , _rules = "A Werewolf may never devour another Werewolf." + , _description = T.strip [iFile|variant/standard/role/simple-werewolf/description.txt|] + , _rules = T.strip [iFile|variant/standard/role/simple-werewolf/rules.txt|] } diff --git a/werewolf.cabal b/werewolf.cabal --- a/werewolf.cabal +++ b/werewolf.cabal @@ -1,5 +1,5 @@ name: werewolf -version: 1.1.1.0 +version: 1.2.0.0 author: Henry J. Wylde maintainer: public@hjwylde.com @@ -42,8 +42,16 @@ Game.Werewolf.Command.Werewolf Game.Werewolf.Command.Witch Game.Werewolf.Engine - Game.Werewolf.Messages + Game.Werewolf.Message + Game.Werewolf.Message.Command + Game.Werewolf.Message.Engine + Game.Werewolf.Message.Error Game.Werewolf.Util + Game.Werewolf.Variant.NoRoleKnowledge.Command + Game.Werewolf.Variant.NoRoleKnowledge.Engine + Game.Werewolf.Variant.Standard.Command + Game.Werewolf.Variant.Standard.Engine + Game.Werewolf.Variant.Standard.Error Paths_werewolf Werewolf.Command.Boot Werewolf.Command.Choose @@ -64,7 +72,6 @@ Werewolf.Command.Unvote Werewolf.Command.Version Werewolf.Command.Vote - Werewolf.Messages Werewolf.Options Werewolf.System Werewolf.Version @@ -74,6 +81,7 @@ FlexibleContexts, MultiParamTypeClasses, OverloadedStrings, + QuasiQuotes, Rank2Types build-depends: aeson >= 0.8 && < 0.12, @@ -96,6 +104,7 @@ exposed-modules: Control.Lens.Extra Data.String.Humanise + Data.String.Interpolate.Extra Game.Werewolf Game.Werewolf.Game Game.Werewolf.Player @@ -108,6 +117,7 @@ DeriveGeneric, FlexibleContexts, OverloadedStrings, + QuasiQuotes, Rank2Types, TemplateHaskell build-depends: @@ -115,7 +125,9 @@ base >= 4.8 && < 5, containers == 0.5.*, extra == 1.4.*, + interpolate == 0.1.*, lens >= 4.12 && < 4.15, mtl == 2.2.*, + template-haskell == 2.10.*, text == 1.2.*, transformers == 0.4.*