werewolf 0.4.5.0 → 0.4.6.0

raw patch · 42 files changed

+2320/−1400 lines, 42 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +16/−0
• LICENSE +1/−1
• README.md +52/−24
• app/Main.hs +4/−2
• app/Werewolf/Commands/Choose.hs +15/−12
• app/Werewolf/Commands/Circle.hs +47/−0
• app/Werewolf/Commands/End.hs +9/−16
• app/Werewolf/Commands/Heal.hs +4/−5
• app/Werewolf/Commands/Help.hs +9/−10
• app/Werewolf/Commands/Interpret.hs +1/−2
• app/Werewolf/Commands/Pass.hs +4/−5
• app/Werewolf/Commands/Ping.hs +4/−5
• app/Werewolf/Commands/Poison.hs +4/−6
• app/Werewolf/Commands/Protect.hs +4/−6
• app/Werewolf/Commands/Quit.hs +4/−5
• app/Werewolf/Commands/See.hs +4/−6
• app/Werewolf/Commands/Start.hs +36/−17
• app/Werewolf/Commands/Status.hs +4/−5
• app/Werewolf/Commands/Version.hs +3/−3
• app/Werewolf/Commands/Vote.hs +10/−11
• app/Werewolf/Messages.hs +43/−0
• app/Werewolf/Options.hs +31/−18
• app/Werewolf/Version.hs +1/−2
• src/Game/Werewolf.hs +34/−0
• src/Game/Werewolf/Command.hs +51/−18
• src/Game/Werewolf/Engine.hs +102/−56
• src/Game/Werewolf/Game.hs +10/−194
• src/Game/Werewolf/Internal/Game.hs +309/−0
• src/Game/Werewolf/Internal/Player.hs +180/−0
• src/Game/Werewolf/Internal/Role.hs +380/−0
• src/Game/Werewolf/Messages.hs +539/−0
• src/Game/Werewolf/Player.hs +5/−115
• src/Game/Werewolf/Response.hs +38/−476
• src/Game/Werewolf/Role.hs +7/−203
• test/app/Main.hs +2/−1
• test/src/Game/Werewolf/Test/Arbitrary.hs +78/−19
• test/src/Game/Werewolf/Test/Command.hs +130/−38
• test/src/Game/Werewolf/Test/Engine.hs +105/−102
• test/src/Game/Werewolf/Test/Game.hs +26/−13
• test/src/Game/Werewolf/Test/Player.hs +2/−2
• test/src/Game/Werewolf/Test/Util.hs +1/−1
• werewolf.cabal +11/−1

@@ -2,6 +2,22 @@  #### Upcoming +#### v0.4.6.0++*Minor*++* Added the Village Idiot role. ([#41](https://github.com/hjwylde/werewolf/issues/41))+* Added the Scapegoat's ability to choose whom may vote on the next day when he is blamed. ([#62](https://github.com/hjwylde/werewolf/issues/62))+* Added in balance concept for roles to help balance role selection. ([#81](https://github.com/hjwylde/werewolf/issues/81))+* Added `--random-extra-roles` option to `start`. ([#30](https://github.com/hjwylde/werewolf/issues/30))+* Added the Bear Tamer role. ([#45](https://github.com/hjwylde/werewolf/issues/45))+* Added a `circle` command. ([#45](https://github.com/hjwylde/werewolf/issues/45))++*Revisions*++* Fixed the Defender being unable to protect himself.+* Restructured library modules to only export relevant functions. ([#11](https://github.com/hjwylde/werewolf/issues/11))+ #### v0.4.5.0  *Minor*

@@ -1,4 +1,4 @@-Copyright (c) 2015, Henry J. Wylde+Copyright (c) 2016, Henry J. Wylde All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -20,18 +20,40 @@  #### Roles -The current implemented roles are:+The implemented roles are split into four categories.++**The Ambiguous:**++The Ambiguous may change allegiance during the game.++* Wild-child.+* Wolf-hound.++**The Loners:**++The Loners have their own win condition.+ * Angel.++**The Villagers:**++The Villagers must lynch all of the Werewolves.++* Bear Tamer. * Defender. * Scapegoat. * Seer. * Simple Villager.-* Simple Werewolf.+* Village Idiot. * Villager-Villager.-* Wild-child. * Witch.-* Wolf-hound. +**The Werewolves:**++The Werewolves must devour all of the Villagers.++* Simple Werewolf.+ ### Installing  Installing werewolf is easiest done using either@@ -58,16 +80,17 @@  All werewolf commands are designed to be run by a user from the chat client. E.g., to start a game:+ ```bash > werewolf --caller @foo start --extra-roles seer @bar @baz @qux @quux @corge @grault {"ok":true,"messages":[     {"to":null,"message":"A new game of werewolf is starting with @foo, @bar, @baz, @qux, @quux, @corge, @grault!"},-    {"to":null,"message":"The roles in play are Seer (1), Simple Villager (4), Simple Werewolf (2)."},-    {"to":"@foo","message":"You're a Simple Werewolf, along with @baz.\nA shapeshifting townsperson that, at night, hunts the residents of Millers Hollow."},+    {"to":null,"message":"The roles in play are Seer (1), Simple Villager (4), Simple Werewolf (2) for a total balance of -2."},+    {"to":"@foo","message":"You're a Simple Villager.\nA simple, ordinary townsperson in every way. Their only weapons are the ability to analyze behaviour to identify Werewolves, and the strength of their conviction to prevent the execution of the innocents like themselves."},     ...,     {"to":null,"message":"Night falls, the village is asleep."},     {"to":null,"message":"The Seer wakes up."},-    {"to":"@qux","message":"Whose allegiance would you like to see?"}+    {"to":"@corge","message":"Whose allegiance would you like to `see`?"}     ]} ``` @@ -81,46 +104,51 @@     recipient.  It's the Seer's turn now.+ ```bash-> werewolf --caller @qux see @grault+> werewolf --caller @corge see @grault {"ok":true,"messages":[-    {"to":"@qux","message":"@grault is aligned with the Villagers."},+    {"to":"@corge","message":"@grault is aligned with the Werewolves."},+    {"to":"@quux","message":"You feel restless, like an old curse is keeping you from sleep. It seems you're not the only one... @grault are also emerging from their homes."},+    {"to":"@grault","message":"You feel restless, like an old curse is keeping you from sleep.  It seems you're not the only one... @quux are also emerging from their homes."},     {"to":null,"message":"The Werewolves wake up, recognise one another and choose a new victim."},-    {"to":"@foo","message":"Whom would you like to devour?"},-    {"to":"@baz","message":"Whom would you like to devour?"}+    {"to":"@quux","message":"Whom would you like to `vote` to devour?"},+    {"to":"@grault","message":"Whom would you like to `vote` to devour?"}     ]} ``` -Let's have the Werewolves, _@foo_ and _@baz_, vote to devour a Villager.+Let's have the Werewolves, _@quux_ and _@grault_, vote to devour a Villager.+ ```bash-> werewolf --caller @foo vote @bar+> werewolf --caller @quux vote @foo {"ok":true,"messages":[-    {"to":"@baz","message":"@foo voted to devour @bar."}+    {"to":"@grault","message":"@quux voted to devour @foo."}     ]}-> werewolf --caller @baz vote @bar+> werewolf --caller @grault vote @foo {"ok":true,"messages":[-    {"to":"@foo","message":"@baz voted to devour @bar."},+    {"to":"@quux","message":"@grault voted to devour @foo."},     {"to":null,"message":"The sun rises. Everybody wakes up and opens their eyes..."},-    {"to":null,"message":"As you open them you notice a door broken down and @bar's guts half devoured and spilling out over the cobblestones. From the look of their personal effects, you deduce they were a Simple Villager."},-    {"to":null,"message":"As the village gathers in the town square the town clerk calls for a vote."},-    {"to":null,"message":"Whom would you like to lynch?"}+    {"to":null,"message":"As you open them you notice a door broken down and @foo's guts half devoured and spilling out over the cobblestones. From the look of their personal effects, you deduce they were a Simple Villager."},+    {"to":null,"message":"As the village gathers in the square the town clerk calls for a vote."},+    {"to":null,"message":"Whom would you like to `vote` to lynch?"}     ]} ``` -Too bad for _@bar_. Maybe the village can get some vengeance...+Too bad for _@foo_. Maybe the village can get some vengeance...+ ```bash-> werewolf --caller @qux vote @foo+> werewolf --caller @corge vote @grault {"ok":true,"messages":[]} ```  This time, even though the command was successful, there are no messages.  ```bash-> werewolf --caller @qux vote @foo-{"ok":false,"messages":[{"to":["@qux"],"message":"You've already voted!"}]}+> werewolf --caller @corge vote @grault+{"ok":false,"messages":[{"to":["@corge"],"message":"You've already voted!"}]} ``` -Here the command was unsuccessful and an error message is sent to _@qux_.+Here the command was unsuccessful and an error message is sent to _@corge_. Even though the command was unsuccessful, the chat client interface probably won't need to do     anything special. Relaying the error message back to the user should suffice.

@@ -1,7 +1,7 @@ {-| Module      : Main -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com -}@@ -11,7 +11,7 @@  module Main (     -- * Main-    main, handle,+    main, ) where  import           Data.Text (Text)@@ -22,6 +22,7 @@ import System.Environment  import qualified Werewolf.Commands.Choose    as Choose+import qualified Werewolf.Commands.Circle    as Circle import qualified Werewolf.Commands.End       as End import qualified Werewolf.Commands.Heal      as Heal import qualified Werewolf.Commands.Help      as Help@@ -55,6 +56,7 @@ handle :: Options -> IO () handle (Options callerName command) = case command of     Choose options                      -> Choose.handle callerName options+    Circle options                      -> Circle.handle callerName options     End                                 -> End.handle callerName     Heal                                -> Heal.handle callerName     Help options                        -> Help.handle callerName options

@@ -2,13 +2,15 @@ Module      : Werewolf.Commands.Choose Description : Options and handler for the choose subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com  Options and handler for the choose subcommand. -} +{-# LANGUAGE OverloadedStrings #-}+ module Werewolf.Commands.Choose (     -- * Options     Options(..),@@ -17,24 +19,23 @@     handle, ) where +import Control.Lens import Control.Monad.Except import Control.Monad.Extra import Control.Monad.State import Control.Monad.Writer -import Data.Text (Text)+import           Data.Text (Text)+import qualified Data.Text as T -import Game.Werewolf.Command-import Game.Werewolf.Engine   hiding (isWildChildsTurn)-import Game.Werewolf.Game-import Game.Werewolf.Response+import Game.Werewolf --- | Options.+import Werewolf.Messages+ data Options = Options     { arg :: Text     } deriving (Eq, Show) --- | Handle. handle :: MonadIO m => Text -> Options -> m () handle callerName (Options arg) = do     unlessM doesGameExist $ exitWith failure@@ -43,10 +44,12 @@      game <- readGame -    let command = (if isWildChildsTurn game-            then choosePlayerCommand-            else chooseAllegianceCommand-            ) callerName arg+    let command = case game ^. stage of+            ScapegoatsTurn  -> choosePlayersCommand callerName (filter (/= T.empty) (T.splitOn "," arg))+            WildChildsTurn  -> choosePlayerCommand callerName arg+            WolfHoundsTurn  -> chooseAllegianceCommand callerName arg+            -- TODO (hjw): throw an error+            _               -> undefined      case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of         Left errorMessages      -> exitWith failure { messages = errorMessages }

@@ -0,0 +1,47 @@+{-|+Module      : Werewolf.Commands.Circle+Description : Options and handler for the circle subcommand.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Options and handler for the circle subcommand.+-}++module Werewolf.Commands.Circle (+    -- * Options+    Options(..),++    -- * Handle+    handle,+) where++import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.State+import Control.Monad.Writer++import Data.Text (Text)++import Game.Werewolf++import Werewolf.Messages++data Options = Options+    { optIncludeDead :: Bool+    } deriving (Eq, Show)++handle :: MonadIO m => Text -> Options -> m ()+handle callerName (Options includeDead) = do+    unlessM doesGameExist $ exitWith failure+        { messages = [noGameRunningMessage callerName]+        }++    game <- readGame++    let command = circleCommand callerName includeDead++    case runExcept (execWriterT $ execStateT (apply command) game) of+        Left errorMessages  -> exitWith failure { messages = errorMessages }+        Right messages      -> exitWith success { messages = messages }

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.End Description : Handler for the end subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -16,31 +16,24 @@     handle, ) where -import Control.Lens import Control.Monad.Extra import Control.Monad.IO.Class -import           Data.Maybe-import           Data.Text  (Text)-import qualified Data.Text  as T+import           Data.Text (Text)+import qualified Data.Text as T -import Game.Werewolf.Engine-import Game.Werewolf.Game-import Game.Werewolf.Player-import Game.Werewolf.Response+import Game.Werewolf --- | Handle.+import Werewolf.Messages+ handle :: MonadIO m => Text -> m () handle callerName = do-    unlessM doesGameExist $ exitWith failure-        { messages = [noGameRunningMessage callerName]-        }+    unlessM doesGameExist $ exitWith failure { messages = [noGameRunningMessage callerName] }      game <- readGame -    when (isNothing $ findByName callerName (game ^. players)) $ exitWith failure-        { messages = [playerCannotDoThatMessage callerName]-        }+    unless (doesPlayerExist callerName game) $+        exitWith failure { messages = [playerCannotDoThatMessage callerName] }      deleteGame 

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.Heal Description : Handler for the heal subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -23,11 +23,10 @@  import Data.Text (Text) -import Game.Werewolf.Command-import Game.Werewolf.Engine-import Game.Werewolf.Response+import Game.Werewolf --- | Handle.+import Werewolf.Messages+ handle :: MonadIO m => Text -> m () handle callerName = do     unlessM doesGameExist $ exitWith failure

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.Help Description : Options and handler for the help subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -25,19 +25,16 @@ import           Data.Text (Text) import qualified Data.Text as T -import Game.Werewolf.Response-import Game.Werewolf.Role     as Role+import Game.Werewolf      hiding (Command)+import Game.Werewolf.Role as Role --- | Options. data Options = Options     { argCommand :: Maybe Command     } deriving (Eq, Show) --- | Command. data Command = Commands | Description | Rules | Roles     deriving (Eq, Show) --- | Handle. handle :: MonadIO m => Text -> Options -> m () handle callerName (Options (Just Commands)) = exitWith success     { messages = map (privateMessage callerName) commandsMessages@@ -47,7 +44,7 @@     } handle callerName (Options (Just Roles)) = exitWith success     { messages = map (\role -> privateMessage callerName $ T.intercalate "\n"-        [ T.snoc (role ^. Role.name) ':'+        [ T.concat [role ^. Role.name, " (", T.pack . show $ role ^. balance, "):"]         , role ^. description         , role ^. advice         ]) allRoles@@ -61,7 +58,7 @@  commandsMessages :: [Text] commandsMessages =-    [ "choose (ALLEGIANCE|PLAYER) - choose an allegiance or player."+    [ "choose (ALLEGIANCE | PLAYER,...) - choose an allegiance or player(s)."     , "end - ends the current game."     , "heal - heal the devoured player."     , "pass - pass on healing or poisoning a player."@@ -70,8 +67,9 @@     , "protect PLAYER - protect a player."     , "quit - quit the current game."     , "see PLAYER - see a player's allegiance."-    , "start [--extra-roles ROLE,...] PLAYER... - starts a new game with the given players and extra roles. A game requires at least 7 players."+    , "start ([--extra-roles ROLE,...] | [--random-extra-roles]) PLAYER... - starts a new game with the given players and extra roles. A game requires at least 7 players."     , "status - gets the status of the current game."+    , "version - show this engine's version."     , "vote PLAYER - vote against a player."     ] @@ -130,9 +128,10 @@       , "8. The Witch wakes up and may heal the victim and/or poison someone."       , "9. The village wakes up and find the victim."       , "10. The village votes to lynch a suspect."+      , "11. (When the Scapegoat is blamed) the Scapegot chooses whom may vote on the next day."       , T.unwords         [ "The game is over when only Villagers or Werewolves are left alive,"-        , "or one of the loners completes their own objective."+        , "or when one of the Loners completes their own objective."         ]       ]     ]

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.Interpret Description : Options for the interpret subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -16,7 +16,6 @@  import Data.Text (Text) --- | Options. data Options = Options     { args :: [Text]     } deriving (Eq, Show)

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.Pass Description : Handler for the pass subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -21,11 +21,10 @@  import Data.Text (Text) -import Game.Werewolf.Command-import Game.Werewolf.Engine-import Game.Werewolf.Response+import Game.Werewolf --- | Handle.+import Werewolf.Messages+ handle :: MonadIO m => Text -> m () handle callerName = do     unlessM doesGameExist $ exitWith failure

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.Ping Description : Handler for the ping subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -21,11 +21,10 @@  import Data.Text (Text) -import Game.Werewolf.Command-import Game.Werewolf.Engine-import Game.Werewolf.Response+import Game.Werewolf --- | Handle.+import Werewolf.Messages+ handle :: MonadIO m => Text -> m () handle callerName = do     unlessM doesGameExist $ exitWith failure

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.Poison Description : Options and handler for the poison subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -24,16 +24,14 @@  import Data.Text (Text) -import Game.Werewolf.Command-import Game.Werewolf.Engine-import Game.Werewolf.Response+import Game.Werewolf --- | Options.+import Werewolf.Messages+ data Options = Options     { argTarget :: Text     } deriving (Eq, Show) --- | Handle. handle :: MonadIO m => Text -> Options -> m () handle callerName (Options targetName) = do     unlessM doesGameExist $ exitWith failure

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.Protect Description : Options and handler for the protect subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -24,16 +24,14 @@  import Data.Text (Text) -import Game.Werewolf.Command-import Game.Werewolf.Engine-import Game.Werewolf.Response+import Game.Werewolf --- | Options.+import Werewolf.Messages+ data Options = Options     { argTarget :: Text     } deriving (Eq, Show) --- | Handle. handle :: MonadIO m => Text -> Options -> m () handle callerName (Options targetName) = do     unlessM doesGameExist $ exitWith failure

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.Quit Description : Handler for the quit subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -21,11 +21,10 @@  import Data.Text (Text) -import Game.Werewolf.Command-import Game.Werewolf.Engine-import Game.Werewolf.Response+import Game.Werewolf --- | Handle.+import Werewolf.Messages+ handle :: MonadIO m => Text -> m () handle callerName = do     unlessM doesGameExist $ exitWith failure

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.See Description : Options and handler for the see subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -24,16 +24,14 @@  import Data.Text (Text) -import Game.Werewolf.Command-import Game.Werewolf.Engine-import Game.Werewolf.Response+import Game.Werewolf --- | Options.+import Werewolf.Messages+ data Options = Options     { argTarget :: Text     } deriving (Eq, Show) --- | Handle. handle :: MonadIO m => Text -> Options -> m () handle callerName (Options targetName) = do     unlessM doesGameExist $ exitWith failure

@@ -2,16 +2,18 @@ Module      : Werewolf.Commands.Start Description : Options and handler for the start subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com  Options and handler for the start subcommand. -} +{-# LANGUAGE FlexibleContexts      #-}+ module Werewolf.Commands.Start (     -- * Options-    Options(..),+    Options(..), ExtraRoles(..),      -- * Handle     handle,@@ -19,6 +21,7 @@  import Control.Lens import Control.Monad.Except+import Control.Monad.Random import Control.Monad.Extra import Control.Monad.State import Control.Monad.Writer@@ -27,31 +30,34 @@ import           Data.Text (Text) import qualified Data.Text as T -import Game.Werewolf.Engine   hiding (isGameOver)-import Game.Werewolf.Game-import Game.Werewolf.Response-import Game.Werewolf.Role+import Game.Werewolf+import Game.Werewolf.Role as Role --- | Options.+import System.Random.Shuffle++import Werewolf.Messages+ data Options = Options-    { optExtraRoleNames :: [Text]-    , argPlayers        :: [Text]+    { optExtraRoles :: ExtraRoles+    , argPlayers    :: [Text]     } deriving (Eq, Show) --- | Handle.+data ExtraRoles = None | Random | Use [Text]+    deriving (Eq, Show)+ handle :: MonadIO m => Text -> Options -> m ()-handle callerName (Options extraRoleNames playerNames) = do+handle callerName (Options extraRoles playerNames) = do     whenM (doesGameExist &&^ fmap (not . isGameOver) readGame) $ exitWith failure         { messages = [gameAlreadyRunningMessage callerName]         }      result <- runExceptT $ do-        extraRoles <- forM extraRoleNames $ \roleName -> maybe-            (throwError [roleDoesNotExistMessage callerName roleName])-            return-            (findByName roleName)+        extraRoles' <- case extraRoles of+            None            -> return []+            Random          -> randomExtraRoles $ length playerNames+            Use roleNames   -> useExtraRoles callerName roleNames -        players <- createPlayers (callerName:playerNames) extraRoles+        players <- createPlayers (callerName:playerNames) (padRoles extraRoles' (length playerNames + 1))          runWriterT $ startGame callerName players >>= execStateT checkStage @@ -59,5 +65,18 @@         Left errorMessages      -> exitWith failure { messages = errorMessages }         Right (game, messages)  -> writeGame game >> exitWith success { messages = messages } +randomExtraRoles :: MonadIO m => Int -> m [Role]+randomExtraRoles n = liftIO . evalRandIO $ do+    let minimum = n `div` 5 + 1++    count <- getRandomR (minimum, minimum + 2)++    take count <$> shuffleM restrictedRoles++useExtraRoles :: MonadError [Message] m => Text -> [Text] -> m [Role]+useExtraRoles callerName roleNames = forM roleNames $ \roleName -> case findByName roleName of+    Just role   -> return role+    Nothing     -> throwError [roleDoesNotExistMessage callerName roleName]+ findByName :: Text -> Maybe Role-findByName name' = find ((name' ==) . T.toLower . view name) allRoles+findByName name' = find ((name' ==) . T.toLower . view Role.name) allRoles

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.Status Description : Handler for the status subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -21,11 +21,10 @@  import Data.Text (Text) -import Game.Werewolf.Command-import Game.Werewolf.Engine-import Game.Werewolf.Response+import Game.Werewolf --- | Handle.+import Werewolf.Messages+ handle :: MonadIO m => Text -> m () handle callerName = do     unlessM doesGameExist $ exitWith failure

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.Version Description : Handler for the version subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -18,10 +18,10 @@  import Data.Text (Text) -import Game.Werewolf.Response+import Game.Werewolf +import Werewolf.Messages import Werewolf.Version --- | Handle. handle :: MonadIO m => Text -> m () handle callerName = exitWith success { messages = [engineVersionMessage callerName version] }

@@ -2,7 +2,7 @@ Module      : Werewolf.Commands.Vote Description : Options and handler for the vote subcommand. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -17,6 +17,7 @@     handle, ) where +import Control.Lens import Control.Monad.Except import Control.Monad.Extra import Control.Monad.State@@ -24,17 +25,14 @@  import Data.Text (Text) -import Game.Werewolf.Command-import Game.Werewolf.Engine   hiding (isWerewolvesTurn)-import Game.Werewolf.Game-import Game.Werewolf.Response+import Game.Werewolf --- | Options.+import Werewolf.Messages+ data Options = Options     { argTarget :: Text     } deriving (Eq, Show) --- | Handle. handle :: MonadIO m => Text -> Options -> m () handle callerName (Options targetName) = do     unlessM doesGameExist $ exitWith failure@@ -43,10 +41,11 @@      game <- readGame -    let command = (if isWerewolvesTurn game-            then voteDevourCommand-            else voteLynchCommand-            ) callerName targetName+    let command = case game ^. stage of+            VillagesTurn    -> voteLynchCommand callerName targetName+            WerewolvesTurn  -> voteDevourCommand callerName targetName+            -- TODO (hjw): throw an error+            _               -> undefined      case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of         Left errorMessages      -> exitWith failure { messages = errorMessages }

@@ -0,0 +1,43 @@+{-|+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,+    playerCannotDoThatMessage,+) 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."]++playerCannotDoThatMessage :: Text -> Message+playerCannotDoThatMessage to = privateMessage to "You cannot do that!"

@@ -2,7 +2,7 @@ Module      : Werewolf.Options Description : Optparse utilities. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -19,12 +19,12 @@     werewolfPrefs, werewolfInfo, werewolf, ) where -import           Data.List.Extra-import           Data.Text       (Text)-import qualified Data.Text       as T-import           Data.Version    (showVersion)+import           Data.Text    (Text)+import qualified Data.Text    as T+import           Data.Version (showVersion)  import qualified Werewolf.Commands.Choose    as Choose+import qualified Werewolf.Commands.Circle    as Circle import qualified Werewolf.Commands.Help      as Help import qualified Werewolf.Commands.Interpret as Interpret import qualified Werewolf.Commands.Poison    as Poison@@ -36,15 +36,14 @@  import Options.Applicative --- | Options. data Options = Options     { optCaller  :: Text     , argCommand :: Command     } deriving (Eq, Show) --- | Command. data Command     = Choose Choose.Options+    | Circle Circle.Options     | End     | Heal     | Help Help.Options@@ -91,7 +90,8 @@         , help "Specify the calling player's name"         ])     <*> subparser (mconcat-        [ command "choose"      $ info (helper <*> choose)      (fullDesc <> progDesc "Choose an allegiance")+        [ command "choose"      $ info (helper <*> choose)      (fullDesc <> progDesc "Choose an allegiance or player(s)")+        , command "circle"      $ info (helper <*> circle)      (fullDesc <> progDesc "Get the game circle")         , command "end"         $ info (helper <*> end)         (fullDesc <> progDesc "End the current game")         , command "heal"        $ info (helper <*> heal)        (fullDesc <> progDesc "Heal the devoured player")         , command "help"        $ info (helper <*> help_)       (fullDesc <> progDesc "Help documents")@@ -109,8 +109,15 @@         ])  choose :: Parser Command-choose = Choose . Choose.Options . T.pack <$> strArgument (metavar "ALLEGIANCE")+choose = Choose . Choose.Options . T.pack <$> strArgument (metavar "ALLEGIANCE | PLAYER,...") +circle :: Parser Command+circle = Circle . Circle.Options+    <$> switch (mconcat+        [ long "include-dead", short 'a'+        , help "Include dead players"+        ])+ end :: Parser Command end = pure End @@ -127,9 +134,8 @@         ])  interpret :: Parser Command-interpret = Interpret . Interpret.Options <$> many (-    T.pack <$> strArgument (metavar "-- COMMAND ARG...")-    )+interpret = Interpret . Interpret.Options+    <$> many (T.pack <$> strArgument (metavar "-- COMMAND ARG..."))  pass :: Parser Command pass = pure Pass@@ -151,12 +157,19 @@  start :: Parser Command start = fmap Start $ Start.Options-    <$> fmap (map T.pack . wordsBy (',' ==)) (strOption $ mconcat-        [ long "extra-roles", metavar "ROLE,..."-        , value []-        , help "Specify the extra roles to include"-        ])-    <*> many (T.pack <$> strArgument (metavar "PLAYER..."))+    <$> (extraRolesOption <|> randomExtraRolesOption)+    <*> some (T.pack <$> strArgument (metavar "PLAYER..."))+    where+        extraRolesOption = fmap (Start.Use . filter (/= T.empty) . T.splitOn "," . T.pack) (strOption $ mconcat+            [ long "extra-roles", metavar "ROLE,..."+            , value []+            , help "Specify the extra roles to use"+            ])++        randomExtraRolesOption = flag Start.None Start.Random $ mconcat+            [ long "random-extra-roles"+            , help "Use random extra roles"+            ]  status :: Parser Command status = pure Status

@@ -2,7 +2,7 @@ Module      : Werewolf.Version Description : Haskell constant of the binary version. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -11,7 +11,6 @@  module Werewolf.Version (     -- * Version-    -- | The binary version.     version, ) where 

@@ -0,0 +1,34 @@+{-|+Module      : Game.Werewolf+Description : Re-exports all of the public modules under /Game.Werewolf/.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Re-exports all of the public modules under /Game.Werewolf/.++Where clashes are found between "Game.Werewolf.Game" and "Game.Werewolf.Engine", the+"Game.Werewolf.Game" functions are preferred.++Likewise, where clashes are found between "Game.Werewolf.Player" and "Game.Werewolf.Role", the+"Game.Werewolf.Player" functions are preferred.+-}++module Game.Werewolf (+    module Game.Werewolf.Command,+    module Game.Werewolf.Engine,+    module Game.Werewolf.Game,+    module Game.Werewolf.Player,+    module Game.Werewolf.Response,+    module Game.Werewolf.Role+) where++import Game.Werewolf.Command+import Game.Werewolf.Engine   hiding (doesPlayerExist, isDefendersTurn, isGameOver,+                               isScapegoatsTurn, isSeersTurn, isVillagesTurn, isWerewolvesTurn,+                               isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn)+import Game.Werewolf.Game+import Game.Werewolf.Player+import Game.Werewolf.Response+import Game.Werewolf.Role     hiding (name)

@@ -1,8 +1,8 @@ {-| Module      : Game.Werewolf.Command-Description : Command data structures.+Description : Command data structure. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -19,9 +19,9 @@     Command(..),      -- ** Instances-    chooseAllegianceCommand, choosePlayerCommand, healCommand, noopCommand, passCommand,-    pingCommand, poisonCommand, protectCommand, quitCommand, seeCommand, statusCommand,-    voteDevourCommand, voteLynchCommand,+    chooseAllegianceCommand, choosePlayerCommand, choosePlayersCommand, circleCommand, healCommand,+    noopCommand, passCommand, pingCommand, poisonCommand, protectCommand, quitCommand, seeCommand,+    statusCommand, voteDevourCommand, voteLynchCommand, ) where  import Control.Lens         hiding (only)@@ -37,14 +37,17 @@ import qualified Data.Text  as T  import           Game.Werewolf.Engine-import           Game.Werewolf.Game     hiding (getDevourEvent, getPendingVoters, getPlayerVote,-                                         isDefendersTurn, isGameOver, isSeersTurn, isVillagesTurn,-                                         isWerewolvesTurn, isWildChildsTurn, isWitchsTurn,-                                         isWolfHoundsTurn, killPlayer, setPlayerRole)-import           Game.Werewolf.Player   hiding (doesPlayerExist)+import           Game.Werewolf.Internal.Game   hiding (doesPlayerExist, getAllowedVoters,+                                                getDevourEvent, getPendingVoters, getPlayerVote,+                                                isDefendersTurn, isGameOver, isScapegoatsTurn,+                                                isSeersTurn, isVillagesTurn, isWerewolvesTurn,+                                                isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn,+                                                killPlayer, setPlayerRole)+import           Game.Werewolf.Internal.Player+import           Game.Werewolf.Internal.Role   hiding (name)+import qualified Game.Werewolf.Internal.Role   as Role+import           Game.Werewolf.Messages import           Game.Werewolf.Response-import           Game.Werewolf.Role     hiding (name)-import qualified Game.Werewolf.Role     as Role  data Command = Command { apply :: forall m . (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => m () } @@ -72,6 +75,27 @@      roleModel .= Just targetName +choosePlayersCommand :: Text -> [Text] -> Command+choosePlayersCommand callerName targetNames = Command $ do+    whenM isGameOver                        $ throwError [gameIsOverMessage callerName]+    unlessM (doesPlayerExist callerName)    $ throwError [playerDoesNotExistMessage callerName callerName]+    unlessM (isPlayerScapegoat callerName)  $ throwError [playerCannotDoThatMessage callerName]+    unlessM isScapegoatsTurn                $ throwError [playerCannotDoThatRightNowMessage callerName]+    when (null targetNames)                 $ throwError [playerMustChooseAtLeastOneTargetMessage callerName]+    when (callerName `elem` targetNames)    $ throwError [playerCannotChooseSelfMessage callerName]+    forM_ targetNames $ validatePlayer callerName+    whenM (use villageIdiotRevealed &&^ anyM isPlayerVillageIdiot targetNames) $+        throwError [playerCannotChooseVillageIdiotMessage callerName]++    allowedVoters   .= targetNames+    scapegoatBlamed .= False++circleCommand :: Text -> Bool -> Command+circleCommand callerName includeDead = Command $ do+        players' <- uses players (if includeDead then id else filterAlive)++        tell [circleMessage callerName players']+ healCommand :: Text -> Command healCommand callerName = Command $ do     validateWitchsCommand callerName@@ -98,6 +122,11 @@          tell [pingRoleMessage $ defender ^. role . Role.name]         tell [pingPlayerMessage $ defender ^. name]+    ScapegoatsTurn  -> do+        scapegoat <- findPlayerByRole_ scapegoatRole++        tell [pingRoleMessage $ scapegoat ^. role . Role.name]+        tell [pingPlayerMessage $ scapegoat ^. name]     SeersTurn       -> do         seer <- findPlayerByRole_ seerRole @@ -105,11 +134,13 @@         tell [pingPlayerMessage $ seer ^. name]     Sunrise         -> return ()     Sunset          -> return ()+    UrsussGrunt     -> return ()     VillagesTurn    -> do+        allowedVoters <- getAllowedVoters         pendingVoters <- getPendingVoters -        tell [waitingOnMessage Nothing pendingVoters]-        tell $ map (pingPlayerMessage . view name) pendingVoters+        tell [waitingOnMessage Nothing $ allowedVoters `intersect` pendingVoters]+        tell $ map (pingPlayerMessage . view name) (allowedVoters `intersect` pendingVoters)     WerewolvesTurn  -> do         pendingVoters <- getPendingVoters @@ -147,7 +178,6 @@     validatePlayer callerName callerName     unlessM (isPlayerDefender callerName)   $ throwError [playerCannotDoThatMessage callerName]     unlessM isDefendersTurn                 $ throwError [playerCannotDoThatRightNowMessage callerName]-    when (callerName == targetName)         $ throwError [playerCannotProtectSelfMessage callerName]     validatePlayer callerName targetName     whenJustM (use priorProtect) $ \priorName ->         when (targetName == priorName) $ throwError [playerCannotProtectSamePlayerTwiceInARowMessage callerName]@@ -194,10 +224,11 @@     Sunset          -> return ()     VillagesTurn    -> do         game            <- get+        allowedVoters   <- getAllowedVoters         pendingVoters   <- getPendingVoters          tell $ standardStatusMessages stage' (game ^. players)-        tell [waitingOnMessage (Just callerName) pendingVoters]+        tell [waitingOnMessage (Just callerName) (allowedVoters `intersect` pendingVoters)]     WerewolvesTurn  -> do         game            <- get         pendingVoters   <- filterWerewolves <$> getPendingVoters@@ -231,9 +262,11 @@ voteLynchCommand :: Text -> Text -> Command voteLynchCommand callerName targetName = Command $ do     validatePlayer callerName callerName-    unlessM isVillagesTurn                          $ throwError [playerCannotDoThatRightNowMessage callerName]-    whenJustM (getPlayerVote callerName) . const    $ throwError [playerHasAlreadyVotedMessage callerName]+    whenM (uses allowedVoters (callerName `notElem`))                       $ throwError [playerCannotDoThatMessage callerName]+    unlessM isVillagesTurn                                                  $ throwError [playerCannotDoThatRightNowMessage callerName]+    whenJustM (getPlayerVote callerName) . const                            $ throwError [playerHasAlreadyVotedMessage callerName]     validatePlayer callerName targetName+    whenM (use villageIdiotRevealed &&^ isPlayerVillageIdiot targetName)    $ throwError [playerCannotLynchVillageIdiotMessage callerName]      votes %= Map.insert callerName targetName 

@@ -2,7 +2,7 @@ Module      : Game.Werewolf.Engine Description : Engine functions. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com @@ -26,9 +26,9 @@     findPlayerByName_, findPlayerByRole_,      -- ** Queries-    isGameOver, isDefendersTurn, isSeersTurn, isVillagesTurn, isWerewolvesTurn, isWildChildsTurn,-    isWitchsTurn, isWolfHoundsTurn,-    getPlayerVote, getPendingVoters, getVoteResult,+    isGameOver, isDefendersTurn, isScapegoatsTurn, isSeersTurn, isVillagesTurn, isWerewolvesTurn,+    isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn,+    getPlayerVote, getAllowedVoters, getPendingVoters, getVoteResult,      -- ** Reading and writing     defaultFilePath, writeGame, readGame, deleteGame, doesGameExist,@@ -44,13 +44,14 @@     createPlayers,      -- ** Queries-    doesPlayerExist, isPlayerDefender, isPlayerSeer, isPlayerWildChild, isPlayerWitch,-    isPlayerWolfHound,+    doesPlayerExist,+    isPlayerDefender, isPlayerScapegoat, isPlayerSeer, isPlayerVillageIdiot, isPlayerWildChild,+    isPlayerWitch, isPlayerWolfHound,     isPlayerWerewolf,     isPlayerAlive, isPlayerDead,      -- * Role-    randomiseRoles,+    padRoles, ) where  import Control.Lens         hiding (cons, snoc)@@ -65,17 +66,19 @@ import           Data.Text       (Text) import qualified Data.Text       as T -import           Game.Werewolf.Game     hiding (getDevourEvent, getPassers, getPendingVoters,-                                         getPlayerVote, getVoteResult, isDefendersTurn, isGameOver,-                                         isSeersTurn, isVillagesTurn, isWerewolvesTurn,-                                         isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn,-                                         killPlayer, setPlayerAllegiance, setPlayerRole)-import qualified Game.Werewolf.Game     as Game-import           Game.Werewolf.Player   hiding (doesPlayerExist)-import qualified Game.Werewolf.Player   as Player+import           Game.Werewolf.Internal.Game   hiding (doesPlayerExist, getAllowedVoters,+                                                getDevourEvent, getPassers, getPendingVoters,+                                                getPlayerVote, getVoteResult, isDefendersTurn,+                                                isGameOver, isScapegoatsTurn, isSeersTurn,+                                                isVillagesTurn, isWerewolvesTurn, isWildChildsTurn,+                                                isWitchsTurn, isWolfHoundsTurn, killPlayer,+                                                setPlayerAllegiance, setPlayerRole)+import qualified Game.Werewolf.Internal.Game   as Game+import           Game.Werewolf.Internal.Player+import           Game.Werewolf.Internal.Role   hiding (name)+import qualified Game.Werewolf.Internal.Role   as Role+import           Game.Werewolf.Messages import           Game.Werewolf.Response-import           Game.Werewolf.Role     hiding (name)-import qualified Game.Werewolf.Role     as Role  import Prelude hiding (round) @@ -100,6 +103,12 @@          whenJustM (use protect) $ const advanceStage +    ScapegoatsTurn -> unlessM (use scapegoatBlamed) $ do+        allowedVoters' <- use allowedVoters+        tell [scapegoatChoseAllowedVotersMessage allowedVoters']++        advanceStage+     SeersTurn -> do         seer <- findPlayerByRole_ seerRole @@ -115,11 +124,10 @@     Sunrise -> do         round += 1 -        whenJustM (findPlayerByRole angelRole) $ \angel ->-            when (isAlive angel) $ do-                tell [angelJoinedVillagersMessage]+        whenJustM (findAlivePlayerByRole angelRole) $ \angel -> do+            tell [angelJoinedVillagersMessage] -                setPlayerRole (angel ^. name) simpleVillagerRole+            setPlayerRole (angel ^. name) simpleVillagerRole          advanceStage @@ -137,39 +145,33 @@          advanceStage -    VillagesTurn -> do-        playersCount    <- uses players (length . filterAlive)-        votes'          <- use votes+    UrsussGrunt -> do+        bearTamer   <- findPlayerByRole_ bearTamerRole+        players'    <- cons bearTamer <$> gets (getAdjacentAlivePlayers $ bearTamer ^. name) -        when (playersCount == Map.size votes') $ do-            tell $ map (uncurry playerMadeLynchVoteMessage) (Map.toList votes')+        when (any isWerewolf players') $ tell [ursusGruntsMessage] -            getVoteResult >>= \votees -> case votees of-                [votee]   -> do-                    killPlayer $ votee ^. name-                    tell [playerLynchedMessage votee]-                _               ->-                    findPlayerByRole scapegoatRole >>= \mScapegoat -> case mScapegoat of-                        Just scapegoat  -> killPlayer (scapegoat ^. name) >> tell [scapegoatLynchedMessage (scapegoat ^. name)]-                        _               -> tell [noPlayerLynchedMessage]+        advanceStage -            advanceStage+    VillagesTurn -> whenM (null <$> liftM2 intersect getAllowedVoters getPendingVoters) $ do+        tell . map (uncurry playerMadeLynchVoteMessage) =<< uses votes Map.toList -    WerewolvesTurn -> do-        aliveWerewolves <- uses players (filterAlive . filterWerewolves)+        getVoteResult >>= lynchVotees -        whenM (uses votes $ (length aliveWerewolves ==) . Map.size) $ do-            getVoteResult >>= \votees -> case votees of-                [target]    ->-                    ifM (uses protect $ maybe False (== target ^. name))-                        (events %= cons NoDevourEvent)-                        (events %= cons (DevourEvent $ target ^. name))-                _           -> events %= cons NoDevourEvent+        allowedVoters'  <- ifM (use villageIdiotRevealed)+            (uses players (filter $ not . isVillageIdiot))+            (use players)+        allowedVoters   .= map (view name) (filterAlive allowedVoters') -            protect .= Nothing+        advanceStage -            advanceStage+    WerewolvesTurn -> whenM (null . filterWerewolves <$> getPendingVoters) $ do+        getVoteResult >>= devourVotees +        protect .= Nothing++        advanceStage+     WildChildsTurn -> do         whenM (isDead <$> findPlayerByRole_ wildChildRole) advanceStage @@ -193,6 +195,29 @@      WolfHoundsTurn -> unlessM (uses players (any isWolfHound . filterAlive)) advanceStage +lynchVotees :: (MonadState Game m, MonadWriter [Message] m) => [Player] -> m ()+lynchVotees [votee]+    | isVillageIdiot votee  = do+        villageIdiotRevealed .= True++        tell [villageIdiotLynchedMessage $ votee ^. name]+    | otherwise             = do+        killPlayer (votee ^. name)+        tell [playerLynchedMessage votee]+lynchVotees _       = findAlivePlayerByRole scapegoatRole >>= \mScapegoat -> case mScapegoat of+    Just scapegoat  -> do+        scapegoatBlamed .= True++        killPlayer (scapegoat ^. name)+        tell [scapegoatLynchedMessage (scapegoat ^. name)]+    _               -> tell [noPlayerLynchedMessage]++devourVotees :: (MonadState Game m, MonadWriter [Message] m) => [Player] -> m ()+devourVotees [votee]    = ifM (uses protect $ maybe False (== votee ^. name))+    (events %= cons NoDevourEvent)+    (events %= cons (DevourEvent $ votee ^. name))+devourVotees _          = events %= cons NoDevourEvent+ advanceStage :: (MonadState Game m, MonadWriter [Message] m) => m () advanceStage = do     game                <- get@@ -275,15 +300,18 @@ findPlayerByName_ :: MonadState Game m => Text -> m Player findPlayerByName_ name = uses players $ findByName_ name -findPlayerByRole :: MonadState Game m => Role -> m (Maybe Player)-findPlayerByRole role = uses players $ findByRole role- findPlayerByRole_ :: MonadState Game m => Role -> m Player findPlayerByRole_ role = uses players $ findByRole_ role +findAlivePlayerByRole :: MonadState Game m => Role -> m (Maybe Player)+findAlivePlayerByRole role = uses players $ findByRole role . filterAlive+ isDefendersTurn :: MonadState Game m => m Bool isDefendersTurn = gets Game.isDefendersTurn +isScapegoatsTurn :: MonadState Game m => m Bool+isScapegoatsTurn = gets Game.isScapegoatsTurn+ isSeersTurn :: MonadState Game m => m Bool isSeersTurn = gets Game.isSeersTurn @@ -311,6 +339,9 @@ getPlayerVote :: MonadState Game m => Text -> m (Maybe Text) getPlayerVote playerName = gets $ Game.getPlayerVote playerName +getAllowedVoters :: MonadState Game m => m [Player]+getAllowedVoters = gets Game.getAllowedVoters+ getPendingVoters :: MonadState Game m => m [Player] getPendingVoters = gets Game.getPendingVoters @@ -339,17 +370,23 @@ getDevourEvent = gets Game.getDevourEvent  createPlayers :: MonadIO m => [Text] -> [Role] -> m [Player]-createPlayers playerNames extraRoles = zipWith newPlayer playerNames <$> randomiseRoles extraRoles (length playerNames)+createPlayers playerNames roles = liftIO $ zipWith newPlayer playerNames <$> evalRandIO (shuffleM roles)  doesPlayerExist :: MonadState Game m => Text -> m Bool-doesPlayerExist name = uses players $ Player.doesPlayerExist name+doesPlayerExist name = gets $ Game.doesPlayerExist name  isPlayerDefender :: MonadState Game m => Text -> m Bool isPlayerDefender name = isDefender <$> findPlayerByName_ name +isPlayerScapegoat :: MonadState Game m => Text -> m Bool+isPlayerScapegoat name = isScapegoat <$> findPlayerByName_ name+ isPlayerSeer :: MonadState Game m => Text -> m Bool isPlayerSeer name = isSeer <$> findPlayerByName_ name +isPlayerVillageIdiot :: MonadState Game m => Text -> m Bool+isPlayerVillageIdiot name = isVillageIdiot <$> findPlayerByName_ name+ isPlayerWildChild :: MonadState Game m => Text -> m Bool isPlayerWildChild name = isWildChild <$> findPlayerByName_ name @@ -368,10 +405,19 @@ isPlayerDead :: MonadState Game m => Text -> m Bool isPlayerDead name = isDead <$> findPlayerByName_ name -randomiseRoles :: MonadIO m => [Role] -> Int -> m [Role]-randomiseRoles extraRoles n = liftIO . evalRandIO . shuffleM $ extraRoles ++ simpleVillagerRoles ++ simpleWerewolfRoles+padRoles :: [Role] -> Int -> [Role]+padRoles roles n = roles ++ simpleVillagerRoles ++ simpleWerewolfRoles     where-        extraWerewolfRoles = filter ((Role.Werewolves ==) . view allegiance) extraRoles+        goal                    = 2+        m                       = max (n - length roles) 0+        startingBalance         = sum (map (view balance) roles)+        simpleWerewolfBalance   = simpleWerewolfRole ^. balance -        simpleWerewolfRoles = replicate (n `quot` 6 + 1 - length extraWerewolfRoles) simpleWerewolfRole-        simpleVillagerRoles = replicate (n - length extraRoles - length simpleWerewolfRoles) simpleVillagerRole+        -- Little magic here to calculate how many Werewolves and Villagers we want.+        -- Essentially we get a 1:4 ratio of Werewolves to Villagers.+        simpleWerewolvesCount   = (goal - m - startingBalance) `div` (simpleWerewolfBalance - 1) + 1+        simpleVillagersCount    = m - simpleWerewolvesCount++        -- N.B., if roles is quite unbalanced then one list will be empty.+        simpleVillagerRoles = replicate simpleVillagersCount simpleVillagerRole+        simpleWerewolfRoles = replicate simpleWerewolvesCount simpleWerewolfRole

@@ -1,214 +1,30 @@ {-| Module      : Game.Werewolf.Game-Description : Game and stage data structures.+Description : Game data structure. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com -Game and stage data structures.+Game functions are defined in "Game.Werewolf.Internal.Game". This module just re-exports the+functions relevant to the public interface. -} -{-# LANGUAGE TemplateHaskell #-}- module Game.Werewolf.Game (     -- * Game-    Game, stage, round, players, events, passes, heal, healUsed, poison, poisonUsed, priorProtect,-    protect, roleModel, see, votes,-    newGame,--    -- ** Manipulations-    killPlayer, setPlayerRole, setPlayerAllegiance,--    -- ** Queries-    isFirstRound,-    getPassers, getPlayerVote, getPendingVoters, getVoteResult,+    Game, stage, round, players, events, passes, allowedVoters, heal, healUsed, poison, poisonUsed,+    priorProtect, protect, roleModel, scapegoatBlamed, see, villageIdiotRevealed, votes, -    -- * Stage     Stage(..),-    allStages,-    stageCycle, stageAvailable, -    -- ** Queries-    isGameOver, isDefendersTurn, isSeersTurn, isSunrise, isSunset, isVillagesTurn, isWerewolvesTurn,-    isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn,--    -- * Event     Event(..),      -- ** Queries-    getDevourEvent+    isDefendersTurn, isGameOver, isScapegoatsTurn, isSeersTurn, isSunrise, isSunset, isVillagesTurn,+    isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn,+    doesPlayerExist, ) where -import Control.Lens--import           Data.List.Extra-import           Data.Map        (Map)-import qualified Data.Map        as Map-import           Data.Maybe-import           Data.Text       (Text)--import Game.Werewolf.Player-import Game.Werewolf.Role   hiding (name)+import Game.Werewolf.Internal.Game  import Prelude hiding (round)--data Game = Game-    { _stage        :: Stage-    , _round        :: Int-    , _players      :: [Player]-    , _events       :: [Event]-    , _passes       :: [Text]-    , _heal         :: Bool-    , _healUsed     :: Bool-    , _poison       :: Maybe Text-    , _poisonUsed   :: Bool-    , _priorProtect :: Maybe Text-    , _protect      :: Maybe Text-    , _roleModel    :: Maybe Text-    , _see          :: Maybe Text-    , _votes        :: Map Text Text-    } deriving (Eq, Read, Show)--data Stage  = GameOver | DefendersTurn | SeersTurn | Sunrise | Sunset | VillagesTurn-            | WerewolvesTurn | WildChildsTurn | WitchsTurn | WolfHoundsTurn-    deriving (Eq, Read, Show)--data Event = DevourEvent Text | NoDevourEvent | PoisonEvent Text-    deriving (Eq, Read, Show)--makeLenses ''Game--makeLenses ''Stage--newGame :: [Player] -> Game-newGame players = game & stage .~ head (filter (stageAvailable game) stageCycle)-    where-        game = Game-            { _stage        = Sunset-            , _round        = 0-            , _players      = players-            , _events       = []-            , _passes       = []-            , _heal         = False-            , _healUsed     = False-            , _poison       = Nothing-            , _poisonUsed   = False-            , _priorProtect = Nothing-            , _protect      = Nothing-            , _roleModel    = Nothing-            , _see          = Nothing-            , _votes        = Map.empty-            }--killPlayer :: Text -> Game -> Game-killPlayer name' game = game & players %~ map (\player -> if player ^. name == name' then player & state .~ Dead else player)--setPlayerRole :: Text -> Role -> Game -> Game-setPlayerRole name' role' game = game & players %~ map (\player -> if player ^. name == name' then player & role .~ role' else player)--setPlayerAllegiance :: Text -> Allegiance -> Game -> Game-setPlayerAllegiance name' allegiance' game = game & players %~ map (\player -> if player ^. name == name' then player & role . allegiance .~ allegiance' else player)--isFirstRound :: Game -> Bool-isFirstRound game = game ^. round == 0--getPassers :: Game -> [Player]-getPassers game = map (`findByName_` players') passes'-    where-        players'    = game ^. players-        passes'     = game ^. passes--getPlayerVote :: Text -> Game -> Maybe Text-getPlayerVote playerName game = game ^. votes . at playerName--getPendingVoters :: Game -> [Player]-getPendingVoters game = filter (flip Map.notMember votes' . view name) alivePlayers-    where-        votes'          = game ^. votes-        alivePlayers    = filterAlive $ game ^. players--getVoteResult :: Game -> [Player]-getVoteResult game = map (`findByName_` players') result-    where-        players'    = game ^. players-        votees      = Map.elems $ game ^. votes-        result      = last $ groupSortOn (\votee -> length $ elemIndices votee votees) (nub votees)--allStages :: [Stage]-allStages =-    [ GameOver-    , DefendersTurn-    , SeersTurn-    , Sunrise-    , Sunset-    , VillagesTurn-    , WerewolvesTurn-    , WildChildsTurn-    , WitchsTurn-    , WolfHoundsTurn-    ]--stageCycle :: [Stage]-stageCycle = cycle-    [ VillagesTurn-    , Sunset-    , SeersTurn-    , WildChildsTurn-    , DefendersTurn-    , WolfHoundsTurn-    , WerewolvesTurn-    , WitchsTurn-    , Sunrise-    ]--stageAvailable :: Game -> Stage -> Bool-stageAvailable _ GameOver           = False-stageAvailable game DefendersTurn   = any isDefender (filterAlive $ game ^. players)-stageAvailable game SeersTurn       = any isSeer (filterAlive $ game ^. players)-stageAvailable _ Sunrise            = True-stageAvailable _ Sunset             = True-stageAvailable game VillagesTurn    =-    any isAngel (filterAlive $ game ^. players)-    || not (isFirstRound game)-stageAvailable game WerewolvesTurn  = any isWerewolf (filterAlive $ game ^. players)-stageAvailable game WildChildsTurn  =-    any isWildChild (filterAlive $ game ^. players)-    && isNothing (game ^. roleModel)-stageAvailable game WitchsTurn      =-    any isWitch (filterAlive $ game ^. players)-    && (not (game ^. healUsed) || not (game ^. poisonUsed))-stageAvailable game WolfHoundsTurn  = any isWolfHound (filterAlive $ game ^. players)--isGameOver :: Game -> Bool-isGameOver game = game ^. stage == GameOver--isDefendersTurn :: Game -> Bool-isDefendersTurn game = game ^. stage == DefendersTurn--isSeersTurn :: Game -> Bool-isSeersTurn game = game ^. stage == SeersTurn--isSunrise :: Game -> Bool-isSunrise game = game ^. stage == Sunrise--isSunset :: Game -> Bool-isSunset game = game ^. stage == Sunset--isVillagesTurn :: Game -> Bool-isVillagesTurn game = game ^. stage == VillagesTurn--isWerewolvesTurn :: Game -> Bool-isWerewolvesTurn game = game ^. stage == WerewolvesTurn--isWildChildsTurn :: Game -> Bool-isWildChildsTurn game = game ^. stage == WildChildsTurn--isWitchsTurn :: Game -> Bool-isWitchsTurn game = game ^. stage == WitchsTurn--isWolfHoundsTurn :: Game -> Bool-isWolfHoundsTurn game = game ^. stage == WolfHoundsTurn--getDevourEvent :: Game -> Maybe Event-getDevourEvent game = listToMaybe [event | event@(DevourEvent _) <- game ^. events]

@@ -0,0 +1,309 @@+{-|+Module      : Game.Werewolf.Internal.Game+Description : Game data structure with functions for manipulating and querying the game state.+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++A game is not quite as simple as players! Roughly speaking though, this engine is /stateful/. The+game state only changes when a /command/ is issued (see "Game.Werewolf.Command"). Thus, this module+defines the game data structure and any fields required to keep track of the current state.++It also has a few additional functions for manipulating the game state.+-}++{-# LANGUAGE TemplateHaskell #-}++module Game.Werewolf.Internal.Game (+    -- * Game+    Game, stage, round, players, events, passes, allowedVoters, heal, healUsed, poison, poisonUsed,+    priorProtect, protect, roleModel, scapegoatBlamed, see, villageIdiotRevealed, votes,++    Stage(..),+    allStages,+    stageCycle, stageAvailable,++    Event(..),++    newGame,++    -- ** Manipulations+    killPlayer, setPlayerRole, setPlayerAllegiance,++    -- ** Searches+    getAdjacentAlivePlayers, getDevourEvent, getPassers, getPlayerVote, getAllowedVoters,+    getPendingVoters, getVoteResult,++    -- ** Queries+    isDefendersTurn, isGameOver, isScapegoatsTurn, isSeersTurn, isSunrise, isSunset, isVillagesTurn,+    isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn,+    isFirstRound,+    doesPlayerExist,+) where++import Control.Lens++import           Data.List.Extra+import           Data.Map        (Map)+import qualified Data.Map        as Map+import           Data.Maybe+import           Data.Text       (Text)++import Game.Werewolf.Internal.Player+import Game.Werewolf.Internal.Role   hiding (name)++import Prelude hiding (round)++-- | There are a few key pieces of information that a game always needs to hold. These are:+--+--   * the @stage@,+--   * the @round@ number,+--   * the @players@ and+--   * the @events@.+--+--   Any further fields on the game are specific to one or more roles (and their respective turns!).+--   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 Wild-child's @roleModel@).+--+--   In order to advance a game's state, a 'Game.Werewolf.Command.Command' from a user needs to be received. Afterwards+--   the following steps should be performed:+--+--   1. 'Game.Werewolf.Command.apply' the 'Game.Werewolf.Command.Command'.+--   2. run 'Game.Werewolf.Engine.checkStage'.+--   3. run 'Game.Werewolf.Engine.checkGameOver'.+--+--   'Game.Werewolf.Engine.checkStage' will perform any additional checks and manipulations to the+--   game state before advancing the game's @stage@. It also runs any relevant @events@.+--   'Game.Werewolf.Engine.checkGameOver' will check to see if any of the win conditions are met and+--   if so, advance the game's @stage@ to 'GameOver'.+data Game = Game+    { _stage                :: Stage+    , _round                :: Int+    , _players              :: [Player]+    , _events               :: [Event]+    , _allowedVoters        :: [Text]           -- ^ Scapegoat+    , _heal                 :: Bool             -- ^ Witch+    , _healUsed             :: Bool             -- ^ Witch+    , _passes               :: [Text]           -- ^ Witch+    , _poison               :: Maybe Text       -- ^ Witch+    , _poisonUsed           :: Bool             -- ^ Witch+    , _priorProtect         :: Maybe Text       -- ^ Defender+    , _protect              :: Maybe Text       -- ^ Defender+    , _roleModel            :: Maybe Text       -- ^ Wild-child+    , _scapegoatBlamed      :: Bool             -- ^ Scapegoat+    , _see                  :: Maybe Text       -- ^ Seer+    , _villageIdiotRevealed :: Bool             -- ^ Village Idiot+    , _votes                :: Map Text Text    -- ^ Villagers and Werewolves+    } deriving (Eq, Read, Show)++-- | Most of these are fairly self-sufficient (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 'Game.Werewolf.Command.Command' to help push+--   it past. Often only certain roles and commands may be performed at any given stage.+data Stage  = GameOver | DefendersTurn | ScapegoatsTurn | SeersTurn | Sunrise | Sunset+            | UrsussGrunt | VillagesTurn | WerewolvesTurn | WildChildsTurn | WitchsTurn+            | WolfHoundsTurn+    deriving (Eq, Read, Show)++-- | Events occur /after/ a stage is advanced. This is automatically handled in+--   'Game.Werewolf.Engine.checkStage', while an event's specific behaviour is defined by+--   'Game.Werewolf.Engine.eventAvailable' and 'Game.Werewolf.Engine.applyEvent'.+--+--   For the most part events are used to allow something to happen on a stage different to when it+--   was triggered. E.g., the devour event occurs after the village wakes up rather than when the+--   Werewolves' vote, this gives the Witch a chance to heal the victim.+data Event  = DevourEvent Text  -- ^ Werewolves+            | NoDevourEvent     -- ^ Defender, Werewolves and Witch+            | PoisonEvent Text  -- ^ Witch+    deriving (Eq, Read, Show)++makeLenses ''Game++-- | All of the stages in the order that they should occur.+allStages :: [Stage]+allStages =+    [ VillagesTurn+    , ScapegoatsTurn+    , Sunset+    , SeersTurn+    , WildChildsTurn+    , DefendersTurn+    , WolfHoundsTurn+    , WerewolvesTurn+    , WitchsTurn+    , Sunrise+    , UrsussGrunt+    , GameOver+    ]++-- | An infinite cycle of all stages in the order that they should occur.+stageCycle :: [Stage]+stageCycle = cycle allStages++-- | Checks whether the stage is available for the given game. Most often this just involves+--   checking if there is an applicable role alive, but sometimes it is more complex.+--+--   One of the most complex checks here is for the 'VillagesTurn'. If the 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 DefendersTurn   = any isDefender (filterAlive $ game ^. players)+stageAvailable _ GameOver           = False+stageAvailable game ScapegoatsTurn  = game ^. scapegoatBlamed+stageAvailable game SeersTurn       = any isSeer (filterAlive $ game ^. players)+stageAvailable _ Sunrise            = True+stageAvailable _ Sunset             = True+stageAvailable game UrsussGrunt     = any isBearTamer (filterAlive $ game ^. players)+stageAvailable game VillagesTurn    =+    (any isAngel (filterAlive $ game ^. players)+    || not (isFirstRound game))+    && any isAlive (getAllowedVoters game)+stageAvailable game WerewolvesTurn  = any isWerewolf (filterAlive $ game ^. players)+stageAvailable game WildChildsTurn  =+    any isWildChild (filterAlive $ game ^. players)+    && isNothing (game ^. roleModel)+stageAvailable game WitchsTurn      =+    any isWitch (filterAlive $ game ^. players)+    && (not (game ^. healUsed) || not (game ^. poisonUsed))+stageAvailable game WolfHoundsTurn  = any isWolfHound (filterAlive $ game ^. players)++-- | Creates a new game with the given players. No validations are performed here, those are left to+--   'Game.Werewolf.Engine.startGame'.+newGame :: [Player] -> Game+newGame players = game & stage .~ head (filter (stageAvailable game) stageCycle)+    where+        game = Game+            { _stage                = Sunset+            , _round                = 0+            , _players              = players+            , _events               = []+            , _passes               = []+            , _allowedVoters        = map (view name) players+            , _heal                 = False+            , _healUsed             = False+            , _poison               = Nothing+            , _poisonUsed           = False+            , _priorProtect         = Nothing+            , _protect              = Nothing+            , _roleModel            = Nothing+            , _scapegoatBlamed      = False+            , _see                  = Nothing+            , _villageIdiotRevealed = False+            , _votes                = Map.empty+            }++-- | Kills the given player! This function should be used carefully as it doesn't clear any state+--   that the player's role may use. If you're after just removing a player from a game for a test,+--   try using a 'Game.Werewolf.Command.quitCommand' instead.+killPlayer :: Text -> Game -> Game+killPlayer name' game = game & players %~ map (\player -> if player ^. name == name' then player & state .~ Dead else player)++-- | Fudges the player's role by completely setting it to something new. This function is useful for+--   roles such as the Angel where they become something else given some trigger.+setPlayerRole :: Text -> Role -> Game -> Game+setPlayerRole name' role' game = game & players %~ map (\player -> if player ^. name == name' then player & role .~ role' else player)++-- | Fudges the player's allegiance. This function is useful for roles such as the Wild-child where+--   they align themselves differently given some trigger.+setPlayerAllegiance :: Text -> Allegiance -> Game -> Game+setPlayerAllegiance name' allegiance' game = game & players %~ map (\player -> if player ^. name == name' then player & role . allegiance .~ allegiance' else player)++getAdjacentAlivePlayers :: Text -> Game -> [Player]+getAdjacentAlivePlayers name' game = adjacentAlivePlayers+    where+        players'    = filterAlive $ game ^. players+        index       = fromJust $ findIndex ((name' ==) . view name) players'++        adjacentAlivePlayers+            | index == 0    = last players' : take 2 players'+            | otherwise     = take 3 $ drop (index - 1) (cycle players')++-- | Gets all the @passes@ in a game (which is names only) and maps them to their player.+getPassers :: Game -> [Player]+getPassers game = map (`findByName_` players') passes'+    where+        players'    = game ^. players+        passes'     = game ^. passes++-- | Gets a player's vote.+getPlayerVote :: Text -> Game -> Maybe Text+getPlayerVote playerName game = game ^. votes . at playerName++-- | Gets all the @allowedVoters@ in a game (which is names only) and maps them to their player.+getAllowedVoters :: Game -> [Player]+getAllowedVoters game = map (`findByName_` players') (game ^. allowedVoters)+    where+        players' = game ^. players++-- | Gets all alive players that have yet to vote.+getPendingVoters :: Game -> [Player]+getPendingVoters game = filter (flip Map.notMember votes' . view name) alivePlayers+    where+        votes'          = game ^. votes+        alivePlayers    = filterAlive $ game ^. players++-- | Gets all players that had /the/ highest vote count. This could be 1 or more players depending+--   on whether the votes were in conflict.+getVoteResult :: Game -> [Player]+getVoteResult game = map (`findByName_` players') result+    where+        players'    = game ^. players+        votees      = Map.elems $ game ^. votes+        result      = last $ groupSortOn (\votee -> length $ elemIndices votee votees) (nub votees)++-- | Gets the devour event if it exists.+getDevourEvent :: Game -> Maybe Event+getDevourEvent game = listToMaybe [event | event@(DevourEvent _) <- game ^. events]++-- | @isDefendersTurn game = game ^. stage == DefendersTurn@+isDefendersTurn :: Game -> Bool+isDefendersTurn game = game ^. stage == DefendersTurn++-- | @isGameOver game = game ^. stage == GameOver@+isGameOver :: Game -> Bool+isGameOver game = game ^. stage == GameOver++-- | @isScapegoatsTurn game = game ^. stage == ScapegoatsTurn@+isScapegoatsTurn :: Game -> Bool+isScapegoatsTurn game = game ^. stage == ScapegoatsTurn++-- | @isSeersTurn game = game ^. stage == SeersTurn@+isSeersTurn :: Game -> Bool+isSeersTurn game = game ^. stage == SeersTurn++-- | @isSunrise game = game ^. stage == Sunrise@+isSunrise :: Game -> Bool+isSunrise game = game ^. stage == Sunrise++-- | @isSunset game = game ^. stage == Sunset@+isSunset :: Game -> Bool+isSunset game = game ^. stage == Sunset++-- | @isVillagesTurn game = game ^. stage == VillagesTurn@+isVillagesTurn :: Game -> Bool+isVillagesTurn game = game ^. stage == VillagesTurn++-- | @isWerewolvesTurn game = game ^. stage == WerewolvesTurn@+isWerewolvesTurn :: Game -> Bool+isWerewolvesTurn game = game ^. stage == WerewolvesTurn++-- | @isWildChildsTurn game = game ^. stage == WildChildsTurn@+isWildChildsTurn :: Game -> Bool+isWildChildsTurn game = game ^. stage == WildChildsTurn++-- | @isWitchsTurn game = game ^. stage == WitchsTurn@+isWitchsTurn :: Game -> Bool+isWitchsTurn game = game ^. stage == WitchsTurn++-- | @isWolfHoundsTurn game = game ^. stage == WolfHoundsTurn@+isWolfHoundsTurn :: Game -> Bool+isWolfHoundsTurn game = game ^. stage == WolfHoundsTurn++-- | @isFirstRound game = game ^. round == 0@+isFirstRound :: Game -> Bool+isFirstRound game = game ^. round == 0++-- | Queries whether the player is in the game.+doesPlayerExist :: Text -> Game -> Bool+doesPlayerExist name = isJust . findByName name . view players

@@ -0,0 +1,180 @@+{-|+Module      : Game.Werewolf.Internal.Player+Description : Simplistic player data structure with functions for searching, filtering and querying+              lists of players.+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Players are quite simple in themselves. They have a @name@, @role@ and @state@. Any complex+behaviour is handled in "Game.Werewolf.Command" and "Game.Werewolf.Engine". This module provides+utility functions for searching, filtering and querying lists of players based on these 3+attributes.+-}++{-# LANGUAGE TemplateHaskell #-}++module Game.Werewolf.Internal.Player (+    -- * Player+    Player, name, role, state,++    State(..),++    newPlayer,++    -- ** Searches+    findByName, findByName_, findByRole, findByRole_,++    -- ** Filters+    filterByRole,+    filterWerewolves,+    filterAlive, filterDead,++    -- ** Queries+    isAngel, isBearTamer, isDefender, isScapegoat, isSeer, isSimpleVillager, isSimpleWerewolf,+    isVillageIdiot, isVillagerVillager, isWildChild, isWitch, isWolfHound,+    isVillager, isWerewolf,+    isAlive, isDead,+) where++import Control.Lens++import Data.Function+import Data.List+import Data.Maybe+import Data.Text     (Text)++import Game.Werewolf.Internal.Role hiding (name)++-- | A player has a @name@, @role@ and @state@. Any stateful information needed for a player's role+--   is held on the 'Game' itself.+--+--   N.B., player equality is defined on just the @name@ as a player's @role@ may change throughout+--   the game.+data Player = Player+    { _name  :: Text+    , _role  :: Role+    , _state :: State+    } deriving (Read, Show)++-- | Surprise surprise, players may be dead or alive.+data State = Alive | Dead+    deriving (Eq, Read, Show)++makeLenses ''Player++instance Eq Player where+    (==) = (==) `on` view name++-- | Creates a new 'Alive' player.+newPlayer :: Text -> Role -> Player+newPlayer name role = Player name role Alive++-- | Attempts to find the first player in the list with the given name.+findByName :: Text -> [Player] -> Maybe Player+findByName name' = find ((name' ==) . view name)++-- | Finds the first player in the list with the given name.+--+--   @findByName_ name = fromJust . findByName name@+findByName_ :: Text -> [Player] -> Player+findByName_ name = fromJust . findByName name++-- | Attempts to find the first player in the list with the given role.+findByRole :: Role -> [Player] -> Maybe Player+findByRole role' = find ((role' ==) . view role)++-- | Finds the first player in the list with the given role.+--+--   @findByRole_ role = fromJust . findByRole role@+findByRole_ :: Role -> [Player] -> Player+findByRole_ role = fromJust . findByRole role++-- | Filters players by role.+filterByRole :: Role -> [Player] -> [Player]+filterByRole role' = filter ((role' ==) . view role)++-- | Filters players by allegiance, not role.+--   If you're after filtering by role, try @filterByRole simpleWerewolfRole@.+--+--   @filterWerewolves = filter isWerewolf@+filterWerewolves :: [Player] -> [Player]+filterWerewolves = filter isWerewolf++-- | @filterAlive = filter isAlive@+filterAlive :: [Player] -> [Player]+filterAlive = filter isAlive++-- | @filterDead = filter isDead@+filterDead :: [Player] -> [Player]+filterDead = filter isDead++-- | @isAngel player = player ^. role == 'angelRole'@+isAngel :: Player -> Bool+isAngel player = player ^. role == angelRole++-- | @isBearTamer player = player ^. role == 'bearTamerRole'@+isBearTamer :: Player -> Bool+isBearTamer player = player ^. role == bearTamerRole++-- | @isDefender player = player ^. role == 'defenderRole'@+isDefender :: Player -> Bool+isDefender player = player ^. role == defenderRole++-- | @isScapegoat player = player ^. role == 'scapegoatRole'@+isScapegoat :: Player -> Bool+isScapegoat player = player ^. role == scapegoatRole++-- | @isSeer player = player ^. role == 'seerRole'@+isSeer :: Player -> Bool+isSeer player = player ^. role == seerRole++-- | @isSimpleVillager player = player ^. role == 'simpleVillagerRole'@+isSimpleVillager :: Player -> Bool+isSimpleVillager player = player ^. role == simpleVillagerRole++-- | @isSimpleWerewolf player = player ^. role == 'simpleWerewolfRole'@+isSimpleWerewolf :: Player -> Bool+isSimpleWerewolf player = player ^. role == simpleWerewolfRole++-- | @isVillageIdiot player = player ^. role == 'villageIdiotRole'@+isVillageIdiot :: Player -> Bool+isVillageIdiot player = player ^. role == villageIdiotRole++-- | @isVillagerVillager player = player ^. role == 'villagerVillagerRole'@+isVillagerVillager :: Player -> Bool+isVillagerVillager player = player ^. role == villagerVillagerRole++-- | @isWildChild player = player ^. role == 'wildChildRole'@+isWildChild :: Player -> Bool+isWildChild player = player ^. role == wildChildRole++-- | @isWitch player = player ^. role == 'witchRole'@+isWitch :: Player -> Bool+isWitch player = player ^. role == witchRole++-- | @isWolfHound player = player ^. role == 'wolfHoundRole'@+isWolfHound :: Player -> Bool+isWolfHound player = player ^. role == wolfHoundRole++-- | Queries a player's allegiance, not role.+--   If you're after querying their role, try 'isSimpleVillager'.+--+--   @isVillager player = player ^. role . allegiance == Villagers@+isVillager :: Player -> Bool+isVillager player = player ^. role . allegiance == Villagers++-- | Queries a player's allegiance, not role.+--   If you're after querying their role, try 'isSimpleWerewolf'.+--+--   @isWerewolf player = player ^. role . allegiance == Werewolves@+isWerewolf :: Player -> Bool+isWerewolf player = player ^. role . allegiance == Werewolves++-- | @isAlive player = player ^. state == Alive@+isAlive :: Player -> Bool+isAlive player = player ^. state == Alive++-- | @isDead player = player ^. state == Dead@+isDead :: Player -> Bool+isDead player = player ^. state == Dead

@@ -0,0 +1,380 @@+{-|+Module      : Game.Werewolf.Internal.Role+Description : Simplistic role data structure and instances.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++The roles are split into four categories:++* The Ambiguous.+* The Loners.+* The Villagers.+* The Werewolves.+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++module Game.Werewolf.Internal.Role (+    -- * Role+    Role, name, allegiance, balance, description, advice,++    Allegiance(..),++    -- ** Instances+    allRoles, restrictedRoles,+    allAllegiances,++    -- *** The Ambiguous+    -- | The Ambiguous may change allegiance during the game.+    wildChildRole, wolfHoundRole,++    -- *** The Loners+    -- | The Loners have their own win condition.+    angelRole,++    -- *** The Villagers+    -- | The Villagers must lynch all of the Werewolves.+    bearTamerRole, defenderRole, scapegoatRole, seerRole, simpleVillagerRole, villageIdiotRole,+    villagerVillagerRole, witchRole,++    -- *** The Werewolves+    -- | The Werewolves must devour all of the Villagers.+    simpleWerewolfRole,+) where++import Control.Lens++import           Data.Function+import           Data.List+import           Data.Text     (Text)+import qualified Data.Text     as T++import Prelude hiding (all)++-- | Role definitions require only a few pieces of information.+--   Most of the game logic behind a role is implemented in "Game.Werewolf.Command" and+--   "Game.Werewolf.Engine".+--+--   The @balance@ attribute on a role indicates the allegiance it favours. For example, a Simple+--   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.+data Role = Role+    { _name        :: Text+    , _allegiance  :: Allegiance+    , _balance     :: Int+    , _description :: Text+    , _advice      :: Text+    } deriving (Read, Show)++-- | The Loner allegiances are seldom used, rather they are present for correctness.+data Allegiance = Angel | Villagers | Werewolves+    deriving (Eq, Read, Show)++makeLenses ''Role++instance Eq Role where+    (==) = (==) `on` view name++-- | A list containing all the roles defined in this file.+allRoles :: [Role]+allRoles =+    [ angelRole+    , bearTamerRole+    , defenderRole+    , scapegoatRole+    , seerRole+    , simpleVillagerRole+    , villageIdiotRole+    , simpleWerewolfRole+    , villagerVillagerRole+    , wildChildRole+    , witchRole+    , wolfHoundRole+    ]++-- | A list containing roles that are restricted to a single instance per game.+--+--   @restrictedRoles = allRoles \\\\ [simpleVillagerRole, simpleWerewolfRole]@+restrictedRoles :: [Role]+restrictedRoles = allRoles \\ [simpleVillagerRole, simpleWerewolfRole]++-- | A list containing all the allegiances defined in this file.+--+--   TODO (hjw): use reflection to get this list+allAllegiances :: [Allegiance]+allAllegiances = [Angel, Villagers, Werewolves]++-- | /Abandoned in the woods by his parents at a young age, he was raised by wolves. As soon as he/+--   /learned how to walk on all fours, the Wild-child began to wander around Miller's Hollow. One/+--   /day, fascinated by an inhabitant of the village who was walking upright with grace and/+--   /presence, he made them his secret role model. He then decided to integrate himself into the/+--   /community of Miller's Hollow and entered, worried, in the village. The community was moved by/+--   /his frailty, adopted him, and welcomed him in their fold. What will become of him: honest/+--   /Villager or terrible Werewolf? For all of his life, the heart of the Wild-child will swing/+--   /between these two alternatives. May his model confirm him in his newfound humanity./+--+--   On the first night, the Wild-child may choose a player to become his role model. If during the+--   game the chosen player is eliminated, the Wild-child becomes a Werewolf. He will then wake up+--   the next night with his peers and will devour with them each night until the end of the game.+--   However for as long as the Wild-child's role model is alive, he remains a Villager.+wildChildRole :: Role+wildChildRole = Role+    { _name         = "Wild-child"+    , _allegiance   = Villagers+    , _balance      = -1+    , _description  = T.unwords+        [ "Abandoned in the woods by his parents at a young age, he was raised by wolves."+        , "As soon as he learned how to walk on all fours,"+        , "the Wild-child began to wander around Miller's Hollow."+        , "One day, fascinated by an inhabitant of the village who was walking upright"+        , "with grace and presence, he made them his secret role model."+        , "He then decided to integrate himself into the community of Miller's Hollow and entered,"+        , "worried, in the village."+        , "The community was moved by his frailty, adopted him, and welcomed him in their fold."+        , "What will become of him: honest Villager or terrible Werewolf?"+        , "For all of his life,"+        , "the heart of the Wild-child will swing between these two alternatives."+        , "May his model confirm him in his newfound humanity."+        ]+    , _advice       = T.unwords+        [ "Nothing is keeping you from taking part in the elimination of your role model,"+        , "if you so wish..."+        ]+    }++-- | /All dogs know in the depths of their soul that their ancestors were wolves and that it's/+--   /mankind who has kept them in the state of childishness and fear, the faithful and generous/+--   /companions. In any case, only the Wolf-hound can decide if he'll obey his human and civilized/+--   /master or if he'll listen to the call of wild nature buried within him./+--+--   On the first night, he chooses if he wants to be a Simple Villager or Werewolf. The choice is+--   final.+wolfHoundRole :: Role+wolfHoundRole = Role+    { _name         = "Wolf-hound"+    , _allegiance   = Villagers+    , _balance      = -1+    , _description  = T.unwords+        [ "All dogs know in the depths of their soul that their ancestors were wolves"+        , "and that it's mankind who has kept them in the state of childishness and fear,"+        , "the faithful and generous companions."+        , "In any case, only the Wolf-hound can decide if he'll obey his human and civilized master"+        , "or if he'll listen to the call of wild nature buried within him."+        ]+    , _advice       =+        "The choice of being a Simple Villager or Werewolf is final, so decide carefully!"+    }++-- | /The muddy life of a village infested with evil creatures repulses him; he wishes to believe/+--   /he's the victim of a terrible nightmare, in order to finally wake up in his comfortable bed./+--+--   When the Angel is in play, the game always begins with the village's debate followed by an+--   elimination vote, and then the first night.+--+--   The Angel wins if he manages to get eliminated on the first round (day or night).+--   If he fails, then he becomes a Simple Villager for the rest of the game.+angelRole :: Role+angelRole = Role+    { _name         = "Angel"+    , _allegiance   = Angel+    , _balance      = 0+    , _description  = T.unwords+        [ "The muddy life of a village infested with evil creatures repulses him;"+        , "he wishes to believe he's the victim of a terrible nightmare,"+        , "in order to finally wake up in his comfortable bed."+        ]+    , _advice       = T.unwords+        [ "It's going to take all your guile and wits to con the village into eliminating you."+        , "Pretending to be a Werewolf is one tactic, but if it doesn't work then you may have just"+        , "dug yourself a hole for the rest of the game..."+        ]+    }++-- | /Ah! How sweet it is, in my memory, the sound of chains slipping onto the cobblestones of the/+--   /"Three Road" plaza, accompanied by the grunting of Ursus. Ah! How long ago it was that Titan,/+--   /the Bear Tamer, would lead his companion in a ballet so gravious that we'd cry every summer/+--   /in Miller's Hollow. Ursus even had the oh-so-previous ability to detect lycanthropes hidden/+--   /near him./+--+--   Each morning, right after the revelation of any possible nocturnal victims, if at least one+--   Werewolf is or ends up directly next to the Bear Tamer, then Ursus grunts to indicate danger to+--   all of the other players.+bearTamerRole :: Role+bearTamerRole = Role+    { _name         = "Bear Tamer"+    , _allegiance   = Villagers+    , _balance      = 2+    , _description  = T.unwords+        [ "Ah! How sweet it is, in my memory, the sound of chains slipping onto the cobblestones"+        , "of the \"Three Road\" plaza, accompanied by the grunting of Ursus."+        , "Ah! How long ago it was that Titan, the Bear Tamer, would lead his companion in a ballet"+        , "so gravious that we'd cry every summer in Miller's Hollow."+        , "Ursus even had the oh-so-previous ability to detect lycanthropes hidden near him."+        ]+    , _advice       =+        "Aren't you lucky to have a companion with a strong nose. Just don't let him wander off!"+    }++-- | /This character can save the Villagers from the bite of the Werewolves./+--+--   Each night the Defender is called before the Werewolves to select a player deserving of his+--   protection. That player is safe during the night (and only that night) against the Werewolves.+defenderRole :: Role+defenderRole = Role+    { _name         = "Defender"+    , _allegiance   = Villagers+    , _balance      = 2+    , _description  =+        "This character can save the Villagers from the bite of the Werewolves."+    , _advice       = T.unwords+        [ "Be careful: you can protect yourself,"+        , "but you're not allowed to protect the same player two nights in a row."+        ]+    }++-- | /It's sad to say, but in Miller's Hollow, when something doesn't go right it's always him who/+--   /unjustly suffers the consequences./+--+--   If the village's vote ends in a tie, it's the Scapegoat who is eliminated instead of no-one.+--+--   In this event, the Scapegoat has one last task to complete: he must choose whom is permitted to+--   vote or not on the next day.+scapegoatRole :: Role+scapegoatRole = Role+    { _name         = "Scapegoat"+    , _allegiance   = Villagers+    , _balance      = 1+    , _description  = T.unwords+        [ "It's sad to say, but in Miller's Hollow, when something doesn't go right"+        , "it's always him who unjustly suffers the consequences."+        ]+    , _advice       = T.unwords+        [ "Cross your fingers that the votes don't end up tied."+        , "If you do so happen to be that unlucky,"+        , "then be wary of whom you allow to vote on the next day."+        , "If you choose only one player and the Werewolves devour them in the night,"+        , "then there will be no village vote."+        ]+    }++-- | /A fortunate teller by other names, with the ability to see into fellow townsfolk and/+--   /determine their allegiance./+--+--   Each night the Seer sees the allegiance of a player of her choice.+seerRole :: Role+seerRole = Role+    { _name         = "Seer"+    , _allegiance   = Villagers+    , _balance      = 2+    , _description  = T.unwords+        [ "A fortunate teller by other names, with the ability to see into fellow"+        , "townsfolk and determine their allegiance."+        ]+    , _advice       = T.unwords+        [ "You should help the other Villagers,"+        , "but try to remain discreet so as to not arouse suspicion from any of the Werewolves."+        ]+    }++-- | /A simple, ordinary townsperson in every way. Their only weapons are the ability to analyze/+--   /behaviour to identify Werewolves, and the strength of their conviction to prevent the/+--   /execution of the innocents like themselves./+simpleVillagerRole :: Role+simpleVillagerRole = Role+    { _name         = "Simple Villager"+    , _allegiance   = Villagers+    , _balance      = 1+    , _description  = T.unwords+        [ "A simple, ordinary townsperson in every way."+        , "Their only weapons are the ability to analyze behaviour to identify Werewolves,"+        , "and the strength of their conviction to prevent"+        , "the execution of the innocents like themselves."+        ]+    , _advice       =+        "Bluffing can be a good technique, but you had better be convincing about what you say."+    }++-- | /What is a village without an idiot? He does pretty much nothing important, but he's so/+--   /charming that no one would want to hurt him./+--+--   If the village votes against the Village Idiot, his identity is revealed. At that moment the+--   Villagers understand their mistake and immediately let him be.+--+--   The Village Idiot continues to play but may no longer vote, as what would the vote of an idiot+--   be worth?+villageIdiotRole :: Role+villageIdiotRole = Role+    { _name         = "Village Idiot"+    , _allegiance   = Villagers+    , _balance      = 0+    , _description  = T.unwords+        [ "What is a village without an idiot?"+        , "He does pretty much nothing important,"+        , "but he's so charming that no one would want to hurt him."+        ]+    , _advice       =+        "Hah! As if advice would do you any good..."+    }++-- | /This person has a soul as clear and transparent as the water from a mountain stream. They/+--   /will deserve the attentive ear of their peers and will make their word decisive in crucial/+--   /moments./+--+--   When the game begins, the village is told the identity of the Villager-Villager, thus ensuring+--   certainty that its owner is truly an innocent Villager.+villagerVillagerRole :: Role+villagerVillagerRole = Role+    { _name         = "Villager-Villager"+    , _allegiance   = Villagers+    , _balance      = 2+    , _description  = T.unwords+        [ "This person has a soul as clear and transparent as the water from a mountain stream."+        , "They will deserve the attentive ear of their peers"+        , "and will make their word decisive in crucial moments."+        ]+    , _advice       = "You'll make friends quickly, but be wary about whom you trust."+    }++-- | /She knows how to brew two extremely powerful potions: a healing potion, to resurrect the/+--   /player devoured by the Werewolves, and a poison potion, used at night to eliminate a player./+--+--   The Witch is called after the Werewolves. She is allowed to use both potions in the same night+--   and is also allowed to heal herself.+witchRole :: Role+witchRole = Role+    { _name         = "Witch"+    , _allegiance   = Villagers+    , _balance      = 3+    , _description  = T.unwords+        [ "She knows how to brew two extremely powerful potions:"+        , "a healing potion, to resurrect the player devoured by the Werewolves,"+        , "and a poison potion, used at night to eliminate a player."+        ]+    , _advice       = T.unwords+        [ "Each potion may only be used once per game,"+        , "but there are no restrictions on using both of your potions in the same night."+        ]+    }++-- | /Each night they devour a Villager. During the day they try to hide their nocturnal identity/+--   /to avoid mob justice./+--+--   A Werewolf may never devour another Werewolf.+simpleWerewolfRole :: Role+simpleWerewolfRole = Role+    { _name         = "Simple Werewolf"+    , _allegiance   = Werewolves+    , _balance      = -4+    , _description  = T.unwords+        [ "Each night they devour a Villager."+        , "During the day they try to hide their nocturnal identity to avoid mob justice."+        ]+    , _advice       =+        "Voting to lynch your partner can be a good way to deflect suspicion from yourself."+    }

@@ -0,0 +1,539 @@+{-|+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 calling 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,++    -- ** Error messages+    playerDoesNotExistMessage, playerCannotDoThatMessage, playerCannotDoThatRightNowMessage,+    playerIsDeadMessage, targetIsDeadMessage,++    -- * Circle messages+    circleMessage,++    -- * Ping messages+    pingPlayerMessage, pingRoleMessage,++    -- * Status messages+    currentStageMessages, playersInGameMessage, waitingOnMessage,++    -- * Angel's turn messages+    angelJoinedVillagersMessage,++    -- * Bear Tamer's turn messages+    ursusGruntsMessage,++    -- * Defender's turn messages++    -- ** Error messages+    playerCannotProtectSamePlayerTwiceInARowMessage,++    -- * Scapegoat's turn messages+    scapegoatChoseAllowedVotersMessage,++    -- ** Error messages+    playerMustChooseAtLeastOneTargetMessage, playerCannotChooseVillageIdiotMessage,++    -- * Seer's turn messages+    playerSeenMessage,++    -- * Villages' turn messages+    playerMadeLynchVoteMessage, playerLynchedMessage, noPlayerLynchedMessage,+    scapegoatLynchedMessage, villageIdiotLynchedMessage,++    -- ** Error messages+    playerHasAlreadyVotedMessage, playerCannotLynchVillageIdiotMessage,++    -- * Werewolves' turn messages+    playerMadeDevourVoteMessage, playerDevouredMessage, noPlayerDevouredMessage,++    -- ** Error messages+    playerCannotDevourAnotherWerewolfMessage,++    -- * Wild-child's turn messages+    playerJoinedPackMessage, wildChildJoinedPackMessages,++    -- ** Error messages+    playerCannotChooseSelfMessage,++    -- * Witch's turn messages+    playerPoisonedMessage,++    -- ** Error messages+    playerHasAlreadyHealedMessage, playerHasAlreadyPoisonedMessage,++    -- * Wolf-hound's turn messages++    -- ** Error messages+    allegianceDoesNotExistMessage,+) where++import Control.Arrow+import Control.Lens++import           Data.List.Extra+import           Data.Maybe+import           Data.Text       (Text)+import qualified Data.Text       as T++import           Game.Werewolf.Internal.Game+import           Game.Werewolf.Internal.Player+import           Game.Werewolf.Internal.Role   hiding (name)+import qualified Game.Werewolf.Internal.Role   as Role+import           Game.Werewolf.Response++newGameMessages :: Game -> [Message]+newGameMessages game = concat+    [ [newPlayersInGameMessage players']+    , [rolesInGameMessage $ map (view role) players']+    , map newPlayerMessage players'+    , villagerVillagerMessages+    , stageMessages game+    ]+    where+        players'                    = game ^. players+        villagerVillagerMessages    = case findByRole villagerVillagerRole players' of+            Just villagerVillager   -> [villagerVillagerMessage $ villagerVillager ^. name]+            _                       -> []++newPlayersInGameMessage :: [Player] -> Message+newPlayersInGameMessage players = publicMessage $ T.concat+    [ "A new game of werewolf is starting with "+    , T.intercalate ", " playerNames, "!"+    ]+    where+        playerNames = map (view name) players++newPlayerMessage :: Player -> Message+newPlayerMessage player = privateMessage (player ^. name) $ T.intercalate "\n"+    [ T.concat ["You're ", article playerRole, " ", playerRole ^. Role.name, "."]+    , playerRole ^. description+    ]+    where+        playerRole = player ^. role++villagerVillagerMessage :: Text -> Message+villagerVillagerMessage 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 Villager-Villager."+    ]++stageMessages :: Game -> [Message]+stageMessages game = case game ^. stage of+    GameOver        -> []+    DefendersTurn   -> defendersTurnMessages defendersName+    ScapegoatsTurn  -> scapegoatsTurnMessages scapegoatsName+    SeersTurn       -> seersTurnMessages seersName+    Sunrise         -> [sunriseMessage]+    Sunset          -> [nightFallsMessage]+    UrsussGrunt     -> []+    VillagesTurn    -> if isFirstRound game+        then firstVillagesTurnMessages+        else villagesTurnMessages+    WerewolvesTurn  -> if isFirstRound game+        then firstWerewolvesTurnMessages aliveWerewolfNames+        else werewolvesTurnMessages aliveWerewolfNames+    WildChildsTurn  -> wildChildsTurnMessages wildChildsName+    WitchsTurn      -> witchsTurnMessages game+    WolfHoundsTurn  -> wolfHoundsTurnMessages wolfHoundsName+    where+        players'            = game ^. players+        defendersName       = findByRole_ defenderRole players' ^. name+        scapegoatsName      = findByRole_ scapegoatRole players' ^. name+        seersName           = findByRole_ seerRole players' ^. name+        aliveWerewolfNames  = map (view name) . filterAlive $ filterWerewolves players'+        wildChildsName      = findByRole_ wildChildRole players' ^. name+        wolfHoundsName      = findByRole_ wolfHoundRole players' ^. name++defendersTurnMessages :: Text -> [Message]+defendersTurnMessages to =+    [ publicMessage "The Defender wakes up."+    , privateMessage to "Whom would you like to `protect`?"+    ]++scapegoatsTurnMessages :: Text -> [Message]+scapegoatsTurnMessages scapegoatsName =+    [ publicMessage "Just before he burns to a complete crisp, he cries out a dying wish."+    , publicMessage $ T.concat [scapegoatsName, ", whom 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`?"+    ]++sunriseMessage :: Message+sunriseMessage = publicMessage "The sun rises. Everybody wakes up and opens their eyes..."++nightFallsMessage :: Message+nightFallsMessage = publicMessage "Night falls, the village is asleep."++firstVillagesTurnMessages :: [Message]+firstVillagesTurnMessages =+    publicMessage (T.unwords+        [ "Alas, again I regrettably yield advice: an angelic menace walks among you."+        , "Do not cast your votes lightly,"+        , "for he will relish in this opportunity to be free from his terrible nightmare."+        ])+    : villagesTurnMessages++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 =+    map (\to -> privateMessage to $ packMessage 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+            , "are also emerging from their homes."+            ]+        packNames werewolfName      = T.intercalate ", " (tos \\ [werewolfName])++werewolvesTurnMessages :: [Text] -> [Message]+werewolvesTurnMessages tos =+    publicMessage "The Werewolves wake up, recognise one another and choose a new victim."+    : groupMessages tos "Whom would you like to `vote` to devour?"++wildChildsTurnMessages :: Text -> [Message]+wildChildsTurnMessages to =+    [ publicMessage "The Wild-child wakes up."+    , privateMessage to "Whom do you `choose` to be your role model?"+    ]++witchsTurnMessages :: Game -> [Message]+witchsTurnMessages game = concat+    [ [wakeUpMessage]+    , devourMessages+    , healMessages+    , poisonMessages+    , [passMessage]+    ]+    where+        witchsName      = findByRole_ witchRole (game ^. players) ^. name+        wakeUpMessage   = publicMessage "The Witch wakes up."+        passMessage     = privateMessage witchsName "Type `pass` to end your turn."+        devourMessages  = case getDevourEvent game of+            Just (DevourEvent targetName)   ->+                [ privateMessage witchsName $+                    T.unwords ["You see", targetName, "sprawled outside bleeding uncontrollably."]+                ]+            _                               -> []+        healMessages+            | not (game ^. healUsed)+                && isJust (getDevourEvent game) = [privateMessage witchsName "Would you like to `heal` them?"]+            | otherwise                         = []+        poisonMessages+            | not (game ^. poisonUsed)          = [privateMessage witchsName "Would you like to `poison` anyone?"]+            | otherwise                         = []++wolfHoundsTurnMessages :: Text -> [Message]+wolfHoundsTurnMessages to =+    [ publicMessage "The Wolf-hound wakes up."+    , privateMessage to "Which allegiance do you `choose` to be aligned with?"+    ]++gameOverMessages :: Game -> [Message]+gameOverMessages game+    | any isAngel (filterDead $ game ^. players)    =+        concat+            [ [publicMessage "You should have heeded my warning, for now the Angel has been set free!"]+            , [publicMessage "The game is over! The Angel has won."]+            , [playerWonMessage $ angel ^. name]+            , map (playerLostMessage . view name) (players' \\ [angel])+            ]+    | length aliveAllegiances == 1                  = do+        let allegiance' = head aliveAllegiances++        concat+            [ [publicMessage $ T.unwords ["The game is over! The", T.pack $ show allegiance', "have won."]]+            , map (playerWonMessage . view name) (filter ((allegiance' ==) . view (role . allegiance)) players')+            , map (playerLostMessage . view name) (filter ((allegiance' /=) . view (role . allegiance)) players')+            ]+    | otherwise                                     = publicMessage "The game is over! Everyone died...":map (playerLostMessage . view name) players'+    where+        players'            = game ^. players+        angel               = findByRole_ angelRole players'+        aliveAllegiances    = nub $ map (view $ role . allegiance) (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!"]++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!"++targetIsDeadMessage :: Text -> Text -> Message+targetIsDeadMessage to targetName = privateMessage to $ T.unwords [targetName, "is already dead!"]++circleMessage :: Text -> [Player] -> Message+circleMessage to players = privateMessage to $ T.concat+    [ "The players are sitting in the following order:\n"+    , T.intercalate " <-> " (map playerName (players ++ [head players]))+    ]+    where+        playerName player = T.concat [player ^. name, if isDead 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 to GameOver    = [gameIsOverMessage to]+currentStageMessages _ Sunrise      = []+currentStageMessages _ Sunset       = []+currentStageMessages _ UrsussGrunt  = []+currentStageMessages to turn        = [privateMessage to $ T.concat+    [ "It's currently the ", showTurn turn, " turn."+    ]]+    where+        showTurn :: Stage -> Text+        showTurn DefendersTurn  = "Defender's"+        showTurn GameOver       = undefined+        showTurn ScapegoatsTurn = "Scapegoat's"+        showTurn SeersTurn      = "Seer's"+        showTurn Sunrise        = undefined+        showTurn Sunset         = undefined+        showTurn UrsussGrunt    = undefined+        showTurn VillagesTurn   = "Village's"+        showTurn WerewolvesTurn = "Werewolves'"+        showTurn WildChildsTurn = "Wild-child's"+        showTurn WitchsTurn     = "Witch's"+        showTurn WolfHoundsTurn = "Wolf-hound's"++rolesInGameMessage :: [Role] -> Message+rolesInGameMessage roles = publicMessage $ T.concat+    [ "The roles in play are "+    , T.intercalate ", " $ map (\(role, count) ->+        T.concat [role ^. Role.name, " (", T.pack $ show count, ")"])+        roleCounts+    , " for a total balance of ", T.pack $ show totalBalance, "."+    ]+    where+        roleCounts      = map (head &&& length) (groupSortOn (view Role.name) roles)+        totalBalance    = sum $ map (view balance) 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 (view 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 (view name) players++angelJoinedVillagersMessage :: Message+angelJoinedVillagersMessage = publicMessage $ T.unwords+    [ "You hear the Angel wrought with anger off in the distance."+    , "He failed to attract the discriminatory vote of the village"+    , "or the devouring vindictiveness of the lycanthropes."+    , "Now he is stuck here, doomed forever to live out a mortal life as a Simple Villager."+    ]++ursusGruntsMessage :: Message+ursusGruntsMessage = publicMessage $ T.unwords+    [ "Ursus wakes from his slumber, disturbed and on edge."+    , "He loudly grunts as if he smells danger."+    ]++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", T.intercalate ", " allowedVoters, "shall be allowed to vote."+    , "The town crier, realising how foolish it was to kill him, grants him this wish."+    ]++playerMustChooseAtLeastOneTargetMessage :: Text -> Message+playerMustChooseAtLeastOneTargetMessage to =+    privateMessage to "You must choose at least 1 target!"++playerCannotChooseVillageIdiotMessage :: Text -> Message+playerCannotChooseVillageIdiotMessage to =+    privateMessage to "You cannot choose the Village Idiot!"++playerSeenMessage :: Text -> Player -> Message+playerSeenMessage to target = privateMessage to $ T.concat+    [ targetName, " is aligned with the ", T.pack $ show allegiance', "."+    ]+    where+        targetName  = target ^. name+        allegiance' = 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+        && not (isWildChild 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, " ", playerRole ^. Role.name, "."+        , " 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, " ", playerRole ^. Role.name, "."+        ]+    where+        playerName = player ^. name+        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."+    ]++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."+    ]++villageIdiotLynchedMessage :: Text -> Message+villageIdiotLynchedMessage 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 that oaf, you know, John's boy!\""+    , " The Village Idiot is quickly untied and apologised to."+    ]++playerHasAlreadyVotedMessage :: Text -> Message+playerHasAlreadyVotedMessage to = privateMessage to "You've already voted!"++playerCannotLynchVillageIdiotMessage :: Text -> Message+playerCannotLynchVillageIdiotMessage to =+    privateMessage to "You cannot lynch the Village Idiot!"++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, " ", playerRole ^. Role.name, "."+    ]+    where+        playerName = player ^. name+        playerRole = player ^. role++noPlayerDevouredMessage :: Message+noPlayerDevouredMessage = publicMessage $ T.unwords+    [ "Surprisingly you see everyone present at the town square."+    , "Perhaps the Werewolves have left Miller's Hollow?"+    ]++playerCannotDevourAnotherWerewolfMessage :: Text -> Message+playerCannotDevourAnotherWerewolfMessage to = privateMessage to "You cannot devour another Werewolf!"++playerJoinedPackMessage :: Text -> [Text] -> Message+playerJoinedPackMessage to werewolfNames = privateMessage to $ T.unwords+    [ "The death of your role model is distressing."+    , "Without second thought you abandon the Villagers and run off into the woods,"+    , "towards your old home."+    , "As you arrive you see the familiar faces of", T.intercalate ", " werewolfNames+    , "waiting and happy to have you back."+    ]++wildChildJoinedPackMessages :: [Text] -> Text -> [Message]+wildChildJoinedPackMessages tos wildChildsName = groupMessages tos $ T.unwords+    [ wildChildsName, "the Wild-child scampers off into the woods."+    , "Without his role model nothing is holding back his true, wolfish, nature."+    ]++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."+    , player ^. name, "the", player ^. role . Role.name+    , "is lying in their bed, poisoned, drooling over the side."+    ]++playerHasAlreadyHealedMessage :: Text -> Message+playerHasAlreadyHealedMessage to = privateMessage to "You've already healed someone!"++playerHasAlreadyPoisonedMessage :: Text -> Message+playerHasAlreadyPoisonedMessage to = privateMessage to "You've already poisoned someone!"++allegianceDoesNotExistMessage :: Text -> Text -> Message+allegianceDoesNotExistMessage to name = privateMessage to $ T.unwords+    [ "Allegiance", name, "does not exist."+    ]++article :: Role -> Text+article role+    | role `elem` restrictedRoles   = "the"+    | otherwise                     = "a"

@@ -1,129 +1,19 @@ {-| Module      : Game.Werewolf.Player-Description : Player data structures.--Copyright   : (c) Henry J. Wylde, 2015+Description : Simplistic player data structure.+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com -Player data structures.+Player functions are defined in "Game.Werewolf.Internal.Player". This module just re-exports the+functions relevant to the public interface. -} -{-# LANGUAGE TemplateHaskell #-}- module Game.Werewolf.Player (     -- * Player     Player, name, role, state,-    newPlayer, -    -- ** Searches-    findByName, findByName_, findByRole, findByRole_,--    -- ** Filters-    filterByRole,-    filterWerewolves,--    -- ** Queries-    doesPlayerExist,-    isAngel, isDefender, isScapegoat, isSeer, isSimpleVillager, isSimpleWerewolf,-    isVillagerVillager, isWildChild, isWitch, isWolfHound,-    isVillager, isWerewolf,-    isAlive, isDead,--    -- * State     State(..),--    -- ** Filters-    filterAlive, filterDead, ) where -import Control.Lens--import Data.List-import Data.Maybe-import Data.Text  (Text)--import Game.Werewolf.Role hiding (name)--data Player = Player-    { _name  :: Text-    , _role  :: Role-    , _state :: State-    } deriving (Eq, Read, Show)--data State = Alive | Dead-    deriving (Eq, Read, Show)--makeLenses ''Player--newPlayer :: Text -> Role -> Player-newPlayer name role = Player name role Alive--findByName :: Text -> [Player] -> Maybe Player-findByName name' = find ((name' ==) . view name)--findByName_ :: Text -> [Player] -> Player-findByName_ name = fromJust . findByName name--findByRole :: Role -> [Player] -> Maybe Player-findByRole role' = find ((role' ==) . view role)--findByRole_ :: Role -> [Player] -> Player-findByRole_ role = fromJust . findByRole role--filterByRole :: Role -> [Player] -> [Player]-filterByRole role' = filter ((role' ==) . view role)--filterWerewolves :: [Player] -> [Player]-filterWerewolves = filter isWerewolf--doesPlayerExist :: Text -> [Player] -> Bool-doesPlayerExist name = isJust . findByName name--isAngel :: Player -> Bool-isAngel player = player ^. role == angelRole--isDefender :: Player -> Bool-isDefender player = player ^. role == defenderRole--isScapegoat :: Player -> Bool-isScapegoat player = player ^. role == scapegoatRole--isSeer :: Player -> Bool-isSeer player = player ^. role == seerRole--isSimpleVillager :: Player -> Bool-isSimpleVillager player = player ^. role == simpleVillagerRole--isSimpleWerewolf :: Player -> Bool-isSimpleWerewolf player = player ^. role == simpleWerewolfRole--isVillagerVillager :: Player -> Bool-isVillagerVillager player = player ^. role == villagerVillagerRole--isWildChild :: Player -> Bool-isWildChild player = player ^. role == wildChildRole--isWitch :: Player -> Bool-isWitch player = player ^. role == witchRole--isWolfHound :: Player -> Bool-isWolfHound player = player ^. role == wolfHoundRole--isVillager :: Player -> Bool-isVillager player = player ^. role . allegiance == Villagers--isWerewolf :: Player -> Bool-isWerewolf player = player ^. role . allegiance == Werewolves--isAlive :: Player -> Bool-isAlive player = player ^. state == Alive--isDead :: Player -> Bool-isDead player = player ^. state == Dead--filterAlive :: [Player] -> [Player]-filterAlive = filter isAlive--filterDead :: [Player] -> [Player]-filterDead = filter isDead+import Game.Werewolf.Internal.Player

@@ -2,16 +2,20 @@ Module      : Game.Werewolf.Response Description : Response and message data structures. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com -Response and message data structures.+A response is used as a return result of calling the @werewolf@ binary. Each response has a list of+associated messages.++@werewolf@ was designed to be ambivalent to the calling 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 CPP               #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP           #-}+{-# LANGUAGE DeriveGeneric #-}  module Game.Werewolf.Response (     -- * Response@@ -26,85 +30,30 @@     -- * Message     Message(..),     publicMessage, privateMessage, groupMessages,--    -- ** Binary messages-    noGameRunningMessage, gameAlreadyRunningMessage, engineVersionMessage,--    -- ** Generic messages-    newGameMessages, stageMessages, gameOverMessages, playerQuitMessage,--    -- ** Ping messages-    pingPlayerMessage, pingRoleMessage,--    -- ** Status messages-    currentStageMessages, playersInGameMessage, waitingOnMessage,--    -- ** Angel's turn messages-    angelJoinedVillagersMessage,--    -- ** Seer's turn messages-    playerSeenMessage,--    -- ** Villages' turn messages-    playerMadeLynchVoteMessage, playerLynchedMessage, noPlayerLynchedMessage,-    scapegoatLynchedMessage,--    -- ** Werewolves' turn messages-    playerMadeDevourVoteMessage, playerDevouredMessage, noPlayerDevouredMessage,--    -- ** Wild-child's turn messages-    playerJoinedPackMessage, wildChildJoinedPackMessages,--    -- ** Witch's turn messages-    playerPoisonedMessage,--    -- ** Generic error messages-    gameIsOverMessage, playerDoesNotExistMessage, playerCannotDoThatMessage,-    playerCannotDoThatRightNowMessage, playerIsDeadMessage, roleDoesNotExistMessage,-    allegianceDoesNotExistMessage,--    -- ** Defender's turn error messages-    playerCannotProtectSelfMessage, playerCannotProtectSamePlayerTwiceInARowMessage,--    -- ** Voting turn error messages-    playerHasAlreadyVotedMessage, targetIsDeadMessage,--    -- ** Werewolves' turn error messages-    playerCannotDevourAnotherWerewolfMessage,--    -- ** Wild-child's turn error messages-    playerCannotChooseSelfMessage,--    -- ** Witch's turn error messages-    playerHasAlreadyHealedMessage, playerHasAlreadyPoisonedMessage, ) 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.Maybe 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           Data.Version -import           Game.Werewolf.Game-import           Game.Werewolf.Player-import           Game.Werewolf.Role   hiding (name)-import qualified Game.Werewolf.Role   as Role-import           GHC.Generics+import GHC.Generics  import qualified System.Exit as Exit +-- | When a user sends a command to the @werewolf@ binary, a response is always returned.+--+--   The chat client interface should then relay any @messages@ from the response. Whether or not+--   the command was valid (indicated by the @ok@ flag) is often irrelevant as the returned+--   @messages@ will include errors to the user. data Response = Response-    { ok       :: Bool-    , messages :: [Message]+    { ok       :: Bool      -- ^ Boolean flag to indicate success.+    , messages :: [Message] -- ^ List of messages.     } deriving (Eq, Generic, Show)  instance FromJSON Response@@ -115,18 +64,30 @@     toEncoding  = genericToEncoding defaultOptions #endif +-- | A successful, empty response. success :: Response success = Response True [] +-- | An unsuccessful, empty response. failure :: Response failure = Response False [] +-- | Exits fast with the given response. The response is encoded as JSON, printed to @stdout@ and+--   then the program is exited with @0@ (success).+--+--   The program always exits with success even if the response was a failure one. This is to+--   distinguish between bad calls to the binary and bad commands to the werewolf engine. exitWith :: MonadIO m => Response -> m () exitWith response = liftIO $ T.putStrLn (T.decodeUtf8 $ encode response) >> Exit.exitSuccess +-- | A message may be either public or private, indicated by it's @to@ field.+--+--   Each message contains a single text field. This field is permitted to contain special+--   characters such as new lines and tabs. data Message = Message-    { to      :: Maybe Text-    , message :: Text+    { to      :: Maybe Text -- ^ The message recipient: 'Nothing' for a public message,+                            --   'Just' for a private message.+    , message :: Text       -- ^ The message text.     } deriving (Eq, Generic, Show)  instance FromJSON Message@@ -137,417 +98,18 @@     toEncoding  = genericToEncoding defaultOptions #endif +-- | Creates a public message with the given text. publicMessage :: Text -> Message publicMessage = Message Nothing +-- | @privateMessage to message@+--+--   Creates a private message to @to@ with the given text. privateMessage :: Text -> Text -> Message privateMessage to = Message (Just to) +-- | @groupMessages tos message@+--+--   Creates multiple private messages (1 to each recipient) with the given text. groupMessages :: [Text] -> Text -> [Message] groupMessages tos message = map (`privateMessage` 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."--engineVersionMessage :: Text -> Version -> Message-engineVersionMessage to version = privateMessage to $ T.unwords ["Version", T.pack $ showVersion version]--newGameMessages :: Game -> [Message]-newGameMessages game = concat-    [ [newPlayersInGameMessage players', rolesInGameMessage $ map (view role) players']-    , map newPlayerMessage players'-    , villagerVillagerMessages-    , stageMessages game-    ]-    where-        players'                    = game ^. players-        villagerVillagerMessages    =-            case findByRole villagerVillagerRole players' of-                Just villagerVillager   -> [villagerVillagerMessage $ villagerVillager ^. name]-                _                       -> []--newPlayersInGameMessage :: [Player] -> Message-newPlayersInGameMessage players = publicMessage $ T.concat-    [ "A new game of werewolf is starting with "-    , T.intercalate ", " playerNames, "!"-    ]-    where-        playerNames = map (view name) players--newPlayerMessage :: Player -> Message-newPlayerMessage player = privateMessage (player ^. name) $ T.intercalate "\n"-    [ T.concat ["You're ", article playerRole, " ", playerRole ^. Role.name, "."]-    , playerRole ^. description-    ]-    where-        playerRole = player ^. role--villagerVillagerMessage :: Text -> Message-villagerVillagerMessage 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 Villager-Villager."-    ]--stageMessages :: Game -> [Message]-stageMessages game = case game ^. stage of-    GameOver        -> []-    DefendersTurn   -> defendersTurnMessages defendersName-    SeersTurn       -> seersTurnMessages seersName-    Sunrise         -> [sunriseMessage]-    Sunset          -> [nightFallsMessage]-    VillagesTurn    -> if isFirstRound game-        then firstVillagesTurnMessages-        else villagesTurnMessages-    WerewolvesTurn  -> if isFirstRound game-        then firstWerewolvesTurnMessages aliveWerewolfNames-        else werewolvesTurnMessages aliveWerewolfNames-    WildChildsTurn  -> wildChildsTurnMessages wildChildsName-    WitchsTurn      -> witchsTurnMessages game-    WolfHoundsTurn  -> wolfHoundsTurnMessages wolfHoundsName-    where-        players'            = game ^. players-        defendersName       = findByRole_ defenderRole players' ^. name-        seersName           = findByRole_ seerRole players' ^. name-        aliveWerewolfNames  = map (view name) . filterAlive $ filterWerewolves players'-        wildChildsName      = findByRole_ wildChildRole players' ^. name-        wolfHoundsName      = findByRole_ wolfHoundRole players' ^. name--defendersTurnMessages :: Text -> [Message]-defendersTurnMessages to =-    [ publicMessage "The Defender wakes up."-    , privateMessage to "Whom would you like to `protect`?"-    ]--seersTurnMessages :: Text -> [Message]-seersTurnMessages to =-    [ publicMessage "The Seer wakes up."-    , privateMessage to "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."--firstVillagesTurnMessages :: [Message]-firstVillagesTurnMessages =-    ( publicMessage $ T.unwords-        [ "Alas, again I regrettably yield advice: an angelic menace walks among you."-        , "Do not cast your votes lightly,"-        , "for he will relish in this opportunity to be free from his terrible nightmare."-        ]-    ) : villagesTurnMessages--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 = concat-    [ map (\to -> privateMessage to $ packMessage 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-            , "are also emerging from their homes."-            ]-        packNames werewolfName      = T.intercalate ", " (tos \\ [werewolfName])--werewolvesTurnMessages :: [Text] -> [Message]-werewolvesTurnMessages tos =-    [ publicMessage "The Werewolves wake up, recognise one another and choose a new victim."-    ] ++ groupMessages tos "Whom would you like to `vote` to devour?"--wildChildsTurnMessages :: Text -> [Message]-wildChildsTurnMessages to =-    [ publicMessage "The Wild-child wakes up."-    , privateMessage to "Whom do you `choose` to be your role model?"-    ]--witchsTurnMessages :: Game -> [Message]-witchsTurnMessages game = concat-    [ [wakeUpMessage]-    , devourMessages-    , healMessages-    , poisonMessages-    , [passMessage]-    ]-    where-        witchsName      = findByRole_ witchRole (game ^. players) ^. name-        wakeUpMessage   = publicMessage "The Witch wakes up."-        passMessage     = privateMessage witchsName "Type `pass` to end your turn."-        devourMessages  = case getDevourEvent game of-            Just (DevourEvent targetName)   ->-                [ privateMessage witchsName $-                    T.unwords ["You see", targetName, "sprawled outside bleeding uncontrollably."]-                ]-            _                               -> []-        healMessages-            | not (game ^. healUsed)-                && isJust (getDevourEvent game) = [privateMessage witchsName "Would you like to `heal` them?"]-            | otherwise                         = []-        poisonMessages-            | not (game ^. poisonUsed)          = [privateMessage witchsName "Would you like to `poison` anyone?"]-            | otherwise                         = []--wolfHoundsTurnMessages :: Text -> [Message]-wolfHoundsTurnMessages to =-    [ publicMessage "The Wolf-hound wakes up."-    , privateMessage to "Which allegiance do you `choose` to be aligned with?"-    ]--gameOverMessages :: Game -> [Message]-gameOverMessages game-    | any isAngel (filterDead $ game ^. players)    =-        concat-            [ [publicMessage "You should have heeded my warning, for now the Angel has been set free!"]-            , [publicMessage "The game is over! The Angel has won."]-            , [playerWonMessage $ angel ^. name]-            , map (playerLostMessage . view name) (players' \\ [angel])-            ]-    | length aliveAllegiances == 1                  = do-        let allegiance' = head aliveAllegiances--        concat-            [ [publicMessage $ T.unwords ["The game is over! The", T.pack $ show allegiance', "have won."]]-            , map (playerWonMessage . view name) (filter ((allegiance' ==) . view (role . allegiance)) players')-            , map (playerLostMessage . view name) (filter ((allegiance' /=) . view (role . allegiance)) players')-            ]-    | otherwise                                     = publicMessage "The game is over! Everyone died...":map (playerLostMessage . view name) players'-    where-        players'            = game ^. players-        angel               = findByRole_ angelRole players'-        aliveAllegiances    = nub $ map (view $ role . allegiance) (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..."--pingRoleMessage :: Text -> Message-pingRoleMessage roleName = publicMessage $ T.concat ["Waiting on the ", roleName, "..."]--currentStageMessages :: Text -> Stage -> [Message]-currentStageMessages to GameOver    = [gameIsOverMessage to]-currentStageMessages _ Sunrise      = []-currentStageMessages _ Sunset       = []-currentStageMessages to turn        = [privateMessage to $ T.concat-    [ "It's currently the ", showTurn turn, " turn."-    ]]-    where-        showTurn :: Stage -> Text-        showTurn DefendersTurn  = "Defender's"-        showTurn GameOver       = undefined-        showTurn SeersTurn      = "Seer's"-        showTurn Sunrise        = undefined-        showTurn Sunset         = undefined-        showTurn VillagesTurn   = "Village's"-        showTurn WerewolvesTurn = "Werewolves'"-        showTurn WildChildsTurn = "Wild-child's"-        showTurn WitchsTurn     = "Witch's"-        showTurn WolfHoundsTurn = "Wolf-hound's"--rolesInGameMessage :: [Role] -> Message-rolesInGameMessage roles = publicMessage $ 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 (view 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 (view 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 (view name) players--angelJoinedVillagersMessage :: Message-angelJoinedVillagersMessage = publicMessage $ T.unwords-    [ "You hear the Angel wrought with anger off in the distance."-    , "He failed to attract the discriminatory vote of the village"-    , "or the devouring vindictiveness of the lycanthropes."-    , "Now he is stuck here, doomed forever to live out a mortal life as a Simple Villager."-    ]--playerSeenMessage :: Text -> Player -> Message-playerSeenMessage to target = privateMessage to $ T.concat-    [ targetName, " is aligned with the ", T.pack $ show allegiance', "."-    ]-    where-        targetName  = target ^. name-        allegiance' = 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-        && not (isWildChild 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, " ", playerRole ^. Role.name, "."-        , " 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, " ", playerRole ^. Role.name, "."-        ]-    where-        playerName = player ^. name-        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."-    ]--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 "-    , playerName, "'s guts half devoured and spilling out over the cobblestones."-    , " From the look of their personal effects, you deduce they were "-    , article playerRole, " ", playerRole ^. Role.name, "."-    ]-    where-        playerName = player ^. name-        playerRole = player ^. role--noPlayerDevouredMessage :: Message-noPlayerDevouredMessage = publicMessage $ T.unwords-    [ "Surprisingly you see everyone present at the town square."-    , "Perhaps the Werewolves have left Miller's Hollow?"-    ]--playerJoinedPackMessage :: Text -> [Text] -> Message-playerJoinedPackMessage to werewolfNames = privateMessage to $ T.unwords-    [ "The death of your role model is distressing."-    , "Without second thought you abandon the Villagers and run off into the woods,"-    , "towards your old home."-    , "As you arrive you see the familiar faces of", T.intercalate ", " werewolfNames-    , "waiting and happy to have you back."-    ]--wildChildJoinedPackMessages :: [Text] -> Text -> [Message]-wildChildJoinedPackMessages tos wildChildsName = groupMessages tos $ T.unwords-    [ wildChildsName, "the Wild-child scampers off into the woods."-    , "Without his role model nothing is holding back his true, wolfish, nature."-    ]--playerPoisonedMessage :: Player -> Message-playerPoisonedMessage player = publicMessage $ T.unwords-    [ "Upon further discovery, it looks like the Witch struck in the night."-    , player ^. name, "the", player ^. role . Role.name-    , "is lying in their bed, poisoned, drooling over the side."-    ]--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."]--allegianceDoesNotExistMessage :: Text -> Text -> Message-allegianceDoesNotExistMessage to name = privateMessage to $ T.unwords-    [ "Allegiance", name, "does not exist."-    ]--playerCannotProtectSelfMessage :: Text -> Message-playerCannotProtectSelfMessage to = privateMessage to "You cannot protect yourself!"--playerCannotProtectSamePlayerTwiceInARowMessage :: Text -> Message-playerCannotProtectSamePlayerTwiceInARowMessage to =-    privateMessage to "You cannot protect the same player twice in a row!"--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!"-    ]--playerCannotDevourAnotherWerewolfMessage :: Text -> Message-playerCannotDevourAnotherWerewolfMessage to =-    privateMessage to "You cannot devour another Werewolf!"--playerCannotChooseSelfMessage :: Text -> Message-playerCannotChooseSelfMessage to = privateMessage to "You cannot choose yourself!"--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"

@@ -1,219 +1,23 @@ {-| Module      : Game.Werewolf.Role-Description : Role data structures.+Description : Simplistic role data structure and instances. -Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com -Role data structures.+Role instances are defined in "Game.Werewolf.Internal.Role". This module just re-exports the+functions relevant to the public interface. -} -{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell   #-}- module Game.Werewolf.Role (     -- * Role-    Role, name, allegiance, description, advice,--    -- ** Instances-    allRoles, restrictedRoles,-    angelRole, defenderRole, scapegoatRole, seerRole, simpleVillagerRole, simpleWerewolfRole,-    villagerVillagerRole, wildChildRole, witchRole, wolfHoundRole,+    Role, name, allegiance, balance, description, advice, -    -- * Allegiance     Allegiance(..),      -- ** Instances-    allAllegiances,+    allRoles, restrictedRoles, ) where -import Control.Lens--import           Data.Function-import           Data.List-import           Data.Text     (Text)-import qualified Data.Text     as T--import Prelude hiding (all)--data Role = Role-    { _name        :: Text-    , _allegiance  :: Allegiance-    , _description :: Text-    , _advice      :: Text-    } deriving (Read, Show)--data Allegiance = Angel | Villagers | Werewolves-    deriving (Eq, Read, Show)--makeLenses ''Role--instance Eq Role where-    (==) = (==) `on` view name--allRoles :: [Role]-allRoles =-    [ angelRole-    , defenderRole-    , scapegoatRole-    , seerRole-    , simpleVillagerRole-    , simpleWerewolfRole-    , villagerVillagerRole-    , wildChildRole-    , witchRole-    , wolfHoundRole-    ]--restrictedRoles :: [Role]-restrictedRoles = allRoles \\ [simpleVillagerRole, simpleWerewolfRole]--angelRole :: Role-angelRole = Role-    { _name         = "Angel"-    , _allegiance   = Angel-    , _description  = T.unwords-        [ "The muddy life of a village infested with evil creatures repulses him;"-        , "he wishes to believe he's the victim of a terrible nightmare,"-        , "in order to finally wake up in his comfortable bed."-        ]-    , _advice       = T.unwords-        [ "It's going to take all your guile and wits to con the village into eliminating you."-        , "Pretending to be a Werewolf is one tactic, but if it doesn't work then you may have just"-        , "dug yourself a hole for the rest of the game..."-        ]-    }--defenderRole :: Role-defenderRole = Role-    { _name         = "Defender"-    , _allegiance   = Villagers-    , _description  = T.unwords-        [ "A knight living in Miller's Hollow."-        , "The Defender can save the Villagers (bar himself!) from the bite of the Werewolves."-        ]-    , _advice       =-        "Be careful when you choose to protect someone, you cannot protect them 2 nights in a row."-    }--scapegoatRole :: Role-scapegoatRole = Role-    { _name         = "Scapegoat"-    , _allegiance   = Villagers-    , _description  = T.unwords-        [ "It's sad to say, but in Miller's Hollow, when something doesn't go right"-        , "it's always him who unjustly suffers the consequences."-        ]-    , _advice       = "Cross your fingers that the votes don't end up tied."-    }--seerRole :: Role-seerRole = Role-    { _name         = "Seer"-    , _allegiance   = Villagers-    , _description  = T.unwords-        [ "A fortunate teller by other names, with the ability to see into fellow"-        , "townsfolk and determine their allegiance."-        ]-    , _advice       = T.unwords-        [ "Be extremely careful if you have discovered a Werewolf."-        , "It may be worth the pain of revealing yourself in order to identify the player,"-        , "but avoid doing this too early."-        ]-    }--simpleVillagerRole :: Role-simpleVillagerRole = Role-    { _name         = "Simple Villager"-    , _allegiance   = Villagers-    , _description  = T.unwords-        [ "A simple, ordinary townsperson in every way."-        , "Their only weapons are the ability to analyze behaviour to identify Werewolves,"-        , "and the strength of their conviction to prevent"-        , "the execution of the innocents like themselves."-        ]-    , _advice       =-        "Bluffing can be a good technique, but you had better be convincing about what you say."-    }--simpleWerewolfRole :: Role-simpleWerewolfRole = Role-    { _name         = "Simple Werewolf"-    , _allegiance   = Werewolves-    , _description  = T.unwords-        [ "Each night they devour a Villager."-        , "During the day they try to hide their nocturnal identity to avoid mob justice."-        ]-    , _advice       =-        "Voting to lynch your partner can be a good way to deflect suspicion from yourself."-    }--villagerVillagerRole :: Role-villagerVillagerRole = Role-    { _name         = "Villager-Villager"-    , _allegiance   = Villagers-    , _description  = T.unwords-        [ "This person has a soul as clear and transparent as the water from a mountain stream."-        , "They will deserve the attentive ear of their peers"-        , "and will make their word decisive in crucial moments."-        ]-    , _advice       = "You'll make friends quickly, but be wary about whom you trust."-    }--wildChildRole :: Role-wildChildRole = Role-    { _name         = "Wild-child"-    , _allegiance   = Villagers-    , _description  = T.unwords-        [ "Abandoned in the woods by his parents at a young age, he was raised by wolves."-        , "As soon as he learned how to walk on all fours,"-        , "the Wild-child began to wander around Miller's Hollow."-        , "One day, fascinated by an inhabitant of the village who was walking upright"-        , "with grace and presence, he made them his secret role model."-        , "He then decided to integrate himself into the community of Miller's Hollow and entered,"-        , "worried, in the village."-        , "The community was moved by his frailty, adopted him, and welcomed him in their fold."-        , "What will become of him: honest Villager or terrible Werewolf?"-        , "For all of his life,"-        , "the heart of the Wild-child will swing between these two alternatives."-        , "May his model confirm him in his newfound humanity."-        ]-    , _advice       = T.unwords-        [ "Nothing is keeping you from taking part in the elimination of your role model,"-        , "if you so wish..."-        ]-    }--witchRole :: Role-witchRole = Role-    { _name         = "Witch"-    , _allegiance   = Villagers-    , _description  = T.unwords-        [ "She knows how to make up 2 extremely powerful potions;"-        , "one healing potion which can revive the Werewolves' victim,"-        , "one poison potion which when used can kill a player."-        ]-    , _advice       = T.unwords-        [ "Each potion may only be used once per game,"-        , "but there are no restrictions on using both on one night."-        ]-    }--wolfHoundRole :: Role-wolfHoundRole = Role-    { _name         = "Wolf-hound"-    , _allegiance   = Villagers-    , _description  = T.unwords-        [ "All dogs know in the depths of their soul that their ancestors were wolves"-        , "and that it's mankind who has kept them in the state of childishness and fear,"-        , "the faithful and generous companions."-        , "In any case, only the Wolf-hound can decide if he'll obey his human and civilized master"-        , "or if he'll listen to the call of wild nature buried within him."-        ]-    , _advice       =-        "The choice of being a Simple Villager or Werewolf is final, so decide carefully!"-    }--allAllegiances :: [Allegiance]-allAllegiances = [Angel, Villagers, Werewolves]+import Game.Werewolf.Internal.Role

@@ -1,6 +1,6 @@ {-| Module      : Main-Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com -}@@ -8,6 +8,7 @@ {-# OPTIONS_HADDOCK hide, prune #-}  module Main (+    -- * Main     main ) where 

@@ -1,6 +1,6 @@ {-| Module      : Game.Werewolf.Test.Arbitrary-Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com -}@@ -13,14 +13,16 @@      -- ** Game     NewGame(..),-    GameAtDefendersTurn(..), GameAtGameOver(..), GameAtSeersTurn(..), GameAtSunrise(..),-    GameAtVillagesTurn(..), GameAtWerewolvesTurn(..), GameAtWildChildsTurn(..),+    GameAtDefendersTurn(..), GameAtGameOver(..), GameAtScapegoatsTurn(..), GameAtSeersTurn(..),+    GameAtSunrise(..), GameAtVillagesTurn(..), GameAtWerewolvesTurn(..), GameAtWildChildsTurn(..),     GameAtWitchsTurn(..), GameAtWolfHoundsTurn(..),     GameOnSecondRound(..),-    GameWithDeadPlayers(..), GameWithDevourEvent(..), GameWithDevourVotes(..), GameWithHeal(..),-    GameWithLynchVotes(..), GameWithOneAllegianceAlive(..), GameWithPoison(..),-    GameWithProtect(..), GameWithProtectAndDevourVotes(..), GameWithRoleModel(..),-    GameWithRoleModelAtVillagesTurn(..), GameWithSee(..), GameWithZeroAllegiancesAlive(..),+    GameWithAllowedVoters(..), GameWithDeadPlayers(..), GameWithDevourEvent(..),+    GameWithDevourVotes(..), GameWithHeal(..), GameWithLynchVotes(..),+    GameWithOneAllegianceAlive(..), GameWithPoison(..), GameWithProtect(..),+    GameWithProtectAndDevourVotes(..), GameWithRoleModel(..), GameWithRoleModelAtVillagesTurn(..),+    GameWithScapegoatBlamed(..), GameWithSee(..), GameWithVillageIdiotRevealedAtVillagesTurn(..),+    GameWithZeroAllegiancesAlive(..),      -- ** Player     arbitraryPlayerSet,@@ -29,9 +31,9 @@      -- ** Command     arbitraryCommand, arbitraryChooseAllegianceCommand, arbitraryChoosePlayerCommand,-    arbitraryHealCommand, arbitraryPassCommand, arbitraryPoisonCommand, arbitraryProtectCommand,-    arbitraryQuitCommand, arbitrarySeeCommand, arbitraryVoteDevourCommand,-    arbitraryVoteLynchCommand,+    arbitraryChoosePlayersCommand, arbitraryHealCommand, arbitraryPassCommand,+    arbitraryPoisonCommand, arbitraryProtectCommand, arbitraryQuitCommand, arbitrarySeeCommand,+    arbitraryVoteDevourCommand, arbitraryVoteLynchCommand,     runArbitraryCommands,      -- ** Player@@ -46,10 +48,10 @@ import qualified Data.Text       as T  import Game.Werewolf.Command-import Game.Werewolf.Engine    (checkStage)-import Game.Werewolf.Game-import Game.Werewolf.Player-import Game.Werewolf.Role      hiding (name)+import Game.Werewolf.Engine          (checkStage)+import Game.Werewolf.Internal.Game+import Game.Werewolf.Internal.Player+import Game.Werewolf.Internal.Role   hiding (name) import Game.Werewolf.Test.Util  import Prelude hiding (round)@@ -105,6 +107,15 @@          return $ GameAtGameOver (game & stage .~ GameOver) +newtype GameAtScapegoatsTurn = GameAtScapegoatsTurn Game+    deriving (Eq, Show)++instance Arbitrary GameAtScapegoatsTurn where+    arbitrary = do+        (GameWithScapegoatBlamed game) <- arbitrary++        return $ GameAtScapegoatsTurn (run_ checkStage game)+ newtype GameAtSeersTurn = GameAtSeersTurn Game     deriving (Eq, Show) @@ -177,14 +188,24 @@          return $ GameOnSecondRound (game & round .~ 1) +newtype GameWithAllowedVoters = GameWithAllowedVoters Game+    deriving (Eq, Show)++instance Arbitrary GameWithAllowedVoters where+    arbitrary = do+        (GameAtScapegoatsTurn game) <- arbitrary+        (Blind command)             <- arbitraryChoosePlayersCommand game++        return $ GameWithAllowedVoters (run_ (apply command) game)+ newtype GameWithDeadPlayers = GameWithDeadPlayers Game     deriving (Eq, Show)  instance Arbitrary GameWithDeadPlayers where     arbitrary = do-        game        <- arbitrary-        players'    <- sublistOf $ game ^. players-        let game'   = foldr killPlayer game (map (view name) players')+        game                <- arbitrary+        (NonEmpty players') <- NonEmpty <$> sublistOf (game ^. players)+        let game'           = foldr killPlayer game (map (view name) players')          return $ GameWithDeadPlayers (run_ checkStage game') @@ -312,6 +333,15 @@          return $ GameWithRoleModelAtVillagesTurn (game & stage .~ VillagesTurn) +newtype GameWithScapegoatBlamed = GameWithScapegoatBlamed Game+    deriving (Eq, Show)++instance Arbitrary GameWithScapegoatBlamed where+    arbitrary = do+        (GameWithLynchVotes game) <- suchThat arbitrary $ \(GameWithLynchVotes game) -> length (getVoteResult game) > 1++        return $ GameWithScapegoatBlamed game+ newtype GameWithSee = GameWithSee Game     deriving (Eq, Show) @@ -323,6 +353,26 @@          return $ GameWithSee (run_ (apply command) game') +newtype GameWithVillageIdiotRevealed = GameWithVillageIdiotRevealed Game+    deriving (Eq, Show)++instance Arbitrary GameWithVillageIdiotRevealed where+    arbitrary = do+        game                <- arbitrary+        let villageIdiot    = findByRole_ villageIdiotRole (game ^. players)+        let game'           = game & villageIdiotRevealed .~ True & allowedVoters %~ delete (villageIdiot ^. name)++        return $ GameWithVillageIdiotRevealed game'++newtype GameWithVillageIdiotRevealedAtVillagesTurn = GameWithVillageIdiotRevealedAtVillagesTurn Game+    deriving (Eq, Show)++instance Arbitrary GameWithVillageIdiotRevealedAtVillagesTurn where+    arbitrary = do+        (GameWithVillageIdiotRevealed game) <- arbitrary++        return $ GameWithVillageIdiotRevealedAtVillagesTurn (game & stage .~ VillagesTurn)+ newtype GameWithZeroAllegiancesAlive = GameWithZeroAllegiancesAlive Game     deriving (Eq, Show) @@ -349,9 +399,11 @@ arbitraryCommand game = case game ^. stage of     GameOver        -> return $ Blind noopCommand     DefendersTurn   -> arbitraryProtectCommand game+    ScapegoatsTurn  -> arbitraryChoosePlayersCommand game+    SeersTurn       -> arbitrarySeeCommand game     Sunrise         -> return $ Blind noopCommand     Sunset          -> return $ Blind noopCommand-    SeersTurn       -> arbitrarySeeCommand game+    UrsussGrunt     -> return $ Blind noopCommand     VillagesTurn    -> arbitraryVoteLynchCommand game     WerewolvesTurn  -> arbitraryVoteDevourCommand game     WildChildsTurn  -> arbitraryChoosePlayerCommand game@@ -376,6 +428,13 @@      return . Blind $ choosePlayerCommand (wildChild ^. name) (target ^. name) +arbitraryChoosePlayersCommand :: Game -> Gen (Blind Command)+arbitraryChoosePlayersCommand game = do+    let scapegoat       = findByRole_ scapegoatRole (game ^. players)+    (NonEmpty players') <- NonEmpty <$> sublistOf (filterAlive $ game ^. players)++    return . Blind $ choosePlayersCommand (scapegoat ^. name) (map (view name) players')+ arbitraryHealCommand :: Game -> Gen (Blind Command) arbitraryHealCommand game = do     let witch = findByRole_ witchRole (game ^. players)@@ -439,7 +498,7 @@  arbitraryVoteLynchCommand :: Game -> Gen (Blind Command) arbitraryVoteLynchCommand game = do-    let applicableCallers   = getPendingVoters game+    let applicableCallers   = getAllowedVoters game `intersect` getPendingVoters game     target                  <- arbitraryPlayer game      if null applicableCallers

@@ -1,6 +1,6 @@ {-| Module      : Game.Werewolf.Test.Command-Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com -}@@ -22,9 +22,10 @@ import qualified Data.Text         as T  import Game.Werewolf.Command-import Game.Werewolf.Game-import Game.Werewolf.Player-import Game.Werewolf.Role           hiding (name)+import Game.Werewolf.Engine          (checkStage)+import Game.Werewolf.Internal.Game+import Game.Werewolf.Internal.Player+import Game.Werewolf.Internal.Role   hiding (name) import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util @@ -51,6 +52,15 @@     , testProperty "choose player command errors when caller not wild-child"    prop_choosePlayerCommandErrorsWhenCallerNotWildChild     , testProperty "choose player command sets role model"                      prop_choosePlayerCommandSetsRoleModel +    , testProperty "choose players command errors when game is over"                prop_choosePlayersCommandErrorsWhenGameIsOver+    , testProperty "choose players command errors when caller does not exist"       prop_choosePlayersCommandErrorsWhenCallerDoesNotExist+    , testProperty "choose players command errors when any target does not exist"   prop_choosePlayersCommandErrorsWhenAnyTargetDoesNotExist+    , testProperty "choose players command errors when any target is dead"          prop_choosePlayersCommandErrorsWhenAnyTargetIsDead+    , testProperty "choose players command errors when not scapegoat's turn"        prop_choosePlayersCommandErrorsWhenNotScapegoatsTurn+    , testProperty "choose players command errors when caller not scapegoat"        prop_choosePlayersCommandErrorsWhenCallerNotScapegoat+    , testProperty "choose players command sets allowed voters"                     prop_choosePlayersCommandSetsAllowedVoters+    , testProperty "choose players command resets scapegoat blamed"                 prop_choosePlayersCommandResetsScapegoatBlamed+     , testProperty "heal command errors when game is over"          prop_healCommandErrorsWhenGameIsOver     , testProperty "heal command errors when caller does not exist" prop_healCommandErrorsWhenCallerDoesNotExist     , testProperty "heal command errors when caller is dead"        prop_healCommandErrorsWhenCallerIsDead@@ -88,7 +98,6 @@     , testProperty "protect command errors when target is dead"             prop_protectCommandErrorsWhenTargetIsDead     , testProperty "protect command errors when not defender's turn"        prop_protectCommandErrorsWhenNotDefendersTurn     , testProperty "protect command errors when caller not defender"        prop_protectCommandErrorsWhenCallerNotDefender-    , testProperty "protect command errors when target is caller"           prop_protectCommandErrorsWhenTargetIsCaller     , testProperty "protect command errors when target is prior protect"    prop_protectCommandErrorsWhenTargetIsPriorProtect     , testProperty "protect command sets prior protect"                     prop_protectCommandSetsPriorProtect     , testProperty "protect command sets protect"                           prop_protectCommandSetsProtect@@ -106,7 +115,7 @@     , testProperty "quit command clears player's devour vote"                   prop_quitCommandClearsPlayersDevourVote     , testProperty "quit command clears player's lynch vote"                    prop_quitCommandClearsPlayersLynchVote     , testProperty "quit command clears role model when caller is wild-child"   prop_quitCommandClearsRoleModelWhenCallerIsWildChild-    , testProperty "quit command sets angel's role when caller is angel"         prop_quitCommandSetsAngelsRoleWhenCallerIsAngel+    , testProperty "quit command sets angel's role when caller is angel"        prop_quitCommandSetsAngelsRoleWhenCallerIsAngel      , testProperty "see command errors when game is over"           prop_seeCommandErrorsWhenGameIsOver     , testProperty "see command errors when caller does not exist"  prop_seeCommandErrorsWhenCallerDoesNotExist@@ -128,14 +137,17 @@     , testProperty "vote devour command errors when target werewolf"        prop_voteDevourCommandErrorsWhenTargetWerewolf     , testProperty "vote devour command updates votes"                      prop_voteDevourCommandUpdatesVotes -    , testProperty "vote lynch command errors when game is over"            prop_voteLynchCommandErrorsWhenGameIsOver-    , testProperty "vote lynch command errors when caller does not exist"   prop_voteLynchCommandErrorsWhenCallerDoesNotExist-    , testProperty "vote lynch command errors when target does not exist"   prop_voteLynchCommandErrorsWhenTargetDoesNotExist-    , testProperty "vote lynch command errors when caller is dead"          prop_voteLynchCommandErrorsWhenCallerIsDead-    , testProperty "vote lynch command errors when target is dead"          prop_voteLynchCommandErrorsWhenTargetIsDead-    , testProperty "vote lynch command errors when not villages turn"       prop_voteLynchCommandErrorsWhenNotVillagesTurn-    , testProperty "vote lynch command errors when caller has voted"        prop_voteLynchCommandErrorsWhenCallerHasVoted-    , testProperty "vote lynch command updates votes"                       prop_voteLynchCommandUpdatesVotes+    , testProperty "vote lynch command errors when game is over"                    prop_voteLynchCommandErrorsWhenGameIsOver+    , testProperty "vote lynch command errors when caller does not exist"           prop_voteLynchCommandErrorsWhenCallerDoesNotExist+    , testProperty "vote lynch command errors when target does not exist"           prop_voteLynchCommandErrorsWhenTargetDoesNotExist+    , testProperty "vote lynch command errors when caller is dead"                  prop_voteLynchCommandErrorsWhenCallerIsDead+    , testProperty "vote lynch command errors when target is dead"                  prop_voteLynchCommandErrorsWhenTargetIsDead+    , testProperty "vote lynch command errors when not villages turn"               prop_voteLynchCommandErrorsWhenNotVillagesTurn+    , testProperty "vote lynch command errors when caller has voted"                prop_voteLynchCommandErrorsWhenCallerHasVoted+    , testProperty "vote lynch command errors when caller is not in allowed voters" prop_voteLynchCommandErrorsWhenCallerIsNotInAllowedVoters+    , testProperty "vote lynch command errors when caller is known village idiot"   prop_voteLynchCommandErrorsWhenCallerIsKnownVillageIdiot+    , testProperty "vote lynch command errors when target is known village idiot"   prop_voteLynchCommandErrorsWhenTargetIsKnownVillageIdiot+    , testProperty "vote lynch command updates votes"                               prop_voteLynchCommandUpdatesVotes     ]  prop_chooseAllegianceCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property@@ -146,7 +158,7 @@ prop_chooseAllegianceCommandErrorsWhenCallerDoesNotExist (GameAtWolfHoundsTurn game) caller allegiance = do     let command = chooseAllegianceCommand (caller ^. name) (T.pack $ show allegiance) -    not (doesPlayerExist (caller ^. name) (game ^. players))+    not (doesPlayerExist (caller ^. name) game)         ==> verbose_runCommandErrors game command  prop_chooseAllegianceCommandErrorsWhenCallerIsDead :: GameAtWolfHoundsTurn -> Allegiance -> Property@@ -201,7 +213,7 @@     forAll (arbitraryPlayer game) $ \target -> do         let command = choosePlayerCommand (caller ^. name) (target ^. name) -        not (doesPlayerExist (caller ^. name) (game ^. players))+        not (doesPlayerExist (caller ^. name) game)             ==> verbose_runCommandErrors game command  prop_choosePlayerCommandErrorsWhenTargetDoesNotExist :: GameAtWildChildsTurn -> Player -> Property@@ -209,7 +221,7 @@     let wildChild   = findByRole_ wildChildRole (game ^. players)     let command     = choosePlayerCommand (wildChild ^. name) (target ^. name) -    not (doesPlayerExist (target ^. name) (game ^. players))+    not (doesPlayerExist (target ^. name) game)         ==> verbose_runCommandErrors game command  prop_choosePlayerCommandErrorsWhenCallerIsDead :: GameAtWildChildsTurn -> Property@@ -254,7 +266,7 @@  prop_choosePlayerCommandSetsRoleModel :: GameAtWildChildsTurn -> Property prop_choosePlayerCommandSetsRoleModel (GameAtWildChildsTurn game) = do-    let wildChild   = findByRole_ wildChildRole (game ^. players)+    let wildChild = findByRole_ wildChildRole (game ^. players)      forAll (suchThat (arbitraryPlayer game) (not . isWildChild)) $ \target -> do         let command = choosePlayerCommand (wildChild ^. name) (target ^. name)@@ -262,6 +274,65 @@          fromJust (game' ^. roleModel) === target ^. name +prop_choosePlayersCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property+prop_choosePlayersCommandErrorsWhenGameIsOver (GameAtGameOver game) =+    forAll (arbitraryChoosePlayersCommand game) $ verbose_runCommandErrors game . getBlind++prop_choosePlayersCommandErrorsWhenCallerDoesNotExist :: GameAtScapegoatsTurn -> Player -> Property+prop_choosePlayersCommandErrorsWhenCallerDoesNotExist (GameAtScapegoatsTurn game) caller =+    forAll (NonEmpty <$> sublistOf (filterAlive $ game ^. players)) $ \(NonEmpty targets) -> do+        let command = choosePlayersCommand (caller ^. name) (map (view name) targets)++        not (doesPlayerExist (caller ^. name) game)+            ==> verbose_runCommandErrors game command++prop_choosePlayersCommandErrorsWhenAnyTargetDoesNotExist :: GameAtScapegoatsTurn -> Player -> Property+prop_choosePlayersCommandErrorsWhenAnyTargetDoesNotExist (GameAtScapegoatsTurn game) target = do+    let scapegoat   = findByRole_ scapegoatRole (game ^. players)+    let command     = choosePlayersCommand (scapegoat ^. name) [target ^. name]++    not (doesPlayerExist (target ^. name) game)+        ==> verbose_runCommandErrors game command++prop_choosePlayersCommandErrorsWhenAnyTargetIsDead :: GameAtScapegoatsTurn -> Property+prop_choosePlayersCommandErrorsWhenAnyTargetIsDead (GameAtScapegoatsTurn game) = do+    let scapegoat = findByRole_ scapegoatRole (game ^. players)++    forAll (NonEmpty <$> sublistOf (filterAlive $ game ^. players)) $ \(NonEmpty targets) ->+        forAll (elements targets) $ \target -> do+            let game'   = killPlayer (target ^. name) game+            let command = choosePlayersCommand (scapegoat ^. name) (map (view name) targets)++            verbose_runCommandErrors game' command++prop_choosePlayersCommandErrorsWhenNotScapegoatsTurn :: Game -> Property+prop_choosePlayersCommandErrorsWhenNotScapegoatsTurn game =+    not (isScapegoatsTurn game)+    ==> forAll (arbitraryChoosePlayersCommand game) $ verbose_runCommandErrors game . getBlind++prop_choosePlayersCommandErrorsWhenCallerNotScapegoat :: GameAtScapegoatsTurn -> Property+prop_choosePlayersCommandErrorsWhenCallerNotScapegoat (GameAtScapegoatsTurn game) =+    forAll (suchThat (arbitraryPlayer game) (not . isScapegoat)) $ \caller ->+    forAll (NonEmpty <$> sublistOf (filterAlive $ game ^. players)) $ \(NonEmpty targets) -> do+        let command = choosePlayersCommand (caller ^. name) (map (view name) targets)++        verbose_runCommandErrors game command++prop_choosePlayersCommandSetsAllowedVoters :: GameAtScapegoatsTurn -> Property+prop_choosePlayersCommandSetsAllowedVoters (GameAtScapegoatsTurn game) = do+    let scapegoat = findByRole_ scapegoatRole (game ^. players)++    forAll (NonEmpty <$> sublistOf (filterAlive $ game ^. players)) $ \(NonEmpty targets) -> do+        let command = choosePlayersCommand (scapegoat ^. name) (map (view name) targets)+        let game'   = run_ (apply command) game++        game' ^. allowedVoters === map (view name) targets++prop_choosePlayersCommandResetsScapegoatBlamed :: GameAtScapegoatsTurn -> Property+prop_choosePlayersCommandResetsScapegoatBlamed (GameAtScapegoatsTurn game) = do+    forAll (arbitraryChoosePlayersCommand game) $ \(Blind command) ->+        not $ run_ (apply command) game ^. scapegoatBlamed+ prop_healCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property prop_healCommandErrorsWhenGameIsOver (GameAtGameOver game) = do     let witch   = findByRole_ witchRole (game ^. players)@@ -271,7 +342,7 @@  prop_healCommandErrorsWhenCallerDoesNotExist :: GameWithDevourEvent -> Player -> Property prop_healCommandErrorsWhenCallerDoesNotExist (GameWithDevourEvent game) caller =-    not (doesPlayerExist (caller ^. name) (game ^. players))+    not (doesPlayerExist (caller ^. name) game)     ==> verbose_runCommandErrors game (healCommand (caller ^. name))  prop_healCommandErrorsWhenCallerIsDead :: GameWithDevourEvent -> Property@@ -326,7 +397,7 @@  prop_passCommandErrorsWhenCallerDoesNotExist :: GameAtWitchsTurn -> Player -> Property prop_passCommandErrorsWhenCallerDoesNotExist (GameAtWitchsTurn game) caller =-    not (doesPlayerExist (caller ^. name) (game ^. players))+    not (doesPlayerExist (caller ^. name) game)     ==> verbose_runCommandErrors game (passCommand (caller ^. name))  prop_passCommandErrorsWhenCallerIsDead :: GameAtWitchsTurn -> Property@@ -355,7 +426,7 @@  prop_poisonCommandErrorsWhenCallerDoesNotExist :: GameAtWitchsTurn -> Player -> Property prop_poisonCommandErrorsWhenCallerDoesNotExist (GameAtWitchsTurn game) caller =-    not (doesPlayerExist (caller ^. name) (game ^. players))+    not (doesPlayerExist (caller ^. name) game)     ==> forAll (arbitraryPlayer game) $ \target -> do         let command = poisonCommand (caller ^. name) (target ^. name) @@ -366,7 +437,7 @@     let witch   = findByRole_ witchRole (game ^. players)     let command = poisonCommand (witch ^. name) (target ^. name) -    not (doesPlayerExist (target ^. name) (game ^. players))+    not (doesPlayerExist (target ^. name) game)         ==> verbose_runCommandErrors game command  prop_poisonCommandErrorsWhenCallerIsDead :: GameAtWitchsTurn -> Property@@ -436,7 +507,7 @@  prop_protectCommandErrorsWhenCallerDoesNotExist :: GameAtDefendersTurn -> Player -> Property prop_protectCommandErrorsWhenCallerDoesNotExist (GameAtDefendersTurn game) caller =-    not (doesPlayerExist (caller ^. name) (game ^. players))+    not (doesPlayerExist (caller ^. name) game)     ==> forAll (arbitraryPlayer game) $ \target -> do         let command = protectCommand (caller ^. name) (target ^. name) @@ -447,7 +518,7 @@     let defender    = findByRole_ defenderRole (game ^. players)     let command     = protectCommand (defender ^. name) (target ^. name) -    not (doesPlayerExist (target ^. name) (game ^. players))+    not (doesPlayerExist (target ^. name) game)         ==> verbose_runCommandErrors game command  prop_protectCommandErrorsWhenCallerIsDead :: GameAtDefendersTurn -> Property@@ -483,13 +554,6 @@          verbose_runCommandErrors game command -prop_protectCommandErrorsWhenTargetIsCaller :: GameAtDefendersTurn -> Property-prop_protectCommandErrorsWhenTargetIsCaller (GameAtDefendersTurn game) = do-    let defender    = findByRole_ defenderRole (game ^. players)-    let command     = protectCommand (defender ^. name) (defender ^. name)--    verbose_runCommandErrors game command- prop_protectCommandErrorsWhenTargetIsPriorProtect :: GameWithProtect -> Property prop_protectCommandErrorsWhenTargetIsPriorProtect (GameWithProtect game) = do     let game' = game & protect .~ Nothing@@ -515,7 +579,7 @@  prop_quitCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property prop_quitCommandErrorsWhenCallerDoesNotExist game caller =-    not (doesPlayerExist (caller ^. name) (game ^. players))+    not (doesPlayerExist (caller ^. name) game)     ==> verbose_runCommandErrors game (quitCommand $ caller ^. name)  prop_quitCommandErrorsWhenCallerIsDead :: Game -> Property@@ -610,7 +674,7 @@  prop_seeCommandErrorsWhenCallerDoesNotExist :: GameAtSeersTurn -> Player -> Property prop_seeCommandErrorsWhenCallerDoesNotExist (GameAtSeersTurn game) caller =-    not (doesPlayerExist (caller ^. name) (game ^. players))+    not (doesPlayerExist (caller ^. name) game)     ==> forAll (arbitraryPlayer game) $ \target -> do         let command = seeCommand (caller ^. name) (target ^. name) @@ -621,7 +685,7 @@     let seer    = findByRole_ seerRole (game ^. players)     let command = seeCommand (seer ^. name) (target ^. name) -    not (doesPlayerExist (target ^. name) (game ^. players))+    not (doesPlayerExist (target ^. name) game)         ==> verbose_runCommandErrors game command  prop_seeCommandErrorsWhenCallerIsDead :: GameAtSeersTurn -> Property@@ -668,7 +732,7 @@  prop_voteDevourCommandErrorsWhenCallerDoesNotExist :: GameAtWerewolvesTurn -> Player -> Property prop_voteDevourCommandErrorsWhenCallerDoesNotExist (GameAtWerewolvesTurn game) caller =-    not (doesPlayerExist (caller ^. name) (game ^. players))+    not (doesPlayerExist (caller ^. name) game)     ==> forAll (arbitraryPlayer game) $ \target -> do         let command = voteDevourCommand (caller ^. name) (target ^. name) @@ -676,7 +740,7 @@  prop_voteDevourCommandErrorsWhenTargetDoesNotExist :: GameAtWerewolvesTurn -> Player -> Property prop_voteDevourCommandErrorsWhenTargetDoesNotExist (GameAtWerewolvesTurn game) target =-    not (doesPlayerExist (target ^. name) (game ^. players))+    not (doesPlayerExist (target ^. name) game)     ==> forAll (arbitraryWerewolf game) $ \caller -> do         let command = voteDevourCommand (caller ^. name) (target ^. name) @@ -740,7 +804,7 @@  prop_voteLynchCommandErrorsWhenCallerDoesNotExist :: GameAtVillagesTurn -> Player -> Property prop_voteLynchCommandErrorsWhenCallerDoesNotExist (GameAtVillagesTurn game) caller =-    not (doesPlayerExist (caller ^. name) (game ^. players))+    not (doesPlayerExist (caller ^. name) game)     ==> forAll (arbitraryPlayer game) $ \target -> do         let command = voteLynchCommand (caller ^. name) (target ^. name) @@ -748,7 +812,7 @@  prop_voteLynchCommandErrorsWhenTargetDoesNotExist :: GameAtVillagesTurn -> Player -> Property prop_voteLynchCommandErrorsWhenTargetDoesNotExist (GameAtVillagesTurn game) target =-    not (doesPlayerExist (target ^. name) (game ^. players))+    not (doesPlayerExist (target ^. name) game)     ==> forAll (arbitraryPlayer game) $ \caller -> do         let command = voteLynchCommand (caller ^. name) (target ^. name) @@ -784,6 +848,34 @@         let command = voteLynchCommand (caller ^. name) (target ^. name)          verbose_runCommandErrors game command++prop_voteLynchCommandErrorsWhenCallerIsNotInAllowedVoters :: GameWithAllowedVoters -> Property+prop_voteLynchCommandErrorsWhenCallerIsNotInAllowedVoters (GameWithAllowedVoters game) =+    forAll (suchThat (arbitraryPlayer game') (`notElem` getAllowedVoters game')) $ \caller ->+    forAll (arbitraryPlayer game') $ \target -> do+        let command = voteLynchCommand (caller ^. name) (target ^. name)++        verbose_runCommandErrors game' command+    where+        game' = run_ checkStage game++prop_voteLynchCommandErrorsWhenCallerIsKnownVillageIdiot :: GameWithVillageIdiotRevealedAtVillagesTurn -> Property+prop_voteLynchCommandErrorsWhenCallerIsKnownVillageIdiot (GameWithVillageIdiotRevealedAtVillagesTurn game) =+    forAll (arbitraryPlayer game) $ \target -> do+        let command = voteLynchCommand (caller ^. name) (target ^. name)++        verbose_runCommandErrors game command+    where+        caller = findByRole_ villageIdiotRole (game ^. players)++prop_voteLynchCommandErrorsWhenTargetIsKnownVillageIdiot :: GameWithVillageIdiotRevealedAtVillagesTurn -> Property+prop_voteLynchCommandErrorsWhenTargetIsKnownVillageIdiot (GameWithVillageIdiotRevealedAtVillagesTurn game) =+    forAll (arbitraryPlayer game) $ \caller -> do+        let command = voteLynchCommand (caller ^. name) (target ^. name)++        verbose_runCommandErrors game command+    where+        target = findByRole_ villageIdiotRole (game ^. players)  prop_voteLynchCommandUpdatesVotes :: GameAtVillagesTurn -> Property prop_voteLynchCommandUpdatesVotes (GameAtVillagesTurn game) =

@@ -1,6 +1,6 @@ {-| Module      : Game.Werewolf.Test.Engine-Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com -}@@ -24,15 +24,15 @@ import           Data.Text         (Text)  import           Game.Werewolf.Command-import           Game.Werewolf.Engine         hiding (doesPlayerExist, getDevourEvent,-                                               getVoteResult, isDefendersTurn, isGameOver,-                                               isSeersTurn, isVillagesTurn, isWerewolvesTurn,-                                               isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn,-                                               killPlayer)-import           Game.Werewolf.Game-import           Game.Werewolf.Player-import           Game.Werewolf.Role           hiding (name)-import qualified Game.Werewolf.Role           as Role+import           Game.Werewolf.Engine          hiding (doesPlayerExist, getDevourEvent,+                                                getVoteResult, isDefendersTurn, isGameOver,+                                                isScapegoatsTurn, isSeersTurn, isVillagesTurn,+                                                isWerewolvesTurn, isWildChildsTurn, isWitchsTurn,+                                                isWolfHoundsTurn, killPlayer)+import           Game.Werewolf.Internal.Game+import           Game.Werewolf.Internal.Player+import           Game.Werewolf.Internal.Role   hiding (name)+import qualified Game.Werewolf.Internal.Role   as Role import           Game.Werewolf.Test.Arbitrary import           Game.Werewolf.Test.Util @@ -46,7 +46,9 @@ allEngineTests :: [TestTree] allEngineTests =     [ testProperty "check stage skips defender's turn when no defender"         prop_checkStageSkipsDefendersTurnWhenNoDefender+    , testProperty "check stage skips scapegoat's turn when no seer"            prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat     , testProperty "check stage skips seer's turn when no seer"                 prop_checkStageSkipsSeersTurnWhenNoSeer+    , testProperty "check stage skips village's turn when allowed voters empty" prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty     , testProperty "check stage skips wild-child's turn when no wild-child"     prop_checkStageSkipsWildChildsTurnWhenNoWildChild     , testProperty "check stage skips witch's turn when no witch"               prop_checkStageSkipsWitchsTurnWhenNoWitch     , testProperty "check stage skips wolf-hound's turn when no wolf-hound"     prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound@@ -56,6 +58,9 @@     , testProperty "check defender's turn advances when no defender"        prop_checkDefendersTurnAdvancesWhenNoDefender     , testProperty "check defender's turn does nothing unless protected"    prop_checkDefendersTurnDoesNothingUnlessProtected +    , testProperty "check scapegoat's turn advances to seer's turn"             prop_checkScapegoatsTurnAdvancesToSeersTurn+    , testProperty "check scapegoat's turn does nothing while scapegoat blamed" prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed+     , testProperty "check seer's turn advances to wild-child's turn"    prop_checkSeersTurnAdvancesToWildChildsTurn     , testProperty "check seer's turn advances when no seer"            prop_checkSeersTurnAdvancesWhenNoSeer     , testProperty "check seer's turn resets sees"                      prop_checkSeersTurnResetsSee@@ -66,11 +71,13 @@      , testProperty "check sunset sets wild-child's allegiance when role model dead" prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead -    , testProperty "check villages' turn advances to seer's turn"                           prop_checkVillagesTurnAdvancesToSeersTurn+    , testProperty "check villages' turn advances to scapegoat's turn"                      prop_checkVillagesTurnAdvancesToScapegoatsTurn     , testProperty "check villages' turn lynches one player when consensus"                 prop_checkVillagesTurnLynchesOnePlayerWhenConsensus+    , testProperty "check villages' turn lynches no one when target is village idiot"       prop_checkVillagesTurnLynchesNoOneWhenTargetIsVillageIdiot     , testProperty "check villages' turn lynches no one when conflicted and no scapegoats"  prop_checkVillagesTurnLynchesNoOneWhenConflictedAndNoScapegoats     , testProperty "check villages' turn lynches scapegoat when conflicted"                 prop_checkVillagesTurnLynchesScapegoatWhenConflicted     , testProperty "check villages' turn resets votes"                                      prop_checkVillagesTurnResetsVotes+    , testProperty "check villages' turn sets allowed voters"                               prop_checkVillagesTurnSetsAllowedVoters     , testProperty "check villages' turn does nothing unless all voted"                     prop_checkVillagesTurnDoesNothingUnlessAllVoted      , testProperty "check werewolves' turn advances to witch's turn"                    prop_checkWerewolvesTurnAdvancesToWitchsTurn@@ -106,26 +113,19 @@     --, testProperty "check game over does nothing when at least two allegiances alive"   prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive     , testProperty "check game over advances stage when second round and angel dead" prop_checkGameOverAdvancesStageWhenSecondRoundAndAngelDead -    , testProperty "start game uses given players"                          prop_startGameUsesGivenPlayers-    , testProperty "start game errors unless unique player names"           prop_startGameErrorsUnlessUniquePlayerNames-    , testProperty "start game errors when less than 7 players"             prop_startGameErrorsWhenLessThan7Players-    , testProperty "start game errors when more than 24 players"            prop_startGameErrorsWhenMoreThan24Players-    , testProperty "start game errors when more than 1 angel"               prop_startGameErrorsWhenMoreThan1Angel-    , testProperty "start game errors when more than 1 defender"            prop_startGameErrorsWhenMoreThan1Defender-    , testProperty "start game errors when more than 1 scapegoat"           prop_startGameErrorsWhenMoreThan1Scapegoat-    , testProperty "start game errors when more than 1 seer"                prop_startGameErrorsWhenMoreThan1Seer-    , testProperty "start game errors when more than 1 villager-villager"   prop_startGameErrorsWhenMoreThan1VillagerVillager-    , testProperty "start game errors when more than 1 wild-child"          prop_startGameErrorsWhenMoreThan1WildChild-    , testProperty "start game errors when more than 1 witch"               prop_startGameErrorsWhenMoreThan1Witch-    , testProperty "start game errors when more than 1 wolf-hound"          prop_startGameErrorsWhenMoreThan1WolfHound+    , testProperty "start game uses given players"                              prop_startGameUsesGivenPlayers+    , testProperty "start game errors unless unique player names"               prop_startGameErrorsUnlessUniquePlayerNames+    , testProperty "start game errors when less than 7 players"                 prop_startGameErrorsWhenLessThan7Players+    , testProperty "start game errors when more than 24 players"                prop_startGameErrorsWhenMoreThan24Players+    , testProperty "start game errors when more than 1 of a restricted role"    prop_startGameErrorsWhenMoreThan1OfARestrictedRole      , testProperty "create players uses given player names" prop_createPlayersUsesGivenPlayerNames     , testProperty "create players uses given roles"        prop_createPlayersUsesGivenRoles     , testProperty "create players creates alive players"   prop_createPlayersCreatesAlivePlayers -    , testProperty "randomise roles returns n roles"            prop_randomiseRolesReturnsNRoles-    , testProperty "randomise roles uses given roles"           prop_randomiseRolesUsesGivenRoles-    , testProperty "randomise roles proportions allegiances"    prop_randomiseRolesProportionsAllegiances+    , testProperty "pad roles returns n roles"          prop_padRolesReturnsNRoles+    , testProperty "pad roles uses given roles"         prop_padRolesUsesGivenRoles+    , testProperty "pad roles proportions allegiances"  prop_padRolesProportionsAllegiances     ]  prop_checkStageSkipsDefendersTurnWhenNoDefender :: GameWithRoleModel -> Bool@@ -135,14 +135,25 @@         defendersName   = findByRole_ defenderRole (game ^. players) ^. name         game'           = killPlayer defendersName game +prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat :: GameAtScapegoatsTurn -> Bool+prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat (GameAtScapegoatsTurn game) =+    isScapegoatsTurn $ run_ checkStage game+ prop_checkStageSkipsSeersTurnWhenNoSeer :: GameWithLynchVotes -> Property prop_checkStageSkipsSeersTurnWhenNoSeer (GameWithLynchVotes game) =     isAlive (findByRole_ angelRole $ run_ checkStage game' ^. players)-    ==> isWildChildsTurn game' || isDefendersTurn game'+    ==> isScapegoatsTurn game' || isWildChildsTurn game' || isDefendersTurn game'     where         seersName   = findByRole_ seerRole (game ^. players) ^. name         game'       = run_ (apply (quitCommand seersName) >> checkStage) game +prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty :: GameAtWitchsTurn -> Property+prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty (GameAtWitchsTurn game) =+    forAll (arbitraryPassCommand game') $ \(Blind passCommand) -> do+        isSeersTurn $ run_ (apply passCommand >> checkStage) game'+    where+        game' = game & allowedVoters .~ []+ prop_checkStageSkipsWildChildsTurnWhenNoWildChild :: GameWithSee -> Bool prop_checkStageSkipsWildChildsTurnWhenNoWildChild (GameWithSee game) =     isDefendersTurn $ run_ checkStage game'@@ -176,14 +187,22 @@ prop_checkDefendersTurnAdvancesWhenNoDefender :: GameAtDefendersTurn -> Bool prop_checkDefendersTurnAdvancesWhenNoDefender (GameAtDefendersTurn game) = do     let defender    = findByRole_ defenderRole (game ^. players)-    let game'       = killPlayer (defender ^. name) game+    let command     = quitCommand $ defender ^. name -    not . isDefendersTurn $ run_ checkStage game'+    not . isDefendersTurn $ run_ (apply command >> checkStage) game  prop_checkDefendersTurnDoesNothingUnlessProtected :: GameAtDefendersTurn -> Bool prop_checkDefendersTurnDoesNothingUnlessProtected (GameAtDefendersTurn game) =     isDefendersTurn $ run_ checkStage game +prop_checkScapegoatsTurnAdvancesToSeersTurn :: GameWithAllowedVoters -> Bool+prop_checkScapegoatsTurnAdvancesToSeersTurn (GameWithAllowedVoters game) =+    isSeersTurn $ run_ checkStage game++prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed :: GameAtScapegoatsTurn -> Bool+prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed (GameAtScapegoatsTurn game) =+    isScapegoatsTurn $ run_ checkStage game+ prop_checkSeersTurnAdvancesToWildChildsTurn :: GameWithSee -> Bool prop_checkSeersTurnAdvancesToWildChildsTurn (GameWithSee game) =     isWildChildsTurn $ run_ checkStage game@@ -191,9 +210,9 @@ prop_checkSeersTurnAdvancesWhenNoSeer :: GameAtSeersTurn -> Bool prop_checkSeersTurnAdvancesWhenNoSeer (GameAtSeersTurn game) = do     let seer    = findByRole_ seerRole (game ^. players)-    let game'   = killPlayer (seer ^. name) game+    let command = quitCommand $ seer ^. name -    not . isSeersTurn $ run_ checkStage game'+    not . isSeersTurn $ run_ (apply command >> checkStage) game  prop_checkSeersTurnResetsSee :: GameWithSee -> Bool prop_checkSeersTurnResetsSee (GameWithSee game) =@@ -216,23 +235,33 @@  prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead :: GameWithRoleModelAtVillagesTurn -> Property prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead (GameWithRoleModelAtVillagesTurn game) = do-    let roleModelsName  = fromJust $ game ^. roleModel-    let game'           = foldr (\player -> run_ (apply $ voteLynchCommand (player ^. name) roleModelsName)) game (game ^. players)+    let game' = foldr (\player -> run_ (apply $ voteLynchCommand (player ^. name) (roleModel' ^. name))) game (game ^. players) -    not (isAngel $ findByName_ roleModelsName (game' ^. players))+    not (isAngel roleModel' || isVillageIdiot roleModel')         ==> isWerewolf $ findByRole_ wildChildRole (run_ checkStage game' ^. players)+    where+        roleModel' = findByName_ (fromJust $ game ^. roleModel) (game ^. players) -prop_checkVillagesTurnAdvancesToSeersTurn :: GameWithLynchVotes -> Property-prop_checkVillagesTurnAdvancesToSeersTurn (GameWithLynchVotes game) =-    isAlive (findByRole_ seerRole $ run_ checkStage game ^. players)-    && isAlive (findByRole_ angelRole $ run_ checkStage game ^. players)-    ==> isSeersTurn $ run_ checkStage game+prop_checkVillagesTurnAdvancesToScapegoatsTurn :: GameWithScapegoatBlamed -> Bool+prop_checkVillagesTurnAdvancesToScapegoatsTurn (GameWithScapegoatBlamed game) =+    isScapegoatsTurn $ run_ checkStage game  prop_checkVillagesTurnLynchesOnePlayerWhenConsensus :: GameWithLynchVotes -> Property prop_checkVillagesTurnLynchesOnePlayerWhenConsensus (GameWithLynchVotes game) =     length (getVoteResult game) == 1+    && not (isVillageIdiot target)     ==> length (filterDead $ run_ checkStage game ^. players) == 1+    where+        target = head $ getVoteResult game +prop_checkVillagesTurnLynchesNoOneWhenTargetIsVillageIdiot :: GameAtVillagesTurn -> Bool+prop_checkVillagesTurnLynchesNoOneWhenTargetIsVillageIdiot (GameAtVillagesTurn game) = do+    let game' = foldr (\player -> run_ (apply $ voteLynchCommand (player ^. name) (villageIdiot ^. name))) game (game ^. players)++    null . filterDead $ run_ checkStage game' ^. players+    where+        villageIdiot = findByRole_ villageIdiotRole (game ^. players)+ -- TODO (hjw): tidy this test prop_checkVillagesTurnLynchesNoOneWhenConflictedAndNoScapegoats :: Game -> Property prop_checkVillagesTurnLynchesNoOneWhenConflictedAndNoScapegoats game =@@ -244,15 +273,23 @@         game'           = killPlayer scapegoatsName game & stage .~ VillagesTurn         n               = length $ game' ^. players -prop_checkVillagesTurnLynchesScapegoatWhenConflicted :: GameWithLynchVotes -> Property-prop_checkVillagesTurnLynchesScapegoatWhenConflicted (GameWithLynchVotes game) =-    length (getVoteResult game) > 1-    ==> isDead . findByRole_ scapegoatRole $ run_ checkStage game ^. players+prop_checkVillagesTurnLynchesScapegoatWhenConflicted :: GameAtScapegoatsTurn -> Bool+prop_checkVillagesTurnLynchesScapegoatWhenConflicted (GameAtScapegoatsTurn game) =+    isDead . findByRole_ scapegoatRole $ run_ checkStage game ^. players  prop_checkVillagesTurnResetsVotes :: GameWithLynchVotes -> Bool prop_checkVillagesTurnResetsVotes (GameWithLynchVotes game) =     Map.null $ run_ checkStage game ^. votes +prop_checkVillagesTurnSetsAllowedVoters :: GameWithLynchVotes -> Property+prop_checkVillagesTurnSetsAllowedVoters (GameWithLynchVotes game) =+    game' ^. allowedVoters === map (view name) expectedAllowedVoters+    where+        game' = run_ checkStage game+        expectedAllowedVoters+            | game' ^. villageIdiotRevealed = filter (not . isVillageIdiot) $ game' ^. players+            | otherwise                     = filterAlive $ game' ^. players+ prop_checkVillagesTurnDoesNothingUnlessAllVoted :: GameAtVillagesTurn -> Property prop_checkVillagesTurnDoesNothingUnlessAllVoted (GameAtVillagesTurn game) =     forAll (runArbitraryCommands n game) $ \game' ->@@ -312,9 +349,9 @@ prop_checkWildChildsTurnAdvancesWhenNoWildChild :: GameAtWildChildsTurn -> Bool prop_checkWildChildsTurnAdvancesWhenNoWildChild (GameAtWildChildsTurn game) = do     let wildChild   = findByRole_ wildChildRole (game ^. players)-    let game'       = killPlayer (wildChild ^. name) game+    let command     = quitCommand $ wildChild ^. name -    not . isWildChildsTurn $ run_ checkStage game'+    not . isWildChildsTurn $ run_ (apply command >> checkStage) game  prop_checkWildChildsTurnDoesNothingUnlessRoleModelChosen :: GameAtWildChildsTurn -> Bool prop_checkWildChildsTurnDoesNothingUnlessRoleModelChosen (GameAtWildChildsTurn game) =@@ -328,9 +365,9 @@ prop_checkWitchsTurnAdvancesWhenNoWitch :: GameAtWitchsTurn -> Bool prop_checkWitchsTurnAdvancesWhenNoWitch (GameAtWitchsTurn game) = do     let witch   = findByRole_ witchRole (game ^. players)-    let game'   = killPlayer (witch ^. name) game+    let command = quitCommand $ witch ^. name -    not . isWitchsTurn $ run_ checkStage game'+    not . isWitchsTurn $ run_ (apply command >> checkStage) game  prop_checkWitchsTurnHealsDevoureeWhenHealed :: GameWithHeal -> Property prop_checkWitchsTurnHealsDevoureeWhenHealed (GameWithHeal game) =@@ -374,9 +411,9 @@ prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound :: GameAtWolfHoundsTurn -> Bool prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound (GameAtWolfHoundsTurn game) = do     let wolfHound   = findByRole_ wolfHoundRole (game ^. players)-    let game'       = killPlayer (wolfHound ^. name) game+    let command     = quitCommand $ wolfHound ^. name -    not . isWolfHoundsTurn $ run_ checkStage game'+    not . isWolfHoundsTurn $ run_ (apply command >> checkStage) game  prop_checkWolfHoundsTurnDoesNothingUnlessChosen :: GameAtWolfHoundsTurn -> Bool prop_checkWolfHoundsTurnDoesNothingUnlessChosen (GameAtWolfHoundsTurn game) =@@ -429,80 +466,46 @@         length players > 24         ==> isLeft . runExcept . runWriterT $ startGame "" players -prop_startGameErrorsWhenMoreThan1Angel :: [Player] -> Property-prop_startGameErrorsWhenMoreThan1Angel players =-    length (filter isAngel players) > 1-    ==> isLeft . runExcept . runWriterT $ startGame "" players--prop_startGameErrorsWhenMoreThan1Defender :: [Player] -> Property-prop_startGameErrorsWhenMoreThan1Defender players =-    length (filter isDefender players) > 1-    ==> isLeft . runExcept . runWriterT $ startGame "" players--prop_startGameErrorsWhenMoreThan1Scapegoat :: [Player] -> Property-prop_startGameErrorsWhenMoreThan1Scapegoat players =-    length (filter isScapegoat players) > 1-    ==> isLeft . runExcept . runWriterT $ startGame "" players--prop_startGameErrorsWhenMoreThan1Seer :: [Player] -> Property-prop_startGameErrorsWhenMoreThan1Seer players =-    length (filter isSeer players) > 1-    ==> isLeft . runExcept . runWriterT $ startGame "" players--prop_startGameErrorsWhenMoreThan1VillagerVillager :: [Player] -> Property-prop_startGameErrorsWhenMoreThan1VillagerVillager players =-    length (filter isVillagerVillager players) > 1-    ==> isLeft . runExcept . runWriterT $ startGame "" players--prop_startGameErrorsWhenMoreThan1WildChild :: [Player] -> Property-prop_startGameErrorsWhenMoreThan1WildChild players =-    length (filter isWildChild players) > 1-    ==> isLeft . runExcept . runWriterT $ startGame "" players--prop_startGameErrorsWhenMoreThan1Witch :: [Player] -> Property-prop_startGameErrorsWhenMoreThan1Witch players =-    length (filter isWitch players) > 1-    ==> isLeft . runExcept . runWriterT $ startGame "" players--prop_startGameErrorsWhenMoreThan1WolfHound :: [Player] -> Property-prop_startGameErrorsWhenMoreThan1WolfHound players =-    length (filter isWolfHound players) > 1+prop_startGameErrorsWhenMoreThan1OfARestrictedRole :: [Player] -> Property+prop_startGameErrorsWhenMoreThan1OfARestrictedRole players =+    any (\role -> length (filterByRole role players) > 1) restrictedRoles     ==> isLeft . runExcept . runWriterT $ startGame "" players  prop_createPlayersUsesGivenPlayerNames :: [Text] -> [Role] -> Property prop_createPlayersUsesGivenPlayerNames playerNames extraRoles = monadicIO $ do-    players <- createPlayers playerNames extraRoles+    players <- createPlayers playerNames (padRoles extraRoles (length playerNames))      return $ playerNames == map (view name) players  prop_createPlayersUsesGivenRoles :: [Text] -> [Role] -> Property prop_createPlayersUsesGivenRoles playerNames extraRoles = monadicIO $ do-    players <- createPlayers playerNames extraRoles+    let roles = padRoles extraRoles (length playerNames) -    return $ extraRoles `isSubsequenceOf` map (view role) players+    players <- createPlayers playerNames roles +    return $ roles == map (view role) players+ prop_createPlayersCreatesAlivePlayers :: [Text] -> [Role] -> Property prop_createPlayersCreatesAlivePlayers playerNames extraRoles = monadicIO $ do-    players <- createPlayers playerNames extraRoles+    players <- createPlayers playerNames (padRoles extraRoles (length playerNames))      return $ all isAlive players -prop_randomiseRolesReturnsNRoles :: [Role] -> Int -> Property-prop_randomiseRolesReturnsNRoles extraRoles n = monadicIO $ do-    roles <- randomiseRoles extraRoles n+prop_padRolesReturnsNRoles :: [Role] -> Int -> Property+prop_padRolesReturnsNRoles extraRoles n = monadicIO $ do+    let roles = padRoles extraRoles n      return $ length roles == n -prop_randomiseRolesUsesGivenRoles :: [Role] -> Int -> Property-prop_randomiseRolesUsesGivenRoles extraRoles n = monadicIO $ do-    roles <- randomiseRoles extraRoles n+prop_padRolesUsesGivenRoles :: [Role] -> Int -> Property+prop_padRolesUsesGivenRoles extraRoles n = monadicIO $ do+    let roles = padRoles extraRoles n      return $ extraRoles `isSubsequenceOf` roles -prop_randomiseRolesProportionsAllegiances :: [Role] -> Int -> Property-prop_randomiseRolesProportionsAllegiances extraRoles n = monadicIO $ do-    roles <- randomiseRoles extraRoles n-+prop_padRolesProportionsAllegiances :: [Role] -> Int -> Property+prop_padRolesProportionsAllegiances extraRoles n = monadicIO $ do+    let roles           = padRoles extraRoles n     let werewolvesCount = length . elemIndices Role.Werewolves $ map (view allegiance) roles -    return $ werewolvesCount == n `quot` 6 + 1+    return $ werewolvesCount == n `quot` 5 + 1

@@ -1,6 +1,6 @@ {-| Module      : Game.Werewolf.Test.Game-Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com -}@@ -17,9 +17,9 @@ import qualified Data.Map   as Map import           Data.Maybe -import Game.Werewolf.Game-import Game.Werewolf.Player-import Game.Werewolf.Test.Arbitrary ()+import Game.Werewolf.Internal.Game+import Game.Werewolf.Internal.Player+import Game.Werewolf.Test.Arbitrary  ()  import Prelude hiding (round) @@ -33,13 +33,16 @@     , testProperty "new game starts on first round"                         prop_newGameStartsOnFirstRound     , testProperty "new game starts with events empty"                      prop_newGameStartsWithEventsEmpty     , testProperty "new game starts with passes empty"                      prop_newGameStartsWithPassesEmpty-    , testProperty "new game starts with no heal"                           prop_newGameStartsWithNoHeal-    , testProperty "new game starts with no heal used"                      prop_newGameStartsWithNoHealUsed+    , testProperty "new game starts with allowed voters full"               prop_newGameStartsWithAllowedVotersFull+    , testProperty "new game starts with heal false"                        prop_newGameStartsWithHealFalse+    , testProperty "new game starts with heal used false"                   prop_newGameStartsWithHealUsedFalse     , testProperty "new game starts with no poison"                         prop_newGameStartsWithNoPoison-    , testProperty "new game starts with no poison used"                    prop_newGameStartsWithNoPoisonUsed+    , testProperty "new game starts with poison used false"                 prop_newGameStartsWithPoisonUsedFalse     , testProperty "new game starts with no prior protect"                  prop_newGameStartsWithNoPriorProtect     , testProperty "new game starts with no protect"                        prop_newGameStartsWithNoProtect+    , testProperty "new game starts with scapegoat blamed false"            prop_newGameStartsWithScapegoatBlamedFalse     , testProperty "new game starts with no see"                            prop_newGameStartsWithNoSee+    , testProperty "new game starts with village idiot revealed false"      prop_newGameStartsWithVillageIdiotRevealedFalse     , testProperty "new game starts with votes empty"                       prop_newGameStartsWithVotesEmpty     , testProperty "new game uses given players"                            prop_newGameUsesGivenPlayers     ]@@ -63,17 +66,20 @@ prop_newGameStartsWithPassesEmpty :: [Player] -> Bool prop_newGameStartsWithPassesEmpty players = null $ newGame players ^. passes -prop_newGameStartsWithNoHeal :: [Player] -> Bool-prop_newGameStartsWithNoHeal players = not $ newGame players ^. heal+prop_newGameStartsWithAllowedVotersFull :: [Player] -> Property+prop_newGameStartsWithAllowedVotersFull players = newGame players ^. allowedVoters === map (view name) players -prop_newGameStartsWithNoHealUsed :: [Player] -> Bool-prop_newGameStartsWithNoHealUsed players = not $ newGame players ^. healUsed+prop_newGameStartsWithHealFalse :: [Player] -> Bool+prop_newGameStartsWithHealFalse players = not $ newGame players ^. heal +prop_newGameStartsWithHealUsedFalse :: [Player] -> Bool+prop_newGameStartsWithHealUsedFalse players = not $ newGame players ^. healUsed+ prop_newGameStartsWithNoPoison :: [Player] -> Bool prop_newGameStartsWithNoPoison players = isNothing $ newGame players ^. poison -prop_newGameStartsWithNoPoisonUsed :: [Player] -> Bool-prop_newGameStartsWithNoPoisonUsed players = not $ newGame players ^. poisonUsed+prop_newGameStartsWithPoisonUsedFalse :: [Player] -> Bool+prop_newGameStartsWithPoisonUsedFalse players = not $ newGame players ^. poisonUsed  prop_newGameStartsWithNoPriorProtect :: [Player] -> Bool prop_newGameStartsWithNoPriorProtect players = isNothing $ newGame players ^. priorProtect@@ -81,8 +87,15 @@ prop_newGameStartsWithNoProtect :: [Player] -> Bool prop_newGameStartsWithNoProtect players = isNothing $ newGame players ^. protect +prop_newGameStartsWithScapegoatBlamedFalse :: [Player] -> Bool+prop_newGameStartsWithScapegoatBlamedFalse players = not $ newGame players ^. scapegoatBlamed+ prop_newGameStartsWithNoSee :: [Player] -> Bool prop_newGameStartsWithNoSee players = isNothing $ newGame players ^. see++prop_newGameStartsWithVillageIdiotRevealedFalse :: [Player] -> Bool+prop_newGameStartsWithVillageIdiotRevealedFalse players =+    not $ newGame players ^. villageIdiotRevealed  prop_newGameStartsWithVotesEmpty :: [Player] -> Bool prop_newGameStartsWithVotesEmpty players = Map.null $ newGame players ^. votes

@@ -16,9 +16,9 @@  import Data.Text -import Game.Werewolf.Player+import Game.Werewolf.Internal.Player import Game.Werewolf.Role-import Game.Werewolf.Test.Arbitrary ()+import Game.Werewolf.Test.Arbitrary  ()  import Test.Tasty import Test.Tasty.QuickCheck

@@ -1,6 +1,6 @@ {-| Module      : Game.Werewolf.Test.Util-Copyright   : (c) Henry J. Wylde, 2015+Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3 Maintainer  : public@hjwylde.com -}

@@ -1,5 +1,5 @@ name:           werewolf-version:        0.4.5.0+version:        0.4.6.0  author:         Henry J. Wylde maintainer:     public@hjwylde.com@@ -29,6 +29,7 @@     ghc-options:    -threaded -with-rtsopts=-N     other-modules:         Werewolf.Commands.Choose,+        Werewolf.Commands.Circle,         Werewolf.Commands.End,         Werewolf.Commands.Heal,         Werewolf.Commands.Help,@@ -43,6 +44,7 @@         Werewolf.Commands.Status,         Werewolf.Commands.Version,         Werewolf.Commands.Vote,+        Werewolf.Messages,         Werewolf.Options,         Werewolf.Version,         Paths_werewolf@@ -57,8 +59,10 @@         extra == 1.4.*,         filepath == 1.4.*,         lens >= 4.12 && < 4.14,+        MonadRandom == 0.4.*,         mtl == 2.2.*,         optparse-applicative >= 0.11 && < 0.13,+        random-shuffle,         text == 1.2.*,         transformers == 0.4.*,         werewolf@@ -66,12 +70,18 @@ library     hs-source-dirs: src/     exposed-modules:+        Game.Werewolf,         Game.Werewolf.Command,         Game.Werewolf.Engine,         Game.Werewolf.Game,+        Game.Werewolf.Internal.Game,+        Game.Werewolf.Internal.Player,+        Game.Werewolf.Internal.Role,         Game.Werewolf.Player,         Game.Werewolf.Response,         Game.Werewolf.Role+    other-modules:+        Game.Werewolf.Messages      default-language: Haskell2010     other-extensions: