module Game.Werewolf.Response (
Response(..),
success, failure,
exitWith,
Message(..),
publicMessage, privateMessage, groupMessages,
noGameRunningMessage, gameAlreadyRunningMessage,
newGameMessages, stageMessages, gameOverMessages, playerQuitMessage,
pingPlayerMessage, pingSeerMessage, pingWerewolvesMessage,
currentStageMessages, rolesInGameMessage, playersInGameMessage, waitingOnMessage,
playerSeenMessage,
playerMadeLynchVoteMessage, playerLynchedMessage, noPlayerLynchedMessage,
scapegoatLynchedMessage,
playerMadeDevourVoteMessage, playerDevouredMessage, noPlayerDevouredMessage,
gameIsOverMessage, playerDoesNotExistMessage, playerCannotDoThatMessage,
playerCannotDoThatRightNowMessage, playerIsDeadMessage, roleDoesNotExistMessage,
playerHasAlreadyVotedMessage, targetIsDeadMessage,
playerCannotDevourAnotherWerewolf,
) where
import Control.Lens
import Control.Monad.IO.Class
import Data.Aeson
#if !MIN_VERSION_aeson(0,10,0)
import Data.Aeson.Types
#endif
import Data.List.Extra
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy.Encoding as T
import qualified Data.Text.Lazy.IO as T
import Game.Werewolf.Game
import Game.Werewolf.Player
import Game.Werewolf.Role (Role, allegiance, description, _allegiance)
import qualified Game.Werewolf.Role as Role
import GHC.Generics
import qualified System.Exit as Exit
data Response = Response
{ ok :: Bool
, messages :: [Message]
} deriving (Eq, Generic, Show)
instance FromJSON Response
instance ToJSON Response where
toJSON = genericToJSON defaultOptions
#if MIN_VERSION_aeson(0,10,0)
toEncoding = genericToEncoding defaultOptions
#endif
success :: Response
success = Response True []
failure :: Response
failure = Response False []
exitWith :: MonadIO m => Response -> m ()
exitWith response = liftIO $ T.putStrLn (T.decodeUtf8 $ encode response) >> Exit.exitSuccess
data Message = Message
{ to :: Maybe Text
, message :: Text
} deriving (Eq, Generic, Show)
instance FromJSON Message
instance ToJSON Message where
toJSON = genericToJSON defaultOptions
#if MIN_VERSION_aeson(0,10,0)
toEncoding = genericToEncoding defaultOptions
#endif
publicMessage :: Text -> Message
publicMessage = Message Nothing
privateMessage :: Text -> Text -> Message
privateMessage to = Message (Just to)
groupMessages :: [Text] -> Text -> [Message]
groupMessages tos message = map (\to -> privateMessage to message) tos
noGameRunningMessage :: Text -> Message
noGameRunningMessage to = privateMessage to "No game is running."
gameAlreadyRunningMessage :: Text -> Message
gameAlreadyRunningMessage to = privateMessage to "A game is already running."
newGameMessages :: Game -> [Message]
newGameMessages game = [
newPlayersInGameMessage players',
rolesInGameMessage Nothing $ map _role players'
] ++ map (newPlayerMessage players') players'
++ stageMessages stage' players'
where
stage' = game ^. stage
players' = game ^. players
newPlayersInGameMessage :: [Player] -> Message
newPlayersInGameMessage players = publicMessage $ T.concat [
"A new game of werewolf is starting with ",
T.intercalate ", " (map _name players), "!"
]
newPlayerMessage :: [Player] -> Player -> Message
newPlayerMessage players player
| isWerewolf player = privateMessage (player ^. name) $ T.intercalate "\n" [T.concat ["You're a Werewolf", packMessage], player ^. role . description]
| otherwise = privateMessage (player ^. name) $ T.intercalate "\n" [T.concat ["You're a ", player ^. role . Role.name, "."], player ^. role . description]
where
packMessage
| length (filterWerewolves players) <= 1 = "."
| otherwise = T.concat [", along with ", T.intercalate ", " (map _name $ filterWerewolves players \\ [player]), "."]
stageMessages :: Stage -> [Player] -> [Message]
stageMessages GameOver _ = []
stageMessages SeersTurn alivePlayers = seersTurnMessages . head $ filterSeers alivePlayers
stageMessages Sunrise _ = [sunriseMessage]
stageMessages Sunset _ = [nightFallsMessage]
stageMessages VillagesTurn _ = villagesTurnMessages
stageMessages WerewolvesTurn alivePlayers = werewolvesTurnMessages $ filterWerewolves alivePlayers
seersTurnMessages :: Player -> [Message]
seersTurnMessages seer = [
publicMessage "The Seer wakes up.",
privateMessage (seer ^. name) "Whose allegiance would you like to see?"
]
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 town square the town clerk calls for a vote.",
publicMessage "Whom would you like to lynch?"
]
werewolvesTurnMessages :: [Player] -> [Message]
werewolvesTurnMessages werewolves = [
publicMessage "The Werewolves wake up, recognise one another and choose a new victim."
] ++ groupMessages (map _name werewolves) "Whom would you like to devour?"
gameOverMessages :: Game -> [Message]
gameOverMessages game = case aliveAllegiances of
[allegiance] -> concat [
[publicMessage $ T.unwords ["The game is over! The", T.pack $ show allegiance, "have won."]],
map (playerWonMessage . _name) (filter ((allegiance ==) . _allegiance . _role) players'),
map (playerLostMessage . _name) (filter ((allegiance /=) . _allegiance . _role) players')
]
_ -> publicMessage "The game is over! Everyone died...":map (playerLostMessage . _name) players'
where
players' = game ^. players
aliveAllegiances = nub $ map (_allegiance . _role) (filterAlive players')
playerWonMessage :: Text -> Message
playerWonMessage to = privateMessage to "Victory! You won!"
playerLostMessage :: Text -> Message
playerLostMessage to = privateMessage to "Feck, you lost this time round..."
playerQuitMessage :: Player -> Message
playerQuitMessage player = publicMessage $ T.unwords [player ^. name, "the", player ^. role . Role.name, "has quit!"]
pingPlayerMessage :: Text -> Message
pingPlayerMessage to = privateMessage to "Waiting on you..."
pingSeerMessage :: Message
pingSeerMessage = publicMessage "Waiting on the Seer..."
pingWerewolvesMessage :: Message
pingWerewolvesMessage = publicMessage "Waiting on the Werewolves..."
currentStageMessages :: Text -> Stage -> [Message]
currentStageMessages to GameOver = [gameIsOverMessage to]
currentStageMessages _ Sunrise = []
currentStageMessages _ Sunset = []
currentStageMessages to turn = [privateMessage to $ T.concat [
"It's currently the ", T.pack $ show turn, "' turn."
]]
rolesInGameMessage :: Maybe Text -> [Role] -> Message
rolesInGameMessage mTo roles = Message mTo $ T.concat [
"The roles in play are ",
T.intercalate ", " $ map (\(role, count) ->
T.concat [role ^. Role.name, " (", T.pack $ show count, ")"])
roleCounts,
"."
]
where
roleCounts = map (\list -> (head list, length list)) (groupSortOn Role._name roles)
playersInGameMessage :: Text -> [Player] -> Message
playersInGameMessage to players = privateMessage to . T.intercalate "\n" $ [
alivePlayersText
] ++ if (null $ filterDead players) then [] else [deadPlayersText]
where
alivePlayersText = T.concat [
"The following players are still alive: ",
T.intercalate ", " (map _name $ filterAlive players), "."
]
deadPlayersText = T.concat [
"The following players are dead: ",
T.intercalate ", " (map (\player -> T.concat [player ^. name, " (", player ^. role . Role.name, ")"]) $ filterDead players), "."
]
waitingOnMessage :: Maybe Text -> [Player] -> Message
waitingOnMessage mTo players = Message mTo $ T.concat [
"Waiting on ", T.intercalate ", " playerNames, "..."
]
where
playerNames = map _name players
playerSeenMessage :: Text -> Player -> Message
playerSeenMessage to target = privateMessage to $ T.concat [
target ^. name, " is aligned with the ", T.pack . show $ target ^. role . allegiance, "."
]
playerMadeLynchVoteMessage :: Text -> Text -> Message
playerMadeLynchVoteMessage voterName targetName = publicMessage $ T.concat [
voterName, " voted to lynch ", targetName, "."
]
playerLynchedMessage :: Player -> Message
playerLynchedMessage player
| isWerewolf player = publicMessage $ T.unwords [
player ^. name, "is tied up to a pyre and set alight.",
"As they scream their body starts to contort and writhe, transforming into a Werewolf.",
"Thankfully they go limp before breaking free of their restraints."
]
| otherwise = publicMessage $ T.concat [
player ^. name, " is tied up to a pyre and set alight.",
" Eventually the screams start to die and with their last breath,",
" they reveal themselves as a ", player ^. role . Role.name, "."
]
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."
]
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."
]
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 ",
player ^. name, "'s guts half devoured and spilling out over the cobblestones.",
" From the look of their personal effects, you deduce they were a ",
player ^. role . Role.name, "."
]
noPlayerDevouredMessage :: Message
noPlayerDevouredMessage = publicMessage $ T.unwords [
"Surprisingly you see everyone present at the town square.",
"Perhaps the Werewolves have left Miller's Hollow?"
]
gameIsOverMessage :: Text -> Message
gameIsOverMessage to = privateMessage to "The game is over!"
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!"
roleDoesNotExistMessage :: Text -> Text -> Message
roleDoesNotExistMessage to name = privateMessage to $ T.unwords ["Role", name, "does not exist."]
playerHasAlreadyVotedMessage :: Text -> Message
playerHasAlreadyVotedMessage to = privateMessage to "You've already voted!"
targetIsDeadMessage :: Text -> Text -> Message
targetIsDeadMessage to targetName = privateMessage to $ T.unwords [
targetName, "is already dead!"
]
playerCannotDevourAnotherWerewolf :: Text -> Message
playerCannotDevourAnotherWerewolf to = privateMessage to "You cannot devour another Werewolf!"