werewolf 0.4.6.1 → 0.4.7.0

raw patch · 37 files changed

+1800/−1712 lines, 37 files

Files

• CHANGELOG.md +9/−3
• app/Main.hs +0/−1
• app/Werewolf/Commands/Choose.hs +1/−0
• app/Werewolf/Commands/Circle.hs +1/−0
• app/Werewolf/Commands/End.hs +1/−0
• app/Werewolf/Commands/Heal.hs +1/−0
• app/Werewolf/Commands/Help.hs +3/−2
• app/Werewolf/Commands/Pass.hs +1/−0
• app/Werewolf/Commands/Ping.hs +1/−0
• app/Werewolf/Commands/Poison.hs +1/−0
• app/Werewolf/Commands/Protect.hs +1/−0
• app/Werewolf/Commands/Quit.hs +1/−0
• app/Werewolf/Commands/See.hs +1/−0
• app/Werewolf/Commands/Start.hs +8/−7
• app/Werewolf/Commands/Status.hs +1/−0
• app/Werewolf/Commands/Vote.hs +1/−0
• app/Werewolf/Game.hs +74/−0
• app/Werewolf/Options.hs +1/−1
• src/Game/Werewolf.hs +15/−18
• src/Game/Werewolf/Command.hs +65/−74
• src/Game/Werewolf/Engine.hs +59/−237
• src/Game/Werewolf/Game.hs +239/−9
• src/Game/Werewolf/Internal/Game.hs +0/−309
• src/Game/Werewolf/Internal/Player.hs +0/−180
• src/Game/Werewolf/Internal/Role.hs +0/−380
• src/Game/Werewolf/Messages.hs +86/−76
• src/Game/Werewolf/Player.hs +326/−5
• src/Game/Werewolf/Role.hs +383/−4
• src/Game/Werewolf/Util.hs +167/−0
• test/app/Main.hs +0/−2
• test/src/Game/Werewolf/Test/Arbitrary.hs +69/−81
• test/src/Game/Werewolf/Test/Command.hs +117/−104
• test/src/Game/Werewolf/Test/Engine.hs +122/−166
• test/src/Game/Werewolf/Test/Game.hs +12/−15
• test/src/Game/Werewolf/Test/Player.hs +2/−4
• test/src/Game/Werewolf/Test/Util.hs +0/−2
• werewolf.cabal +31/−32

@@ -2,12 +2,18 @@  #### Upcoming -#### v0.4.6.1+#### v0.4.7.0  *Revisions* -* Fixed Village Idiot text to have spaces around the name. ([#87](https://github.com/hjwylde/werewolf/issues/87))-* Fixed a bug where the Werewolves couldn't win if it was down to 1 Werewolf and the Village Idiot. ([#88](https://github.com/hjwylde/werewolf/issues/88))+* Fixed balance calculation to ensure total balance is between -2 and 2.+* Changed `--random-extra-roles` to have between `n / 3` and `n / 3 + 2` extra roles.+* Added prisms and traversals to Role, Player & Game modules. ([#20](https://github.com/hjwylde/werewolf/issues/20))+* Removed fudging of roles and replaced with fudging of allegiances.+* Wolf-hound now has their allegiance hidden when they are lynched.+* Fixed the grammar on the first Werewolves' turn messages.+* Moved Wolf-hound's turn to before the Seer's so that the Seer may see his allegiance properly.+* Restricted specifying `Simple Villager` or `Simple Werewolf` as extra roles.  #### v0.4.6.0 

@@ -6,7 +6,6 @@ Maintainer  : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-} {-# LANGUAGE OverloadedStrings #-}  module Main (

@@ -30,6 +30,7 @@  import Game.Werewolf +import Werewolf.Game import Werewolf.Messages  data Options = Options

@@ -26,6 +26,7 @@  import Game.Werewolf +import Werewolf.Game import Werewolf.Messages  data Options = Options

@@ -24,6 +24,7 @@  import Game.Werewolf +import Werewolf.Game import Werewolf.Messages  handle :: MonadIO m => Text -> m ()

@@ -25,6 +25,7 @@  import Game.Werewolf +import Werewolf.Game import Werewolf.Messages  handle :: MonadIO m => Text -> m ()

@@ -59,16 +59,17 @@ commandsMessages :: [Text] commandsMessages =     [ "choose (ALLEGIANCE | PLAYER,...) - choose an allegiance or player(s)."+    , "circle [--include-dead] - get the game circle."     , "end - ends the current game."     , "heal - heal the devoured player."     , "pass - pass on healing or poisoning a player."-    , "ping - pings the status of the current game publicly."+    , "ping - ping the status of the current game publicly."     , "poison PLAYER - poison a player."     , "protect PLAYER - protect a player."     , "quit - quit the current game."     , "see PLAYER - see a player's allegiance."     , "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."+    , "status - get the status of the current game."     , "version - show this engine's version."     , "vote PLAYER - vote against a player."     ]

@@ -23,6 +23,7 @@  import Game.Werewolf +import Werewolf.Game import Werewolf.Messages  handle :: MonadIO m => Text -> m ()

@@ -23,6 +23,7 @@  import Game.Werewolf +import Werewolf.Game import Werewolf.Messages  handle :: MonadIO m => Text -> m ()

@@ -26,6 +26,7 @@  import Game.Werewolf +import Werewolf.Game import Werewolf.Messages  data Options = Options

@@ -26,6 +26,7 @@  import Game.Werewolf +import Werewolf.Game import Werewolf.Messages  data Options = Options

@@ -23,6 +23,7 @@  import Game.Werewolf +import Werewolf.Game import Werewolf.Messages  handle :: MonadIO m => Text -> m ()

@@ -26,6 +26,7 @@  import Game.Werewolf +import Werewolf.Game import Werewolf.Messages  data Options = Options

@@ -10,6 +10,7 @@ -}  {-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}  module Werewolf.Commands.Start (     -- * Options@@ -21,20 +22,20 @@  import Control.Lens import Control.Monad.Except-import Control.Monad.Random import Control.Monad.Extra+import Control.Monad.Random import Control.Monad.State import Control.Monad.Writer -import           Data.List import           Data.Text (Text) import qualified Data.Text as T -import Game.Werewolf-import Game.Werewolf.Role as Role+import Game.Werewolf      hiding (name)+import Game.Werewolf.Role  import System.Random.Shuffle +import Werewolf.Game import Werewolf.Messages  data Options = Options@@ -47,7 +48,7 @@  handle :: MonadIO m => Text -> Options -> m () handle callerName (Options extraRoles playerNames) = do-    whenM (doesGameExist &&^ fmap (not . isGameOver) readGame) $ exitWith failure+    whenM (doesGameExist &&^ (hasn't (stage . _GameOver) <$> readGame)) $ exitWith failure         { messages = [gameAlreadyRunningMessage callerName]         } @@ -67,7 +68,7 @@  randomExtraRoles :: MonadIO m => Int -> m [Role] randomExtraRoles n = liftIO . evalRandIO $ do-    let minimum = n `div` 5 + 1+    let minimum = n `div` 3      count <- getRandomR (minimum, minimum + 2) @@ -79,4 +80,4 @@     Nothing     -> throwError [roleDoesNotExistMessage callerName roleName]  findByName :: Text -> Maybe Role-findByName name' = find ((name' ==) . T.toLower . view Role.name) allRoles+findByName name' = restrictedRoles ^? traverse . filtered ((name' ==) . T.toLower . view name)

@@ -23,6 +23,7 @@  import Game.Werewolf +import Werewolf.Game import Werewolf.Messages  handle :: MonadIO m => Text -> m ()

@@ -27,6 +27,7 @@  import Game.Werewolf +import Werewolf.Game import Werewolf.Messages  data Options = Options

@@ -0,0 +1,74 @@+{-|+Module      : Werewolf.Game+Description : Game functions pertaining to binary calls.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++This module defines a few utility functions for working with a game state file. It also provides+functions for padding roles and shuffling them when creating players.+-}++module Werewolf.Game (+    -- * Game++    -- ** Creating anew+    startGame, createPlayers, padRoles,++    -- ** Working with an existing+    defaultFilePath, readGame, writeGame, deleteGame, doesGameExist,+) where++import Control.Lens         hiding (cons)+import Control.Monad.Except+import Control.Monad.Random++import Data.List.Extra+import Data.Text       (Text)++import Game.Werewolf++import Prelude hiding (round)++import System.Directory+import System.FilePath+import System.Random.Shuffle++createPlayers :: MonadIO m => [Text] -> [Role] -> m [Player]+createPlayers playerNames roles = liftIO $ zipWith newPlayer playerNames <$> evalRandIO (shuffleM roles)++padRoles :: [Role] -> Int -> [Role]+padRoles roles n = roles ++ simpleVillagerRoles ++ simpleWerewolfRoles+    where+        goal                    = 3+        m                       = max (n - length roles) 0+        startingBalance         = sumOf (traverse . balance) roles+        simpleWerewolfBalance   = simpleWerewolfRole ^. balance++        -- Little magic here to calculate how many Werewolves and Villagers we want.+        -- This tries to ensure that the balance of the game is between -2 and 2.+        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++defaultFilePath :: MonadIO m => m FilePath+defaultFilePath = (</> defaultFileName) <$> liftIO getHomeDirectory++defaultFileName :: FilePath+defaultFileName = ".werewolf"++readGame :: MonadIO m => m Game+readGame = liftIO . fmap read $ defaultFilePath >>= readFile++writeGame :: MonadIO m => Game -> m ()+writeGame game = liftIO $ defaultFilePath >>= flip writeFile (show game)++deleteGame :: MonadIO m => m ()+deleteGame = liftIO $ defaultFilePath >>= removeFile++doesGameExist :: MonadIO m => m Bool+doesGameExist = liftIO $ defaultFilePath >>= doesFileExist

@@ -97,7 +97,7 @@         , command "help"        $ info (helper <*> help_)       (fullDesc <> progDesc "Help documents")         , command "interpret"   $ info (helper <*> interpret)   (fullDesc <> progDesc "Interpret a command" <> noIntersperse)         , command "pass"        $ info (helper <*> pass)        (fullDesc <> progDesc "Pass")-        , command "ping"        $ info (helper <*> ping)        (fullDesc <> progDesc "Pings the status of the current game publicly")+        , command "ping"        $ info (helper <*> ping)        (fullDesc <> progDesc "Ping the status of the current game publicly")         , command "poison"      $ info (helper <*> poison)      (fullDesc <> progDesc "Poison a player")         , command "protect"     $ info (helper <*> protect)     (fullDesc <> progDesc "Protect a player")         , command "quit"        $ info (helper <*> quit)        (fullDesc <> progDesc "Quit the current game")

@@ -6,29 +6,26 @@ License     : BSD3 Maintainer  : public@hjwylde.com -Re-exports all of the public modules under /Game.Werewolf/.+Re-exports all of the public modules under /Game.Werewolf/. These are: -Where clashes are found between "Game.Werewolf.Game" and "Game.Werewolf.Engine", the-"Game.Werewolf.Game" functions are preferred.+* "Game.Werewolf.Command"+* "Game.Werewolf.Engine"+* "Game.Werewolf.Game"+* "Game.Werewolf.Player"+* "Game.Werewolf.Response"+* "Game.Werewolf.Role" -Likewise, where clashes are found between "Game.Werewolf.Player" and "Game.Werewolf.Role", the+N.B., 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+    module Werewolf ) 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)+import Game.Werewolf.Command  as Werewolf+import Game.Werewolf.Engine   as Werewolf+import Game.Werewolf.Game     as Werewolf+import Game.Werewolf.Player   as Werewolf+import Game.Werewolf.Response as Werewolf+import Game.Werewolf.Role     as Werewolf hiding (name)

@@ -12,7 +12,7 @@ {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE Rank2Types            #-}  module Game.Werewolf.Command (     -- * Command@@ -24,7 +24,7 @@     statusCommand, voteDevourCommand, voteLynchCommand, ) where -import Control.Lens         hiding (only)+import Control.Lens import Control.Monad.Except import Control.Monad.Extra import Control.Monad.State  hiding (state)@@ -36,18 +36,13 @@ import           Data.Text  (Text) import qualified Data.Text  as T -import           Game.Werewolf.Engine-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.Game     hiding (doesPlayerExist, getPendingVoters, killPlayer) import           Game.Werewolf.Messages+import           Game.Werewolf.Player import           Game.Werewolf.Response+import           Game.Werewolf.Role     hiding (name)+import qualified Game.Werewolf.Role     as Role+import           Game.Werewolf.Util  data Command = Command { apply :: forall m . (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => m () } @@ -56,13 +51,13 @@     validatePlayer callerName callerName     unlessM (isPlayerWolfHound callerName)  $ throwError [playerCannotDoThatMessage callerName]     unlessM isWolfHoundsTurn                $ throwError [playerCannotDoThatRightNowMessage callerName]-    when (isNothing mRole)                  $ throwError [allegianceDoesNotExistMessage callerName allegianceName]+    when (isNothing mAllegiance)            $ throwError [allegianceDoesNotExistMessage callerName allegianceName] -    setPlayerRole callerName (fromJust mRole)+    allegianceChosen .= mAllegiance     where-        mRole = case T.toLower allegianceName of-            "villagers"     -> Just simpleVillagerRole-            "werewolves"    -> Just simpleWerewolfRole+        mAllegiance = case T.toLower allegianceName of+            "villagers"     -> Just Villagers+            "werewolves"    -> Just Werewolves             _               -> Nothing  choosePlayerCommand :: Text -> Text -> Command@@ -92,15 +87,15 @@  circleCommand :: Text -> Bool -> Command circleCommand callerName includeDead = Command $ do-        players' <- uses players (if includeDead then id else filterAlive)+        players' <- toListOf (players . traverse . if includeDead then id else alive) <$> get          tell [circleMessage callerName players']  healCommand :: Text -> Command healCommand callerName = Command $ do     validateWitchsCommand callerName-    whenM (use healUsed)                    $ throwError [playerHasAlreadyHealedMessage callerName]-    whenM (isNothing <$> getDevourEvent)    $ throwError [playerCannotDoThatRightNowMessage callerName]+    whenM (use healUsed)                                        $ throwError [playerHasAlreadyHealedMessage callerName]+    whenM (hasn't (events . traverse . _DevourEvent) <$> get)   $ throwError [playerCannotDoThatRightNowMessage callerName]      heal        .= True     healUsed    .= True@@ -118,57 +113,56 @@ pingCommand = Command $ use stage >>= \stage' -> case stage' of     GameOver        -> return ()     DefendersTurn   -> do-        defender <- findPlayerByRole_ defenderRole+        defender <- findPlayerBy_ role defenderRole -        tell [pingRoleMessage $ defender ^. role . Role.name]+        tell [pingRoleMessage $ defenderRole ^. Role.name]         tell [pingPlayerMessage $ defender ^. name]     ScapegoatsTurn  -> do-        scapegoat <- findPlayerByRole_ scapegoatRole+        scapegoat <- findPlayerBy_ role scapegoatRole -        tell [pingRoleMessage $ scapegoat ^. role . Role.name]+        tell [pingRoleMessage $ scapegoatRole ^. Role.name]         tell [pingPlayerMessage $ scapegoat ^. name]     SeersTurn       -> do-        seer <- findPlayerByRole_ seerRole+        seer <- findPlayerBy_ role seerRole -        tell [pingRoleMessage $ seer ^. role . Role.name]+        tell [pingRoleMessage $ seerRole ^. Role.name]         tell [pingPlayerMessage $ seer ^. name]     Sunrise         -> return ()     Sunset          -> return ()     UrsussGrunt     -> return ()     VillagesTurn    -> do-        allowedVoters <- getAllowedVoters-        pendingVoters <- getPendingVoters+        allowedVoterNames <- use allowedVoters+        pendingVoterNames <- toListOf names <$> getPendingVoters -        tell [waitingOnMessage Nothing $ allowedVoters `intersect` pendingVoters]-        tell $ map (pingPlayerMessage . view name) (allowedVoters `intersect` pendingVoters)+        tell [waitingOnMessage Nothing $ allowedVoterNames `intersect` pendingVoterNames]+        tell $ map pingPlayerMessage (allowedVoterNames `intersect` pendingVoterNames)     WerewolvesTurn  -> do         pendingVoters <- getPendingVoters          tell [pingRoleMessage "Werewolves"]-        tell $ map (pingPlayerMessage . view name) (filterWerewolves pendingVoters)+        tell $ map pingPlayerMessage (pendingVoters ^.. werewolves . name)     WildChildsTurn  -> do-        wildChild <- findPlayerByRole_ wildChildRole+        wildChild <- findPlayerBy_ role wildChildRole -        tell [pingRoleMessage $ wildChild ^. role . Role.name]+        tell [pingRoleMessage $ wildChildRole ^. Role.name]         tell [pingPlayerMessage $ wildChild ^. name]     WitchsTurn      -> do-        witch <- findPlayerByRole_ witchRole+        witch <- findPlayerBy_ role witchRole -        tell [pingRoleMessage $ witch ^. role . Role.name]+        tell [pingRoleMessage $ witchRole ^. Role.name]         tell [pingPlayerMessage $ witch ^. name]     WolfHoundsTurn  -> do-        wolfHound <- findPlayerByRole_ wolfHoundRole+        wolfHound <- findPlayerBy_ role wolfHoundRole -        tell [pingRoleMessage $ wolfHound ^. role . Role.name]+        tell [pingRoleMessage $ wolfHoundRole ^. Role.name]         tell [pingPlayerMessage $ wolfHound ^. name]  poisonCommand :: Text -> Text -> Command poisonCommand callerName targetName = Command $ do     validateWitchsCommand callerName-    whenM (use poisonUsed)              $ throwError [playerHasAlreadyPoisonedMessage callerName]+    whenM (use poisonUsed)                                                      $ throwError [playerHasAlreadyPoisonedMessage callerName]     validatePlayer callerName targetName-    whenJustM getDevourEvent            $ \(DevourEvent targetName') ->-        when (targetName == targetName') $ throwError [playerCannotDoThatMessage callerName]+    whenM (has (events . traverse . _DevourEvent . only targetName) <$> get)    $ throwError [playerCannotDoThatMessage callerName]      poison      .= Just targetName     poisonUsed  .= True@@ -176,11 +170,10 @@ protectCommand :: Text -> Text -> Command protectCommand callerName targetName = Command $ do     validatePlayer callerName callerName-    unlessM (isPlayerDefender callerName)   $ throwError [playerCannotDoThatMessage callerName]-    unlessM isDefendersTurn                 $ throwError [playerCannotDoThatRightNowMessage callerName]+    unlessM (isPlayerDefender callerName)                           $ throwError [playerCannotDoThatMessage callerName]+    unlessM isDefendersTurn                                         $ throwError [playerCannotDoThatRightNowMessage callerName]     validatePlayer callerName targetName-    whenJustM (use priorProtect) $ \priorName ->-        when (targetName == priorName) $ throwError [playerCannotProtectSamePlayerTwiceInARowMessage callerName]+    whenM (has (priorProtect . traverse . only targetName) <$> get) $ throwError [playerCannotProtectSamePlayerTwiceInARowMessage callerName]      priorProtect    .= Just targetName     protect         .= Just targetName@@ -189,24 +182,26 @@ quitCommand callerName = Command $ do     validatePlayer callerName callerName -    caller <- findPlayerByName_ callerName+    caller <- findPlayerBy_ name callerName      killPlayer callerName     tell [playerQuitMessage caller] -    passes %= delete callerName-    when (isAngel caller)       $ setPlayerRole callerName simpleVillagerRole-    when (isDefender caller)    $ do+    passes  %= delete callerName+    votes   %= Map.delete callerName++    when (is angel caller)      $ setPlayerAllegiance callerName Villagers+    when (is defender caller)   $ do         protect         .= Nothing         priorProtect    .= Nothing-    when (isSeer caller)        $ see .= Nothing-    when (isWildChild caller)   $ roleModel .= Nothing-    when (isWitch caller)       $ do+    when (is seer caller)       $ see .= Nothing+    when (is wildChild caller)  $ roleModel .= Nothing+    when (is witch caller)      $ do         heal        .= False         healUsed    .= False         poison      .= Nothing         poisonUsed  .= False-    votes %= Map.delete callerName+    when (is wolfHound caller)  $ allegianceChosen .= Nothing  seeCommand :: Text -> Text -> Command seeCommand callerName targetName = Command $ do@@ -223,23 +218,18 @@     Sunrise         -> return ()     Sunset          -> return ()     VillagesTurn    -> do-        game            <- get-        allowedVoters   <- getAllowedVoters-        pendingVoters   <- getPendingVoters+        allowedVoterNames <- use allowedVoters+        pendingVoterNames <- toListOf names <$> getPendingVoters -        tell $ standardStatusMessages stage' (game ^. players)-        tell [waitingOnMessage (Just callerName) (allowedVoters `intersect` pendingVoters)]+        tell . standardStatusMessages stage' =<< use players+        tell [waitingOnMessage (Just callerName) (allowedVoterNames `intersect` pendingVoterNames)]     WerewolvesTurn  -> do-        game            <- get-        pendingVoters   <- filterWerewolves <$> getPendingVoters+        pendingVoterNames <- toListOf (werewolves . name) <$> getPendingVoters -        tell $ standardStatusMessages stage' (game ^. players)+        tell . standardStatusMessages stage' =<< use players         whenM (doesPlayerExist callerName &&^ isPlayerWerewolf callerName) $-            tell [waitingOnMessage (Just callerName) pendingVoters]-    _               -> do-        game <- get--        tell $ standardStatusMessages stage' (game ^. players)+            tell [waitingOnMessage (Just callerName) pendingVoterNames]+    _               -> tell . standardStatusMessages stage' =<< use players     where         standardStatusMessages stage players =             currentStageMessages callerName stage ++ [playersInGameMessage callerName players]@@ -247,25 +237,26 @@ voteDevourCommand :: Text -> Text -> Command voteDevourCommand callerName targetName = Command $ do     validatePlayer callerName callerName-    unlessM (isPlayerWerewolf callerName)           $ throwError [playerCannotDoThatMessage callerName]-    unlessM isWerewolvesTurn                        $ throwError [playerCannotDoThatRightNowMessage callerName]-    whenJustM (getPlayerVote callerName) . const    $ throwError [playerHasAlreadyVotedMessage callerName]+    unlessM (isPlayerWerewolf callerName)       $ throwError [playerCannotDoThatMessage callerName]+    unlessM isWerewolvesTurn                    $ throwError [playerCannotDoThatRightNowMessage callerName]+    whenM (isJust <$> getPlayerVote callerName) $ throwError [playerHasAlreadyVotedMessage callerName]     validatePlayer callerName targetName-    whenM (isPlayerWerewolf targetName)             $ throwError [playerCannotDevourAnotherWerewolfMessage callerName]+    whenM (isPlayerWerewolf targetName)         $ throwError [playerCannotDevourAnotherWerewolfMessage callerName]      votes %= Map.insert callerName targetName -    aliveWerewolfNames <- uses players $ map (view name) . filterAlive . filterWerewolves+    aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get -    tell $ map (\werewolfName -> playerMadeDevourVoteMessage werewolfName callerName targetName) (aliveWerewolfNames \\ [callerName])+    tell [playerMadeDevourVoteMessage werewolfName callerName targetName | werewolfName <- aliveWerewolfNames \\ [callerName]]  voteLynchCommand :: Text -> Text -> Command voteLynchCommand callerName targetName = Command $ do     validatePlayer callerName callerName-    whenM (uses allowedVoters (callerName `notElem`))   $ throwError [playerCannotDoThatMessage 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]+    whenM (isJust <$> getPlayerVote callerName)                             $ throwError [playerHasAlreadyVotedMessage callerName]     validatePlayer callerName targetName+    whenM (use villageIdiotRevealed &&^ isPlayerVillageIdiot targetName)    $ throwError [playerCannotLynchVillageIdiotMessage callerName]      votes %= Map.insert callerName targetName 

@@ -18,74 +18,33 @@     checkStage, checkGameOver,      -- * Game--    -- ** Manipulations-    startGame, killPlayer, setPlayerRole,--    -- ** Searches-    findPlayerByName_, findPlayerByRole_,--    -- ** Queries-    isGameOver, isDefendersTurn, isScapegoatsTurn, isSeersTurn, isVillagesTurn, isWerewolvesTurn,-    isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn,-    getPlayerVote, getAllowedVoters, getPendingVoters, getVoteResult,--    -- ** Reading and writing-    defaultFilePath, writeGame, readGame, deleteGame, doesGameExist,--    -- * Event--    -- ** Queries-    getDevourEvent,--    -- * Player--    -- ** Manipulations-    createPlayers,--    -- ** Queries-    doesPlayerExist,-    isPlayerDefender, isPlayerScapegoat, isPlayerSeer, isPlayerVillageIdiot, isPlayerWildChild,-    isPlayerWitch, isPlayerWolfHound,-    isPlayerWerewolf,-    isPlayerAlive, isPlayerDead,--    -- * Role-    padRoles,+    startGame, ) where -import Control.Lens         hiding (cons, snoc)+import Control.Lens         hiding (cons, isn't) import Control.Monad.Except import Control.Monad.Extra-import Control.Monad.Random import Control.Monad.State  hiding (state) import Control.Monad.Writer  import           Data.List.Extra import qualified Data.Map        as Map+import           Data.Maybe import           Data.Text       (Text) import qualified Data.Text       as T -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.Game     hiding (doesPlayerExist, getAllowedVoters, getPendingVoters,+                                         getVoteResult, hasAngelWon, hasAnyoneWon, hasVillagersWon,+                                         hasWerewolvesWon, killPlayer) import           Game.Werewolf.Messages+import           Game.Werewolf.Player import           Game.Werewolf.Response+import           Game.Werewolf.Role     hiding (name)+import qualified Game.Werewolf.Role     as Role+import           Game.Werewolf.Util  import Prelude hiding (round) -import System.Directory-import System.FilePath-import System.Random.Shuffle- checkStage :: (MonadState Game m, MonadWriter [Message] m) => m () checkStage = do     game <- get@@ -99,9 +58,9 @@     GameOver -> return ()      DefendersTurn -> do-        whenM (isDead <$> findPlayerByRole_ defenderRole) advanceStage+        whenM (has (players . defenders . dead) <$> get) advanceStage -        whenJustM (use protect) $ const advanceStage+        whenM (isJust <$> use protect) advanceStage      ScapegoatsTurn -> unlessM (use scapegoatBlamed) $ do         allowedVoters' <- use allowedVoters@@ -110,12 +69,11 @@         advanceStage      SeersTurn -> do-        seer <- findPlayerByRole_ seerRole--        when (isDead seer) advanceStage+        whenM (has (players . seers . dead) <$> get) advanceStage          whenJustM (use see) $ \targetName -> do-            target <- findPlayerByName_ targetName+            seer    <- findPlayerBy_ role seerRole+            target  <- findPlayerBy_ name targetName              tell [playerSeenMessage (seer ^. name) target] @@ -124,19 +82,19 @@     Sunrise -> do         round += 1 -        whenJustM (findAlivePlayerByRole angelRole) $ \angel -> do+        whenJustM (preuse $ players . angels . alive) $ \angel -> do             tell [angelJoinedVillagersMessage] -            setPlayerRole (angel ^. name) simpleVillagerRole+            setPlayerAllegiance (angel ^. name) Villagers          advanceStage      Sunset -> do         whenJustM (use roleModel) $ \roleModelsName -> do-            wildChild <- findPlayerByRole_ wildChildRole+            wildChild <- findPlayerBy_ role wildChildRole -            whenM (isPlayerDead roleModelsName &&^ return (isVillager wildChild)) $ do-                aliveWerewolfNames <- uses players (map (view name) . filterAlive . filterWerewolves)+            whenM (isPlayerDead roleModelsName &&^ return (is villager wildChild)) $ do+                aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get                  setPlayerAllegiance (wildChild ^. name) Werewolves @@ -146,10 +104,10 @@         advanceStage      UrsussGrunt -> do-        bearTamer   <- findPlayerByRole_ bearTamerRole-        players'    <- cons bearTamer <$> gets (getAdjacentAlivePlayers $ bearTamer ^. name)+        bearTamer   <- findPlayerBy_ role bearTamerRole+        players'    <- getAdjacentAlivePlayers (bearTamer ^. name) -        when (any isWerewolf players') $ tell [ursusGruntsMessage]+        when (has werewolves players') $ tell [ursusGruntsMessage]          advanceStage @@ -158,14 +116,14 @@          getVoteResult >>= lynchVotees -        allowedVoters'  <- ifM (use villageIdiotRevealed)-            (uses players (filter $ not . isVillageIdiot))+        allVoters       <- ifM (use villageIdiotRevealed)+            (uses players $ filter (isn't villageIdiot))             (use players)-        allowedVoters   .= map (view name) (filterAlive allowedVoters')+        allowedVoters   .= allVoters ^.. traverse . alive . name          advanceStage -    WerewolvesTurn -> whenM (null . filterWerewolves <$> getPendingVoters) $ do+    WerewolvesTurn -> whenM (none (is werewolf) <$> getPendingVoters) $ do         getVoteResult >>= devourVotees          protect .= Nothing@@ -173,38 +131,46 @@         advanceStage      WildChildsTurn -> do-        whenM (isDead <$> findPlayerByRole_ wildChildRole) advanceStage+        whenM (has (players . wildChildren . dead) <$> get) advanceStage -        whenJustM (use roleModel) $ const advanceStage+        whenM (isJust <$> use roleModel) advanceStage      WitchsTurn -> do-        whenM (isDead <$> findPlayerByRole_ witchRole) advanceStage+        whenM (has (players . witches . dead) <$> get) advanceStage          whenJustM (use poison) $ \targetName -> do             events %= (++ [PoisonEvent targetName])             poison .= Nothing          whenM (use heal) $ do-            devourEvent <- uses events $ \events -> head [event | event@(DevourEvent _) <- events]+            devourEvent <- fromJust <$> preuse (events . traverse . filtered (is _DevourEvent))              events  %= cons NoDevourEvent . delete devourEvent             heal    .= False          whenM (use healUsed &&^ use poisonUsed) advanceStage-        whenM (any isWitch <$> getPassers)      advanceStage+        whenM (has witches <$> getPassers)      advanceStage -    WolfHoundsTurn -> unlessM (uses players (any isWolfHound . filterAlive)) advanceStage+    WolfHoundsTurn -> do+        whenM (has (players . wolfHounds . dead) <$> get) advanceStage +        whenJustM (use allegianceChosen) $ \allegiance -> do+            wolfHound <- findPlayerBy_ role wolfHoundRole++            setPlayerAllegiance (wolfHound ^. name) allegiance++            advanceStage+ lynchVotees :: (MonadState Game m, MonadWriter [Message] m) => [Player] -> m () lynchVotees [votee]-    | isVillageIdiot votee  = do+    | is villageIdiot votee = do         villageIdiotRevealed .= True          tell [villageIdiotLynchedMessage $ votee ^. name]     | otherwise             = do         killPlayer (votee ^. name)         tell [playerLynchedMessage votee]-lynchVotees _       = findAlivePlayerByRole scapegoatRole >>= \mScapegoat -> case mScapegoat of+lynchVotees _       = preuse (players . scapegoats . alive) >>= \mScapegoat -> case mScapegoat of     Just scapegoat  -> do         scapegoatBlamed .= True @@ -220,13 +186,10 @@  advanceStage :: (MonadState Game m, MonadWriter [Message] m) => m () advanceStage = do-    game                <- get-    stage'              <- use stage-    aliveAllegiances    <- uses players (nub . map (view $ role . allegiance) . filterAlive)--    let nextStage = if length aliveAllegiances <= 1 || any isAngel (filterDead $ game ^. players)-        then GameOver-        else head $ filter (stageAvailable game) (drop1 $ dropWhile (stage' /=) stageCycle)+    game        <- get+    nextStage   <- ifM hasAnyoneWon+        (return GameOver)+        (return . head $ filter (stageAvailable game) (drop1 $ dropWhile (game ^. stage /=) stageCycle))      stage   .= nextStage     passes  .= []@@ -244,32 +207,25 @@     mapM_ applyEvent available  eventAvailable :: MonadState Game m => Event -> m Bool-eventAvailable (DevourEvent _)  = gets isSunrise-eventAvailable NoDevourEvent    = gets isSunrise-eventAvailable (PoisonEvent _)  = gets isSunrise+eventAvailable (DevourEvent _)  = isSunrise+eventAvailable NoDevourEvent    = isSunrise+eventAvailable (PoisonEvent _)  = isSunrise  applyEvent :: (MonadState Game m, MonadWriter [Message] m) => Event -> m () applyEvent (DevourEvent targetName) = do-    player <- findPlayerByName_ targetName+    target <- findPlayerBy_ name targetName      killPlayer targetName-    tell [playerDevouredMessage player]+    tell [playerDevouredMessage target] applyEvent NoDevourEvent            = tell [noPlayerDevouredMessage]-applyEvent (PoisonEvent name)       = do-    player <- findPlayerByName_ name+applyEvent (PoisonEvent targetName) = do+    target <- findPlayerBy_ name targetName -    killPlayer name-    tell [playerPoisonedMessage player]+    killPlayer targetName+    tell [playerPoisonedMessage target]  checkGameOver :: (MonadState Game m, MonadWriter [Message] m) => m ()-checkGameOver = do-    aliveAllegiances    <- uses players (nub . map (view $ role . allegiance) . filterAlive)-    deadPlayers         <- uses players filterDead--    when (length aliveAllegiances <= 1 || any isAngel deadPlayers) $ do-        stage .= GameOver--        tell . gameOverMessages =<< get+checkGameOver = whenM hasAnyoneWon $ stage .= GameOver >> get >>= tell . gameOverMessages  startGame :: (MonadError [Message] m, MonadWriter [Message] m) => Text -> [Player] -> m Game startGame callerName players = do@@ -277,7 +233,7 @@     when (length players < 7)               $ throwError [privateMessage callerName "Must have at least 7 players."]     when (length players > 24)              $ throwError [privateMessage callerName "Cannot have more than 24 players."]     forM_ restrictedRoles $ \role' ->-        when (length (filter ((role' ==) . view role) players) > 1) $+        when (length (players ^.. traverse . filteredBy role role') > 1) $             throwError [privateMessage callerName $ T.concat ["Cannot have more than 1 ", role' ^. Role.name, "."]]      let game = newGame players@@ -286,138 +242,4 @@      return game     where-        playerNames = map (view name) players--killPlayer :: MonadState Game m => Text -> m ()-killPlayer name = modify $ Game.killPlayer name--setPlayerRole :: MonadState Game m => Text -> Role -> m ()-setPlayerRole name role = modify $ Game.setPlayerRole name role--setPlayerAllegiance :: MonadState Game m => Text -> Allegiance -> m ()-setPlayerAllegiance name allegiance = modify $ Game.setPlayerAllegiance name allegiance--findPlayerByName_ :: MonadState Game m => Text -> m Player-findPlayerByName_ name = uses players $ findByName_ name--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--isVillagesTurn :: MonadState Game m => m Bool-isVillagesTurn = gets Game.isVillagesTurn--isWerewolvesTurn :: MonadState Game m => m Bool-isWerewolvesTurn = gets Game.isWerewolvesTurn--isWildChildsTurn :: MonadState Game m => m Bool-isWildChildsTurn = gets Game.isWildChildsTurn--isWitchsTurn :: MonadState Game m => m Bool-isWitchsTurn = gets Game.isWitchsTurn--isWolfHoundsTurn :: MonadState Game m => m Bool-isWolfHoundsTurn = gets Game.isWolfHoundsTurn--isGameOver :: MonadState Game m => m Bool-isGameOver = gets Game.isGameOver--getPassers :: MonadState Game m => m [Player]-getPassers = gets Game.getPassers--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--getVoteResult :: MonadState Game m => m [Player]-getVoteResult = gets Game.getVoteResult--defaultFilePath :: MonadIO m => m FilePath-defaultFilePath = (</> defaultFileName) <$> liftIO getHomeDirectory--defaultFileName :: FilePath-defaultFileName = ".werewolf"--readGame :: MonadIO m => m Game-readGame = liftIO . fmap read $ defaultFilePath >>= readFile--writeGame :: MonadIO m => Game -> m ()-writeGame game = liftIO $ defaultFilePath >>= flip writeFile (show game)--deleteGame :: MonadIO m => m ()-deleteGame = liftIO $ defaultFilePath >>= removeFile--doesGameExist :: MonadIO m => m Bool-doesGameExist = liftIO $ defaultFilePath >>= doesFileExist--getDevourEvent :: MonadState Game m => m (Maybe Event)-getDevourEvent = gets Game.getDevourEvent--createPlayers :: MonadIO m => [Text] -> [Role] -> m [Player]-createPlayers playerNames roles = liftIO $ zipWith newPlayer playerNames <$> evalRandIO (shuffleM roles)--doesPlayerExist :: MonadState Game m => Text -> m Bool-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--isPlayerWitch :: MonadState Game m => Text -> m Bool-isPlayerWitch name = isWitch <$> findPlayerByName_ name--isPlayerWolfHound :: MonadState Game m => Text -> m Bool-isPlayerWolfHound name = isWolfHound <$> findPlayerByName_ name--isPlayerWerewolf :: MonadState Game m => Text -> m Bool-isPlayerWerewolf name = isWerewolf <$> findPlayerByName_ name--isPlayerAlive :: MonadState Game m => Text -> m Bool-isPlayerAlive name = isAlive <$> findPlayerByName_ name--isPlayerDead :: MonadState Game m => Text -> m Bool-isPlayerDead name = isDead <$> findPlayerByName_ name--padRoles :: [Role] -> Int -> [Role]-padRoles roles n = roles ++ simpleVillagerRoles ++ simpleWerewolfRoles-    where-        goal                    = 2-        m                       = max (n - length roles) 0-        startingBalance         = sum (map (view balance) roles)-        simpleWerewolfBalance   = simpleWerewolfRole ^. balance--        -- 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+        playerNames = players ^.. names

@@ -1,30 +1,260 @@ {-| Module      : Game.Werewolf.Game-Description : Game data structure.-+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 -Game functions are defined in "Game.Werewolf.Internal.Game". This module just re-exports the-functions relevant to the public interface.+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 and querying the game state. -} +{-# LANGUAGE TemplateHaskell #-}+ module Game.Werewolf.Game (     -- * Game-    Game, stage, round, players, events, passes, allowedVoters, heal, healUsed, poison, poisonUsed,-    priorProtect, protect, roleModel, scapegoatBlamed, see, villageIdiotRevealed, votes,+    Game,+    stage, round, players, events, passes, allegianceChosen, allowedVoters, heal, healUsed, poison,+    poisonUsed, priorProtect, protect, roleModel, scapegoatBlamed, see, villageIdiotRevealed, votes,      Stage(..),+    _DefendersTurn, _GameOver, _ScapegoatsTurn, _SeersTurn, _Sunrise, _Sunset, _UrsussGrunt,+    _VillagesTurn, _WerewolvesTurn, _WildChildsTurn, _WitchsTurn, _WolfHoundsTurn, +    allStages,+    stageCycle, stageAvailable,+     Event(..),+    _DevourEvent, _NoDevourEvent, _PoisonEvent, +    newGame,++    -- ** Manipulations+    killPlayer,++    -- ** Searches+    getAllowedVoters, getPendingVoters, getVoteResult,+     -- ** Queries-    isDefendersTurn, isGameOver, isScapegoatsTurn, isSeersTurn, isSunrise, isSunset, isVillagesTurn,-    isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn,+    isFirstRound,     doesPlayerExist,+    hasAnyoneWon, hasAngelWon, hasVillagersWon, hasWerewolvesWon, ) where -import Game.Werewolf.Internal.Game+import Control.Lens hiding (isn't) +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 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]+    , _allegianceChosen     :: Maybe Allegiance -- ^ Wolf-hound+    , _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 'DeovurEvent' 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++makePrisms ''Stage++makePrisms ''Event++-- | All of the 'Stage's in the order that they should occur.+allStages :: [Stage]+allStages =+    [ VillagesTurn+    , ScapegoatsTurn+    , Sunset+    , WolfHoundsTurn+    , SeersTurn+    , WildChildsTurn+    , DefendersTurn+    , WerewolvesTurn+    , WitchsTurn+    , Sunrise+    , UrsussGrunt+    , GameOver+    ]++-- | An infinite cycle of all 'Stage's 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   = has (players . defenders . alive) game+stageAvailable _ GameOver           = False+stageAvailable game ScapegoatsTurn  = game ^. scapegoatBlamed+stageAvailable game SeersTurn       = has (players . seers . alive) game+stageAvailable _ Sunrise            = True+stageAvailable _ Sunset             = True+stageAvailable game UrsussGrunt     = has (players . bearTamers . alive) game+stageAvailable game VillagesTurn    =+    (has (players . angels . alive) game || not (isFirstRound game))+    && any (is alive) (getAllowedVoters game)+stageAvailable game WerewolvesTurn  = has (players . werewolves . alive) game+stageAvailable game WildChildsTurn  =+    has (players . wildChildren . alive) game+    && isNothing (game ^. roleModel)+stageAvailable game WitchsTurn      =+    has (players . witches . alive) game+    && (not (game ^. healUsed) || not (game ^. poisonUsed))+stageAvailable game WolfHoundsTurn  = has (players . wolfHounds . alive) game++-- | 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               = []+            , _allegianceChosen     = Nothing+            , _allowedVoters        = players ^.. names+            , _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' = players . traverse . filteredBy name name' . state .~ Dead++-- | Gets all the 'allowedVoters' in a game (which is names only) and maps them to their player.+getAllowedVoters :: Game -> [Player]+getAllowedVoters game =+    map (\name' -> game ^?! players . traverse . filteredBy name name') (game ^. allowedVoters)++-- | Gets all 'Alive' players that have yet to vote.+getPendingVoters :: Game -> [Player]+getPendingVoters game =+    game ^.. players . traverse . alive . filtered ((`Map.notMember` votes') . view name)+    where+        votes' = game ^. votes++-- | 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 (\name' -> game ^?! players . traverse . filteredBy name name') result+    where+        votees = Map.elems $ game ^. votes+        result = last $ groupSortOn (length . (`elemIndices` votees)) (nub votees)++-- | @'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 = has $ players . names . only name++-- | Queries whether anyone has won.+hasAnyoneWon :: Game -> Bool+hasAnyoneWon game = any ($ game) [hasAngelWon, hasVillagersWon, hasWerewolvesWon]++-- | Queries whether the Angel has won. The Angel wins if they manage to get themselves killed on+--   the first round.+--+--   N.B., we check that the Angel isn't a 'villager' as the Angel's role is altered if they don't+--   win.+hasAngelWon :: Game -> Bool+hasAngelWon game = has (players . angels) game && is dead angel && isn't villager angel+    where+        angel = game ^?! players . angels++-- | Queries whether the 'Villagers' have won. The 'Villagers' win if they are the only players+--   surviving.+hasVillagersWon :: Game -> Bool+hasVillagersWon = allOf (players . traverse . alive) (is villager)++-- | Queries whether the 'Werewolves' have won. The 'Werewolves' win if they are the only players+--   surviving.+hasWerewolvesWon :: Game -> Bool+hasWerewolvesWon = allOf (players . traverse . alive) (is werewolf)

@@ -1,309 +0,0 @@-{-|-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

@@ -1,180 +0,0 @@-{-|-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

@@ -1,380 +0,0 @@-{-|-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."-    }

@@ -59,7 +59,7 @@     scapegoatLynchedMessage, villageIdiotLynchedMessage,      -- ** Error messages-    playerHasAlreadyVotedMessage,+    playerHasAlreadyVotedMessage, playerCannotLynchVillageIdiotMessage,      -- * Werewolves' turn messages     playerMadeDevourVoteMessage, playerDevouredMessage, noPlayerDevouredMessage,@@ -89,37 +89,34 @@ 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.Game+import           Game.Werewolf.Player import           Game.Werewolf.Response+import           Game.Werewolf.Role     hiding (name)+import qualified Game.Werewolf.Role     as Role  newGameMessages :: Game -> [Message] newGameMessages game = concat-    [ [newPlayersInGameMessage players']-    , [rolesInGameMessage $ map (view role) players']+    [ [newPlayersInGameMessage $ players' ^.. names]+    , [rolesInGameMessage $ players' ^.. roles]     , map newPlayerMessage players'     , villagerVillagerMessages     , stageMessages game     ]     where         players'                    = game ^. players-        villagerVillagerMessages    = case findByRole villagerVillagerRole players' of+        villagerVillagerMessages    = case players' ^? villagerVillagers of             Just villagerVillager   -> [villagerVillagerMessage $ villagerVillager ^. name]             _                       -> [] -newPlayersInGameMessage :: [Player] -> Message-newPlayersInGameMessage players = publicMessage $ T.concat+newPlayersInGameMessage :: [Text] -> Message+newPlayersInGameMessage playerNames = 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"@@ -157,12 +154,12 @@     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+        defendersName       = players' ^?! defenders . name+        scapegoatsName      = players' ^?! scapegoats . name+        seersName           = players' ^?! seers . name+        aliveWerewolfNames  = players' ^.. werewolves . alive . name+        wildChildsName      = players' ^?! wildChildren . name+        wolfHoundsName      = players' ^?! wolfHounds . name  defendersTurnMessages :: Text -> [Message] defendersTurnMessages to =@@ -189,13 +186,13 @@ 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+firstVillagesTurnMessages = angelInPlayMessage : villagesTurnMessages+    where+        angelInPlayMessage = 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 :: [Message] villagesTurnMessages =@@ -205,14 +202,15 @@  firstWerewolvesTurnMessages :: [Text] -> [Message] firstWerewolvesTurnMessages tos =-    map (\to -> privateMessage to $ packMessage to) tos+    [privateMessage to $ packMessage to | length tos > 1, to <- tos]     ++ werewolvesTurnMessages tos     where         packMessage werewolfName    = T.unwords             [ "You feel restless, like an old curse is keeping you from sleep."             , "It seems you're not the only one..."             , packNames werewolfName-            , "are also emerging from their homes."+            , if length tos == 2 then "is" else "are", "also emerging from their"+            , if length tos == 2 then "home." else "homes."             ]         packNames werewolfName      = T.intercalate ", " (tos \\ [werewolfName]) @@ -236,22 +234,22 @@     , [passMessage]     ]     where-        witchsName      = findByRole_ witchRole (game ^. players) ^. name+        witchsName      = game ^?! players . witches . name         wakeUpMessage   = publicMessage "The Witch wakes up."         passMessage     = privateMessage witchsName "Type `pass` to end your turn."-        devourMessages  = case getDevourEvent game of-            Just (DevourEvent targetName)   ->+        devourMessages  = case game ^? events . traverse . _DevourEvent of+            Just 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                         = []+                && has (events . traverse . _DevourEvent) game  = [privateMessage witchsName "Would you like to `heal` them?"]+            | otherwise                                         = []         poisonMessages-            | not (game ^. poisonUsed)          = [privateMessage witchsName "Would you like to `poison` anyone?"]-            | otherwise                         = []+            | not (game ^. poisonUsed) = [privateMessage witchsName "Would you like to `poison` anyone?"]+            | otherwise                = []  wolfHoundsTurnMessages :: Text -> [Message] wolfHoundsTurnMessages to =@@ -261,27 +259,36 @@  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'+    | hasAngelWon game      = 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."]+        , playerWonMessages+        , playerLostMessages+        ]+    | hasVillagersWon game  = concat+        [ [publicMessage "The game is over! The Villagers have won."]+        , playerWonMessages+        , playerLostMessages+        ]+    | hasWerewolvesWon game = concat+        [ [publicMessage "The game is over! The Werewolves have won."]+        , playerWonMessages+        , playerLostMessages+        ]+    | otherwise             = undefined     where-        players'            = game ^. players-        angel               = findByRole_ angelRole players'-        aliveAllegiances    = nub $ map (view $ role . allegiance) (filterAlive players')+        winningAllegiance+            | hasAngelWon game      = Angel+            | hasVillagersWon game  = Villagers+            | hasWerewolvesWon game = Werewolves+            | otherwise             = undefined +        winningPlayerNames  = game ^.. players . traverse . filteredBy (role . allegiance) winningAllegiance . name+        losingPlayerNames   = game ^.. players . names \\ winningPlayerNames++        playerWonMessages   = map playerWonMessage winningPlayerNames+        playerLostMessages  = map playerLostMessage losingPlayerNames+ playerWonMessage :: Text -> Message playerWonMessage to = privateMessage to "Victory! You won!" @@ -289,16 +296,16 @@ 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!"]+playerQuitMessage player = publicMessage $ T.unwords [playerName, "the", playerRole, "has quit!"]+    where+        playerName = player ^. name+        playerRole = player ^. role . Role.name  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."-    ]+playerDoesNotExistMessage to name = privateMessage to $ T.unwords ["Player", name, "does not exist."]  playerCannotDoThatMessage :: Text -> Message playerCannotDoThatMessage to = privateMessage to "You cannot do that!"@@ -318,7 +325,7 @@     , T.intercalate " <-> " (map playerName (players ++ [head players]))     ]     where-        playerName player = T.concat [player ^. name, if isDead player then " (dead)" else ""]+        playerName player = T.concat [player ^. name, if is dead player then " (dead)" else ""]  pingPlayerMessage :: Text -> Message pingPlayerMessage to = privateMessage to "Waiting on you..."@@ -359,34 +366,33 @@     ]     where         roleCounts      = map (head &&& length) (groupSortOn (view Role.name) roles)-        totalBalance    = sum $ map (view balance) roles+        totalBalance    = sumOf (traverse . balance) roles  playersInGameMessage :: Text -> [Player] -> Message playersInGameMessage to players = privateMessage to . T.intercalate "\n" $-    alivePlayersText : if null $ filterDead players then [] else [deadPlayersText]+    alivePlayersText : [deadPlayersText | any (is dead) players]     where         alivePlayersText = T.concat             [ "The following players are still alive: "-            , T.intercalate ", " (map (view name) $ filterAlive players), "."+            , T.intercalate ", " (players ^.. traverse . alive . name), "."             ]         deadPlayersText = T.concat             [ "The following players are dead: "-            , T.intercalate ", " (map (\player -> T.concat [player ^. name, " (", player ^. role . Role.name, ")"]) $ filterDead players), "."+            , T.intercalate ", " (map playerNameWithRole (players ^.. traverse . dead)), "."             ]+        playerNameWithRole player = T.concat [player ^. name, " (", player ^. role . Role.name, ")"] -waitingOnMessage :: Maybe Text -> [Player] -> Message-waitingOnMessage mTo players = Message mTo $ T.concat+waitingOnMessage :: Maybe Text -> [Text] -> Message+waitingOnMessage mTo playerNames = 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."+    , "Now he is stuck here, doomed forever to live out a mortal life as a Villager."     ]  ursusGruntsMessage :: Message@@ -428,14 +434,13 @@  playerLynchedMessage :: Player -> Message playerLynchedMessage player-    | isWerewolf player-        && not (isWildChild player) = publicMessage $ T.concat+    | is simpleWerewolf 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+    | 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 "@@ -460,7 +465,7 @@  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."+    [ "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."     ]@@ -468,6 +473,9 @@ 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, "."@@ -514,9 +522,11 @@ 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."+    , playerName, "the", playerRole, "is hanging over the side of their bed, poisoned."     ]+    where+        playerName = player ^. name+        playerRole = player ^. role . Role.name  playerHasAlreadyHealedMessage :: Text -> Message playerHasAlreadyHealedMessage to = privateMessage to "You've already healed someone!"

@@ -1,19 +1,340 @@ {-| Module      : Game.Werewolf.Player-Description : Simplistic player data structure.+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 -Player functions are defined in "Game.Werewolf.Internal.Player". This module just re-exports the-functions relevant to the public interface.+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". -} +{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types            #-}+{-# LANGUAGE TemplateHaskell       #-}+ module Game.Werewolf.Player (     -- * Player-    Player, name, role, state,+    Player,+    name, role, state,      State(..),+    _Alive, _Dead,++    newPlayer,++    -- ** Traversals+    angel, bearTamer, defender, scapegoat, seer, simpleVillager, simpleWerewolf, villageIdiot,+    villagerVillager, wildChild, witch, wolfHound,+    villager, werewolf,++    -- | These are provided just as a bit of sugar to avoid continually writing @'traverse' .@.+    names, roles, states,++    -- | N.B., these are not legal traversals for the same reason 'filtered' isn't!+    angels, bearTamers, defenders, scapegoats, seers, simpleVillagers, simpleWerewolves,+    villageIdiots, villagerVillagers, wildChildren, witches, wolfHounds,+    villagers, werewolves,+    alive, dead,++    -- * Utility functions+    is, isn't, filteredBy, ) where -import Game.Werewolf.Internal.Player+import Control.Lens hiding (isn't)++import Data.Function+import Data.Text     (Text)++import Game.Werewolf.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'.+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++makePrisms ''State++-- | Creates a new 'Alive' player.+newPlayer :: Text -> Role -> Player+newPlayer name role = Player name role Alive++-- | The traversal of 'Player's with an 'angelRole'.+--+-- @+-- 'angel' = 'role' . 'only' 'angelRole'+-- @+angel :: Traversal' Player ()+angel = role . only angelRole++-- | The traversal of 'Player's with a 'bearTamerRole'.+--+-- @+-- 'bearTamer' = 'role' . 'only' 'bearTamerRole'+-- @+bearTamer :: Traversal' Player ()+bearTamer = role . only bearTamerRole++-- | The traversal of 'Player's with a 'defenderRole'.+--+-- @+-- 'defender' = 'role' . 'only' 'defenderRole'+-- @+defender :: Traversal' Player ()+defender = role . only defenderRole++-- | The traversal of 'Player's with a 'scapegoatRole'.+--+-- @+-- 'scapegoat' = 'role' . 'only' 'scapegoatRole'+-- @+scapegoat :: Traversal' Player ()+scapegoat = role . only scapegoatRole++-- | The traversal of 'Player's with a 'seerRole'.+--+-- @+-- 'seer' = 'role' . 'only' 'seerRole'+-- @+seer :: Traversal' Player ()+seer = role . only seerRole++-- | The traversal of 'Player's with a 'simpleVillagerRole'.+--+-- @+-- 'simpleVillager' = 'role' . 'only' 'simpleVillagerRole'+-- @+simpleVillager :: Traversal' Player ()+simpleVillager = role . only simpleVillagerRole++-- | The traversal of 'Player's with a 'simpleWerewolfRole'.+--+-- @+-- 'simpleWerewolf' = 'role' . 'only' 'simpleWerewolfRole'+-- @+simpleWerewolf :: Traversal' Player ()+simpleWerewolf = role . only simpleWerewolfRole++-- | The traversal of 'Player's with a 'villageIdiotRole'.+--+-- @+-- 'villageIdiot' = 'role' . 'only' 'villageIdiotRole'+-- @+villageIdiot :: Traversal' Player ()+villageIdiot = role . only villageIdiotRole++-- | The traversal of 'Player's with a 'villagerVillagerRole'.+--+-- @+-- 'villagerVillager' = 'role' . 'only' 'villagerVillagerRole'+-- @+villagerVillager :: Traversal' Player ()+villagerVillager = role . only villagerVillagerRole++-- | The traversal of 'Player's with a 'wildChildRole'.+--+-- @+-- 'wildChild' = 'role' . 'only' 'wildChildRole'+-- @+wildChild :: Traversal' Player ()+wildChild = role . only wildChildRole++-- | The traversal of 'Player's with a 'witchRole'.+--+-- @+-- 'witch' = 'role' . 'only' 'witchRole'+-- @+witch :: Traversal' Player ()+witch = role . only witchRole++-- | The traversal of 'Player's with a 'wolfHoundRole'.+--+-- @+-- 'wolfHound' = 'role' . 'only' 'wolfHoundRole'+-- @+wolfHound :: Traversal' Player ()+wolfHound = role . only wolfHoundRole++-- | The traversal of 'Player's aligned with the 'Villagers'.+--+-- @+-- 'villager' = 'role' . 'allegiance' . '_Villagers'+-- @+villager :: Traversal' Player ()+villager = role . allegiance . _Villagers++-- | The traversal of 'Player's aligned with the 'Werewolves'.+--+-- @+-- 'werewolf' = 'role' . 'allegiance' . '_Werewolves'+-- @+werewolf :: Traversal' Player ()+werewolf = role . allegiance . _Werewolves++-- | This 'Traversal' provides the traversal of 'Player' names.+--+-- @+-- 'names' = 'traverse' . 'name'+-- @+names :: Traversable t => Traversal' (t Player) Text+names = traverse . name++-- | This 'Traversal' provides the traversal of 'Player' roles.+--+-- @+-- 'roles' = 'traverse' . 'role'+-- @+roles :: Traversable t => Traversal' (t Player) Role+roles = traverse . role++-- | This 'Traversal' provides the traversal of 'Player' states.+--+-- @+-- 'states' = 'traverse' . 'state'+-- @+states :: Traversable t => Traversal' (t Player) State+states = traverse . state++-- | This 'Traversal' provides the traversal of 'angel' 'Player's.+--+-- @+-- 'angels' = 'traverse' . 'filtered' ('is' 'angel')+-- @+angels :: Traversable t => Traversal' (t Player) Player+angels = traverse . filtered (is angel)++-- | This 'Traversal' provides the traversal of 'bearTamer' 'Player's.+--+-- @+-- 'bearTamers' = 'traverse' . 'filtered' ('is' 'bearTamer')+-- @+bearTamers :: Traversable t => Traversal' (t Player) Player+bearTamers = traverse . filtered (is bearTamer)++-- | This 'Traversal' provides the traversal of 'defender' 'Player's.+--+-- @+-- 'defenders' = 'traverse' . 'filtered' ('is' 'defender')+-- @+defenders :: Traversable t => Traversal' (t Player) Player+defenders = traverse . filtered (is defender)++-- | This 'Traversal' provides the traversal of 'scapegoat' 'Player's.+--+-- @+-- 'scapegoats' = 'traverse' . 'filtered' ('is' 'scapegoat')+-- @+scapegoats :: Traversable t => Traversal' (t Player) Player+scapegoats = traverse . filtered (is scapegoat)++-- | This 'Traversal' provides the traversal of 'seer' 'Player's.+--+-- @+-- 'seers' = 'traverse' . 'filtered' ('is' 'seer')+-- @+seers :: Traversable t => Traversal' (t Player) Player+seers = traverse . filtered (is seer)++-- | This 'Traversal' provides the traversal of 'simpleVillager' 'Player's.+--+-- @+-- 'simpleVillagers' = 'traverse' . 'filtered' ('is' 'simpleVillager')+-- @+simpleVillagers :: Traversable t => Traversal' (t Player) Player+simpleVillagers = traverse . filtered (is simpleVillager)++-- | This 'Traversal' provides the traversal of 'simpleWerewolf' 'Player's.+--+-- @+-- 'simpleWerewolves' = 'traverse' . 'filtered' ('is' 'simpleWerewolf')+-- @+simpleWerewolves :: Traversable t => Traversal' (t Player) Player+simpleWerewolves = traverse . filtered (is simpleWerewolf)++-- | This 'Traversal' provides the traversal of 'villageIdiot' 'Player's.+--+-- @+-- 'villageIdiots' = 'traverse' . 'filtered' ('is' 'villageIdiot')+-- @+villageIdiots :: Traversable t => Traversal' (t Player) Player+villageIdiots = traverse . filtered (is villageIdiot)++-- | This 'Traversal' provides the traversal of 'villagerVillager' 'Player's.+--+-- @+-- 'villagerVillagers' = 'traverse' . 'filtered' ('is' 'villagerVillager')+-- @+villagerVillagers :: Traversable t => Traversal' (t Player) Player+villagerVillagers = traverse . filtered (is villagerVillager)++-- | This 'Traversal' provides the traversal of 'wildChild' 'Player's.+--+-- @+-- 'wildChildren' = 'traverse' . 'filtered' ('is' 'wildChild')+-- @+wildChildren :: Traversable t => Traversal' (t Player) Player+wildChildren = traverse . filtered (is wildChild)++-- | This 'Traversal' provides the traversal of 'witch' 'Player's.+--+-- @+-- 'witches' = 'traverse' . 'filtered' ('is' 'witch')+-- @+witches :: Traversable t => Traversal' (t Player) Player+witches = traverse . filtered (is witch)++-- | This 'Traversal' provides the traversal of 'wolfHound' 'Player's.+--+-- @+-- 'wolfHounds' = 'traverse' . 'filtered' ('is' 'wolfHound')+-- @+wolfHounds :: Traversable t => Traversal' (t Player) Player+wolfHounds = traverse . filtered (is wolfHound)++-- | This 'Traversal' provides the traversal of 'villager' 'Player's.+--+-- @+-- 'villagers' = 'traverse' . 'filtered' ('is' 'villager')+-- @+villagers :: Traversable t => Traversal' (t Player) Player+villagers = traverse . filtered (is villager)++-- | This 'Traversal' provides the traversal of 'werewolf' 'Player's.+--+-- @+-- 'werewolves' = 'traverse' . 'filtered' ('is' 'werewolf')+-- @+werewolves :: Traversable t => Traversal' (t Player) Player+werewolves = traverse . filtered (is werewolf)++-- | This 'Traversal' provides the traversal of 'Alive' 'Player's.+--+-- @+-- 'alive' = 'filtered' ('has' $ 'state' . '_Alive')+-- @+alive :: Traversal' Player Player+alive = filtered (has $ state . _Alive)++-- | This 'Traversal' provides the traversal of 'Dead' 'Player's.+--+-- @+-- 'dead' = 'filtered' ('has' $ 'state' . '_Dead')+-- @+dead :: Traversal' Player Player+dead = filtered (has $ state . _Dead)

@@ -6,18 +6,397 @@ License     : BSD3 Maintainer  : public@hjwylde.com -Role instances are defined in "Game.Werewolf.Internal.Role". This module just re-exports the-functions relevant to the public interface.+Roles are split into four categories:++* The Ambiguous.+* The Loners.+* The Villagers.+* The Werewolves. -} +{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types        #-}+{-# LANGUAGE TemplateHaskell   #-}+ module Game.Werewolf.Role (     -- * Role-    Role, name, allegiance, balance, description, advice,+    Role,+    name, allegiance, balance, description, advice,      Allegiance(..),+    _Angel, _Villagers, _Werewolves,      -- ** 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,++    -- * Utility functions+    is, isn't, filteredBy, ) where -import Game.Werewolf.Internal.Role+import Control.Lens hiding (isn't)++import           Data.Function+import           Data.List+import           Data.Monoid+import           Data.Text     (Text)+import qualified Data.Text     as T++-- | 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++makePrisms ''Allegiance++-- | 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."+    }++-- | The counter-part to 'isn't', but more general as it takes a 'Getting' instead.+is :: Getting Any s a -> s -> Bool+is query = has query++-- | A re-write of 'Control.Lens.Prism.isn't' to be more general by taking a 'Getting' instead.+isn't :: Getting All s a -> s -> Bool+isn't query = hasn't query++-- | A companion to 'filtered' that, rather than using a predicate, filters on the given lens for+-- matches.+filteredBy :: Eq b => Lens' a b -> b -> Traversal' a a+filteredBy lens value = filtered ((value ==) . view lens)

@@ -0,0 +1,167 @@+{-|+Module      : Game.Werewolf.Util+Description : Utility functions for working in a ('MonadState' 'Game') environment.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Utility functions for woking in a ('MonadState' 'Game') environment.+-}++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types            #-}++module Game.Werewolf.Util (+    -- * Game++    -- ** Manipulations+    killPlayer, setPlayerAllegiance,++    -- ** Searches+    findPlayerBy_, getAdjacentAlivePlayers, getPassers, getPlayerVote,+    getAllowedVoters, getPendingVoters, getVoteResult,++    -- ** Queries+    isDefendersTurn, isGameOver, isScapegoatsTurn, isSeersTurn, isSunrise, isVillagesTurn,+    isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn,+    hasAnyoneWon, hasAngelWon, hasVillagersWon, hasWerewolvesWon,++    -- * Player++    -- ** Queries+    doesPlayerExist,+    isPlayerDefender, isPlayerScapegoat, isPlayerSeer, isPlayerVillageIdiot, isPlayerWildChild,+    isPlayerWitch, isPlayerWolfHound,+    isPlayerWerewolf,+    isPlayerAlive, isPlayerDead,+) where++import Control.Lens        hiding (cons)+import Control.Monad.Extra+import Control.Monad.State hiding (state)++import Data.List+import Data.Maybe+import Data.Text  (Text)++import           Game.Werewolf.Game   hiding (doesPlayerExist, getAllowedVoters, getPendingVoters,+                                       getVoteResult, hasAngelWon, hasAnyoneWon, hasVillagersWon,+                                       hasWerewolvesWon, killPlayer)+import qualified Game.Werewolf.Game   as Game+import           Game.Werewolf.Player+import           Game.Werewolf.Role   hiding (name)++import Prelude hiding (round)++killPlayer :: MonadState Game m => Text -> m ()+killPlayer name = modify $ Game.killPlayer name++-- | 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 :: MonadState Game m => Text -> Allegiance -> m ()+setPlayerAllegiance name' allegiance' = modify $ players . traverse . filteredBy name name' . role . allegiance .~ allegiance'++findPlayerBy_ :: (Eq a, MonadState Game m) => Lens' Player a -> a -> m Player+findPlayerBy_ lens value = fromJust <$> preuse (players . traverse . filteredBy lens value)++getAdjacentAlivePlayers :: MonadState Game m => Text -> m [Player]+getAdjacentAlivePlayers name' = do+    alivePlayers    <- toListOf (players . traverse . alive) <$> get+    let index       = fromJust $ elemIndex name' (alivePlayers ^.. names)++    return $ adjacentElements index alivePlayers+    where+        adjacentElements 0 list     = last list : take 2 list+        adjacentElements index list = take 3 $ drop (index - 1) (cycle list)++getPassers :: MonadState Game m => m [Player]+getPassers = mapM (findPlayerBy_ name) =<< use passes++getPlayerVote :: MonadState Game m => Text -> m (Maybe Text)+getPlayerVote playerName = use $ votes . at playerName++getAllowedVoters :: MonadState Game m => m [Player]+getAllowedVoters = gets Game.getAllowedVoters++getPendingVoters :: MonadState Game m => m [Player]+getPendingVoters = gets Game.getPendingVoters++getVoteResult :: MonadState Game m => m [Player]+getVoteResult = gets Game.getVoteResult++isDefendersTurn :: MonadState Game m => m Bool+isDefendersTurn = has (stage . _DefendersTurn) <$> get++isGameOver :: MonadState Game m => m Bool+isGameOver = has (stage . _GameOver) <$> get++isScapegoatsTurn :: MonadState Game m => m Bool+isScapegoatsTurn = has (stage . _ScapegoatsTurn) <$> get++isSeersTurn :: MonadState Game m => m Bool+isSeersTurn = has (stage . _SeersTurn) <$> get++isSunrise :: MonadState Game m => m Bool+isSunrise = has (stage . _Sunrise) <$> get++isVillagesTurn :: MonadState Game m => m Bool+isVillagesTurn = has (stage . _VillagesTurn) <$> get++isWerewolvesTurn :: MonadState Game m => m Bool+isWerewolvesTurn = has (stage . _WerewolvesTurn) <$> get++isWildChildsTurn :: MonadState Game m => m Bool+isWildChildsTurn = has (stage . _WildChildsTurn) <$> get++isWitchsTurn :: MonadState Game m => m Bool+isWitchsTurn = has (stage . _WitchsTurn) <$> get++isWolfHoundsTurn :: MonadState Game m => m Bool+isWolfHoundsTurn = has (stage . _WolfHoundsTurn) <$> get++hasAnyoneWon :: MonadState Game m => m Bool+hasAnyoneWon = gets Game.hasAnyoneWon++hasAngelWon :: MonadState Game m => m Bool+hasAngelWon = gets Game.hasAngelWon++hasVillagersWon :: MonadState Game m => m Bool+hasVillagersWon = gets Game.hasVillagersWon++hasWerewolvesWon :: MonadState Game m => m Bool+hasWerewolvesWon = gets Game.hasWerewolvesWon++doesPlayerExist :: MonadState Game m => Text -> m Bool+doesPlayerExist name = gets $ Game.doesPlayerExist name++isPlayerDefender :: MonadState Game m => Text -> m Bool+isPlayerDefender name' = is defender <$> findPlayerBy_ name name'++isPlayerScapegoat :: MonadState Game m => Text -> m Bool+isPlayerScapegoat name' = is scapegoat <$> findPlayerBy_ name name'++isPlayerSeer :: MonadState Game m => Text -> m Bool+isPlayerSeer name' = is seer <$> findPlayerBy_ name name'++isPlayerVillageIdiot :: MonadState Game m => Text -> m Bool+isPlayerVillageIdiot name' = is villageIdiot <$> findPlayerBy_ name name'++isPlayerWildChild :: MonadState Game m => Text -> m Bool+isPlayerWildChild name' = is wildChild <$> findPlayerBy_ name name'++isPlayerWitch :: MonadState Game m => Text -> m Bool+isPlayerWitch name' = is witch <$> findPlayerBy_ name name'++isPlayerWolfHound :: MonadState Game m => Text -> m Bool+isPlayerWolfHound name' = is wolfHound <$> findPlayerBy_ name name'++isPlayerWerewolf :: MonadState Game m => Text -> m Bool+isPlayerWerewolf name' = is werewolf <$> findPlayerBy_ name name'++isPlayerAlive :: MonadState Game m => Text -> m Bool+isPlayerAlive name' = is alive <$> findPlayerBy_ name name'++isPlayerDead :: MonadState Game m => Text -> m Bool+isPlayerDead name' = is dead <$> findPlayerBy_ name name'

@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-}- module Main (     -- * Main     main

@@ -5,7 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Game.Werewolf.Test.Arbitrary (@@ -17,12 +16,11 @@     GameAtSunrise(..), GameAtVillagesTurn(..), GameAtWerewolvesTurn(..), GameAtWildChildsTurn(..),     GameAtWitchsTurn(..), GameAtWolfHoundsTurn(..),     GameOnSecondRound(..),-    GameWithAllowedVoters(..), GameWithDeadPlayers(..), GameWithDevourEvent(..),-    GameWithDevourVotes(..), GameWithHeal(..), GameWithLynchVotes(..),+    GameWithAllegianceChosen(..), GameWithAllowedVoters(..), GameWithDeadPlayers(..),+    GameWithDevourEvent(..), GameWithDevourVotes(..), GameWithHeal(..), GameWithLynchVotes(..),     GameWithOneAllegianceAlive(..), GameWithPoison(..), GameWithProtect(..),     GameWithProtectAndDevourVotes(..), GameWithRoleModel(..), GameWithRoleModelAtVillagesTurn(..),     GameWithScapegoatBlamed(..), GameWithSee(..), GameWithVillageIdiotRevealedAtVillagesTurn(..),-    GameWithZeroAllegiancesAlive(..),      -- ** Player     arbitraryPlayerSet,@@ -40,7 +38,7 @@     arbitraryPlayer, arbitraryWerewolf, ) where -import Control.Lens hiding (elements)+import Control.Lens hiding (elements, isn't)  import           Data.List.Extra import           Data.Maybe@@ -48,10 +46,10 @@ import qualified Data.Text       as T  import Game.Werewolf.Command-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.Engine    (checkStage)+import Game.Werewolf.Game+import Game.Werewolf.Player+import Game.Werewolf.Role      hiding (name) import Game.Werewolf.Test.Util  import Prelude hiding (round)@@ -66,7 +64,7 @@         return $ game & stage .~ stage'  instance Arbitrary Stage where-    arbitrary = elements $ allStages \\ [GameOver, Sunrise, Sunset]+    arbitrary = elements . nub $ allStages \\ [GameOver, Sunrise, Sunset]  instance Arbitrary Player where     arbitrary = newPlayer <$> arbitrary <*> arbitrary@@ -188,6 +186,16 @@          return $ GameOnSecondRound (game & round .~ 1) +newtype GameWithAllegianceChosen = GameWithAllegianceChosen Game+    deriving (Eq, Show)++instance Arbitrary GameWithAllegianceChosen where+    arbitrary = do+        (GameAtWolfHoundsTurn game) <- arbitrary+        (Blind command)             <- arbitraryChooseAllegianceCommand game++        return $ GameWithAllegianceChosen (run_ (apply command) game)+ newtype GameWithAllowedVoters = GameWithAllowedVoters Game     deriving (Eq, Show) @@ -205,7 +213,7 @@     arbitrary = do         game                <- arbitrary         (NonEmpty players') <- NonEmpty <$> sublistOf (game ^. players)-        let game'           = foldr killPlayer game (map (view name) players')+        let game'           = foldr killPlayer game (players' ^.. names)          return $ GameWithDeadPlayers (run_ checkStage game') @@ -253,9 +261,9 @@ instance Arbitrary GameWithOneAllegianceAlive where     arbitrary = do         game            <- arbitrary-        allegiance'     <- arbitrary-        let players'    = filter ((allegiance' /=) . view (role . allegiance)) (game ^. players)-        let game'       = foldr killPlayer game (map (view name) players')+        allegiance'     <- elements [Villagers, Werewolves]+        let playerNames = game ^.. players . traverse . filteredBy (role . allegiance) allegiance' . name+        let game'       = foldr killPlayer game (game ^.. players . names \\ playerNames)          return $ GameWithOneAllegianceAlive game' @@ -297,21 +305,10 @@  instance Arbitrary GameWithProtectAndDevourVotes where     arbitrary = do-        (GameWithProtectAndWolfHoundChoice game)    <- arbitrary-        let game'                                   = run_ checkStage game--        GameWithProtectAndDevourVotes <$> runArbitraryCommands (length $ game' ^. players) game'--newtype GameWithProtectAndWolfHoundChoice = GameWithProtectAndWolfHoundChoice Game-    deriving (Eq, Show)--instance Arbitrary GameWithProtectAndWolfHoundChoice where-    arbitrary = do         (GameWithProtect game)  <- arbitrary         let game'               = run_ checkStage game-        (Blind command)         <- arbitraryChooseAllegianceCommand game' -        return $ GameWithProtectAndWolfHoundChoice (run_ (apply command) game')+        GameWithProtectAndDevourVotes <$> runArbitraryCommands (length $ game' ^. players) game'  newtype GameWithRoleModel = GameWithRoleModel Game     deriving (Eq, Show)@@ -338,7 +335,8 @@  instance Arbitrary GameWithScapegoatBlamed where     arbitrary = do-        (GameWithLynchVotes game) <- suchThat arbitrary $ \(GameWithLynchVotes game) -> length (getVoteResult game) > 1+        (GameWithLynchVotes game) <- suchThat arbitrary $ \(GameWithLynchVotes game) ->+            length (getVoteResult game) > 1          return $ GameWithScapegoatBlamed game @@ -358,9 +356,9 @@  instance Arbitrary GameWithVillageIdiotRevealed where     arbitrary = do-        game                <- arbitrary-        let villageIdiot    = findByRole_ villageIdiotRole (game ^. players)-        let game'           = game & villageIdiotRevealed .~ True & allowedVoters %~ delete (villageIdiot ^. name)+        game                    <- arbitrary+        let villageIdiotsName   = game ^?! players . villageIdiots . name+        let game'               = game & villageIdiotRevealed .~ True & allowedVoters %~ delete villageIdiotsName          return $ GameWithVillageIdiotRevealed game' @@ -373,27 +371,17 @@          return $ GameWithVillageIdiotRevealedAtVillagesTurn (game & stage .~ VillagesTurn) -newtype GameWithZeroAllegiancesAlive = GameWithZeroAllegiancesAlive Game-    deriving (Eq, Show)--instance Arbitrary GameWithZeroAllegiancesAlive where-    arbitrary = do-        game        <- arbitrary-        let game'   = foldr killPlayer game (map (view name) (game ^. players))--        return $ GameWithZeroAllegiancesAlive game'- arbitraryPlayerSet :: Gen [Player] arbitraryPlayerSet = do-    n <- choose (14, 24)+    n       <- choose (14, 24)     players <- nubOn (view name) <$> infiniteList -    let playersWithRestrictedRole = map (\role -> head $ filterByRole role players) restrictedRoles+    let playersWithRestrictedRole = map (\role' -> players ^?! traverse . filteredBy role role') restrictedRoles -    let simpleWerewolves    = take (n `quot` 6 + 1) $ filter isSimpleWerewolf players-    let simpleVillagers     = take (n - length restrictedRoles - length simpleWerewolves) $ filter isSimpleVillager players+    let simpleWerewolves'   = players ^.. taking (n `quot` 5 + 1) simpleWerewolves+    let simpleVillagers'    = players ^.. taking (n - length restrictedRoles - length simpleWerewolves') simpleVillagers -    return $ playersWithRestrictedRole ++ simpleVillagers ++ simpleWerewolves+    return $ playersWithRestrictedRole ++ simpleVillagers' ++ simpleWerewolves'  arbitraryCommand :: Game -> Gen (Blind Command) arbitraryCommand game = case game ^. stage of@@ -416,51 +404,51 @@  arbitraryChooseAllegianceCommand :: Game -> Gen (Blind Command) arbitraryChooseAllegianceCommand game = do-    let wolfHound   = findByRole_ wolfHoundRole (game ^. players)-    allegianceName  <- elements $ map (T.pack . show) [Villagers, Werewolves]+    let wolfHoundsName  = game ^?! players . wolfHounds . name+    allegianceName      <- elements $ map (T.pack . show) [Villagers, Werewolves] -    return . Blind $ chooseAllegianceCommand (wolfHound ^. name) allegianceName+    return . Blind $ chooseAllegianceCommand wolfHoundsName allegianceName  arbitraryChoosePlayerCommand :: Game -> Gen (Blind Command) arbitraryChoosePlayerCommand game = do-    let wildChild   = findByRole_ wildChildRole (game ^. players)+    let wildChild   = game ^?! players . wildChildren     target          <- suchThat (arbitraryPlayer game) (wildChild /=)      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)+    let scapegoatsName  = game ^?! players . scapegoats . name+    (NonEmpty players') <- NonEmpty <$> sublistOf (game ^.. players . traverse . alive) -    return . Blind $ choosePlayersCommand (scapegoat ^. name) (map (view name) players')+    return . Blind $ choosePlayersCommand scapegoatsName (players' ^.. names)  arbitraryHealCommand :: Game -> Gen (Blind Command) arbitraryHealCommand game = do-    let witch = findByRole_ witchRole (game ^. players)+    let witchsName = game ^?! players . witches . name -    return $ if game ^. healUsed-        then Blind noopCommand-        else seq (fromJust $ getDevourEvent game) (Blind $ healCommand (witch ^. name))+    return . Blind $ if game ^. healUsed+        then noopCommand+        else healCommand witchsName  arbitraryPassCommand :: Game -> Gen (Blind Command) arbitraryPassCommand game = do-    let witch = findByRole_ witchRole (game ^. players)+    let witchsName = game ^?! players . witches . name -    return . Blind $ passCommand (witch ^. name)+    return . Blind $ passCommand witchsName  arbitraryPoisonCommand :: Game -> Gen (Blind Command) arbitraryPoisonCommand game = do-    let witch   = findByRole_ witchRole (game ^. players)-    target      <- arbitraryPlayer game+    let witchsName  = game ^?! players . witches . name+    target          <- arbitraryPlayer game      return $ if isJust (game ^. poison)         then Blind noopCommand-        else Blind $ poisonCommand (witch ^. name) (target ^. name)+        else Blind $ poisonCommand witchsName (target ^. name)  arbitraryProtectCommand :: Game -> Gen (Blind Command) arbitraryProtectCommand game = do-    let defender    = findByRole_ defenderRole (game ^. players)+    let defender    = game ^?! players . defenders     -- TODO (hjw): add suchThat (/= priorProtect)     target          <- suchThat (arbitraryPlayer game) (defender /=) @@ -470,41 +458,41 @@  arbitraryQuitCommand :: Game -> Gen (Blind Command) arbitraryQuitCommand game = do-    let applicableCallers = filterAlive $ game ^. players+    let applicableCallerNames = game ^.. players . traverse . alive . name -    if null applicableCallers+    if null applicableCallerNames         then return $ Blind noopCommand-        else elements applicableCallers >>= \caller ->-            return . Blind $ quitCommand (caller ^. name)+        else elements applicableCallerNames >>= \callersName ->+            return . Blind $ quitCommand callersName  arbitrarySeeCommand :: Game -> Gen (Blind Command) arbitrarySeeCommand game = do-    let seer    = findByRole_ seerRole (game ^. players)-    target      <- arbitraryPlayer game+    let seersName   = game ^?! players . seers . name+    target          <- arbitraryPlayer game      return $ if isJust (game ^. see)         then Blind noopCommand-        else Blind $ seeCommand (seer ^. name) (target ^. name)+        else Blind $ seeCommand seersName (target ^. name)  arbitraryVoteDevourCommand :: Game -> Gen (Blind Command) arbitraryVoteDevourCommand game = do-    let applicableCallers   = filterWerewolves $ getPendingVoters game-    target                  <- suchThat (arbitraryPlayer game) $ not . isWerewolf+    let applicableCallerNames   = getPendingVoters game ^.. werewolves . name+    target                      <- suchThat (arbitraryPlayer game) $ isn't werewolf -    if null applicableCallers+    if null applicableCallerNames         then return $ Blind noopCommand-        else elements applicableCallers >>= \caller ->-            return . Blind $ voteDevourCommand (caller ^. name) (target ^. name)+        else elements applicableCallerNames >>= \callerName ->+            return . Blind $ voteDevourCommand callerName (target ^. name)  arbitraryVoteLynchCommand :: Game -> Gen (Blind Command) arbitraryVoteLynchCommand game = do-    let applicableCallers   = getAllowedVoters game `intersect` getPendingVoters game-    target                  <- arbitraryPlayer game+    let applicableCallerNames   = (game ^. allowedVoters) `intersect` (getPendingVoters game ^.. names)+    target                      <- arbitraryPlayer game -    if null applicableCallers+    if null applicableCallerNames         then return $ Blind noopCommand-        else elements applicableCallers >>= \caller ->-            return . Blind $ voteLynchCommand (caller ^. name) (target ^. name)+        else elements applicableCallerNames >>= \callerName ->+            return . Blind $ voteLynchCommand callerName (target ^. name)  runArbitraryCommands :: Int -> Game -> Gen Game runArbitraryCommands n = iterateM n $ \game -> do@@ -517,7 +505,7 @@ iterateM n f a = f a >>= iterateM (n - 1) f  arbitraryPlayer :: Game -> Gen Player-arbitraryPlayer = elements . filterAlive . view players+arbitraryPlayer game = elements $ game ^.. players . traverse . alive  arbitraryWerewolf :: Game -> Gen Player-arbitraryWerewolf = elements . filterAlive . filterWerewolves . view players+arbitraryWerewolf game = elements $ game ^.. players . werewolves . alive

@@ -5,7 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-} {-# LANGUAGE OverloadedStrings #-}  module Game.Werewolf.Test.Command (@@ -13,7 +12,7 @@     allCommandTests, ) where -import Control.Lens hiding (elements)+import Control.Lens hiding (elements, isn't)  import           Data.Either.Extra import qualified Data.Map          as Map@@ -22,10 +21,10 @@ import qualified Data.Text         as T  import Game.Werewolf.Command-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.Engine         (checkStage)+import Game.Werewolf.Game+import Game.Werewolf.Player+import Game.Werewolf.Role           hiding (name) import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util @@ -40,7 +39,7 @@     , testProperty "choose allegiance command errors when not wolf-hound's turn"        prop_chooseAllegianceCommandErrorsWhenNotWolfHoundsTurn     , testProperty "choose allegiance command errors when caller not wolf-hound"        prop_chooseAllegianceCommandErrorsWhenCallerNotWolfHound     , testProperty "choose allegiance command errors when allegiance does not exist"    prop_chooseAllegianceCommandErrorsWhenAllegianceDoesNotExist-    , testProperty "choose allegiance command sets caller's role"                       prop_chooseAllegianceCommandSetsCallersRole+    , testProperty "choose allegiance command sets allegiance chosen"                   prop_chooseAllegianceCommandSetsAllegianceChosen      , testProperty "choose player command errors when game is over"             prop_choosePlayerCommandErrorsWhenGameIsOver     , testProperty "choose player command errors when caller does not exist"    prop_choosePlayerCommandErrorsWhenCallerDoesNotExist@@ -102,20 +101,21 @@     , testProperty "protect command sets prior protect"                     prop_protectCommandSetsPriorProtect     , testProperty "protect command sets protect"                           prop_protectCommandSetsProtect -    , testProperty "quit command errors when game is over"                      prop_quitCommandErrorsWhenGameIsOver-    , testProperty "quit command errors when caller does not exist"             prop_quitCommandErrorsWhenCallerDoesNotExist-    , testProperty "quit command errors when caller is dead"                    prop_quitCommandErrorsWhenCallerIsDead-    , testProperty "quit command kills player"                                  prop_quitCommandKillsPlayer-    , testProperty "quit command clears heal when caller is witch"              prop_quitCommandClearsHealWhenCallerIsWitch-    , testProperty "quit command clears heal used when caller is witch"         prop_quitCommandClearsHealUsedWhenCallerIsWitch-    , testProperty "quit command clears poison when caller is witch"            prop_quitCommandClearsPoisonWhenCallerIsWitch-    , testProperty "quit command clears poison used when caller is witch"       prop_quitCommandClearsPoisonUsedWhenCallerIsWitch-    , testProperty "quit command clears prior protect when caller is defender"  prop_quitCommandClearsPriorProtectWhenCallerIsDefender-    , testProperty "quit command clears protect when caller is defender"        prop_quitCommandClearsProtectWhenCallerIsDefender-    , 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 errors when game is over"                              prop_quitCommandErrorsWhenGameIsOver+    , testProperty "quit command errors when caller does not exist"                     prop_quitCommandErrorsWhenCallerDoesNotExist+    , testProperty "quit command errors when caller is dead"                            prop_quitCommandErrorsWhenCallerIsDead+    , testProperty "quit command kills player"                                          prop_quitCommandKillsPlayer+    , testProperty "quit command clears allegiance chosen when caller is wolf-hound"    prop_quitCommandClearsAllegianceChosenWhenCallerIsWolfHound+    , testProperty "quit command clears heal when caller is witch"                      prop_quitCommandClearsHealWhenCallerIsWitch+    , testProperty "quit command clears heal used when caller is witch"                 prop_quitCommandClearsHealUsedWhenCallerIsWitch+    , testProperty "quit command clears poison when caller is witch"                    prop_quitCommandClearsPoisonWhenCallerIsWitch+    , testProperty "quit command clears poison used when caller is witch"               prop_quitCommandClearsPoisonUsedWhenCallerIsWitch+    , testProperty "quit command clears prior protect when caller is defender"          prop_quitCommandClearsPriorProtectWhenCallerIsDefender+    , testProperty "quit command clears protect when caller is defender"                prop_quitCommandClearsProtectWhenCallerIsDefender+    , 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 allegiance when caller is angel"          prop_quitCommandSetsAngelsAllegianceWhenCallerIsAngel      , testProperty "see command errors when game is over"           prop_seeCommandErrorsWhenGameIsOver     , testProperty "see command errors when caller does not exist"  prop_seeCommandErrorsWhenCallerDoesNotExist@@ -146,6 +146,7 @@     , 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     ] @@ -162,7 +163,7 @@  prop_chooseAllegianceCommandErrorsWhenCallerIsDead :: GameAtWolfHoundsTurn -> Allegiance -> Property prop_chooseAllegianceCommandErrorsWhenCallerIsDead (GameAtWolfHoundsTurn game) allegiance = do-    let wolfHound   = findByRole_ wolfHoundRole (game ^. players)+    let wolfHound   = game ^?! players . wolfHounds     let game'       = killPlayer (wolfHound ^. name) game     let command     = chooseAllegianceCommand (wolfHound ^. name) (T.pack $ show allegiance) @@ -170,38 +171,33 @@  prop_chooseAllegianceCommandErrorsWhenNotWolfHoundsTurn :: Game -> Property prop_chooseAllegianceCommandErrorsWhenNotWolfHoundsTurn game =-    not (isWolfHoundsTurn game)+    hasn't (stage . _WolfHoundsTurn) game     ==> forAll (arbitraryChooseAllegianceCommand game) $ verbose_runCommandErrors game . getBlind  prop_chooseAllegianceCommandErrorsWhenCallerNotWolfHound :: GameAtWolfHoundsTurn -> Allegiance -> Property prop_chooseAllegianceCommandErrorsWhenCallerNotWolfHound (GameAtWolfHoundsTurn game) allegiance =-    forAll (suchThat (arbitraryPlayer game) (not . isWolfHound)) $ \caller -> do+    forAll (suchThat (arbitraryPlayer game) (isn't wolfHound)) $ \caller -> do         let command = chooseAllegianceCommand (caller ^. name) (T.pack $ show allegiance)          verbose_runCommandErrors game command  prop_chooseAllegianceCommandErrorsWhenAllegianceDoesNotExist :: GameAtWolfHoundsTurn -> Text -> Property prop_chooseAllegianceCommandErrorsWhenAllegianceDoesNotExist (GameAtWolfHoundsTurn game) allegiance = do-    let wolfHound   = findByRole_ wolfHoundRole (game ^. players)+    let wolfHound   = game ^?! players . wolfHounds     let command     = chooseAllegianceCommand (wolfHound ^. name) allegiance      allegiance `notElem` ["Villagers", "Werewolves"]         ==> verbose_runCommandErrors game command -prop_chooseAllegianceCommandSetsCallersRole :: GameAtWolfHoundsTurn -> Property-prop_chooseAllegianceCommandSetsCallersRole (GameAtWolfHoundsTurn game) = do-    let wolfHound = findByRole_ wolfHoundRole (game ^. players)+prop_chooseAllegianceCommandSetsAllegianceChosen :: GameAtWolfHoundsTurn -> Property+prop_chooseAllegianceCommandSetsAllegianceChosen (GameAtWolfHoundsTurn game) = do+    let wolfHoundsName = game ^?! players . wolfHounds . name      forAll (elements [Villagers, Werewolves]) $ \allegiance' -> do-        let command = chooseAllegianceCommand (wolfHound ^. name) (T.pack $ show allegiance')+        let command = chooseAllegianceCommand wolfHoundsName (T.pack $ show allegiance')         let game'   = run_ (apply command) game -        findByName_ (wolfHound ^. name) (game' ^. players) ^. role === roleForAllegiance allegiance'-    where-        roleForAllegiance allegiance = case allegiance of-            Villagers   -> simpleVillagerRole-            Werewolves  -> simpleWerewolfRole-            _           -> undefined+        fromJust (game' ^. allegianceChosen) === allegiance'  prop_choosePlayerCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property prop_choosePlayerCommandErrorsWhenGameIsOver (GameAtGameOver game) =@@ -217,7 +213,7 @@  prop_choosePlayerCommandErrorsWhenTargetDoesNotExist :: GameAtWildChildsTurn -> Player -> Property prop_choosePlayerCommandErrorsWhenTargetDoesNotExist (GameAtWildChildsTurn game) target = do-    let wildChild   = findByRole_ wildChildRole (game ^. players)+    let wildChild   = game ^?! players . wildChildren     let command     = choosePlayerCommand (wildChild ^. name) (target ^. name)      not (doesPlayerExist (target ^. name) game)@@ -225,7 +221,7 @@  prop_choosePlayerCommandErrorsWhenCallerIsDead :: GameAtWildChildsTurn -> Property prop_choosePlayerCommandErrorsWhenCallerIsDead (GameAtWildChildsTurn game) = do-    let wildChild   = findByRole_ wildChildRole (game ^. players)+    let wildChild   = game ^?! players . wildChildren     let game'       = killPlayer (wildChild ^. name) game      forAll (arbitraryPlayer game') $ \target -> do@@ -235,7 +231,7 @@  prop_choosePlayerCommandErrorsWhenTargetIsDead :: GameAtWildChildsTurn -> Property prop_choosePlayerCommandErrorsWhenTargetIsDead (GameAtWildChildsTurn game) = do-    let wildChild = findByRole_ wildChildRole (game ^. players)+    let wildChild = game ^?! players . wildChildren      forAll (arbitraryPlayer game) $ \target -> do         let game'   = killPlayer (target ^. name) game@@ -245,19 +241,19 @@  prop_choosePlayerCommandErrorsWhenTargetIsCaller :: GameAtWildChildsTurn -> Property prop_choosePlayerCommandErrorsWhenTargetIsCaller (GameAtWildChildsTurn game) = do-    let wildChild   = findByRole_ wildChildRole (game ^. players)+    let wildChild   = game ^?! players . wildChildren     let command     = choosePlayerCommand (wildChild ^. name) (wildChild ^. name)      verbose_runCommandErrors game command  prop_choosePlayerCommandErrorsWhenNotWildChildsTurn :: Game -> Property prop_choosePlayerCommandErrorsWhenNotWildChildsTurn game =-    not (isWildChildsTurn game)+    hasn't (stage . _WildChildsTurn) game     ==> forAll (arbitraryChoosePlayerCommand game) $ verbose_runCommandErrors game . getBlind  prop_choosePlayerCommandErrorsWhenCallerNotWildChild :: GameAtWildChildsTurn -> Property prop_choosePlayerCommandErrorsWhenCallerNotWildChild (GameAtWildChildsTurn game) =-    forAll (suchThat (arbitraryPlayer game) (not . isWildChild)) $ \caller ->+    forAll (suchThat (arbitraryPlayer game) (isn't wildChild)) $ \caller ->     forAll (arbitraryPlayer game) $ \target -> do         let command = choosePlayerCommand (caller ^. name) (target ^. name) @@ -265,9 +261,9 @@  prop_choosePlayerCommandSetsRoleModel :: GameAtWildChildsTurn -> Property prop_choosePlayerCommandSetsRoleModel (GameAtWildChildsTurn game) = do-    let wildChild = findByRole_ wildChildRole (game ^. players)+    let wildChild = game ^?! players . wildChildren -    forAll (suchThat (arbitraryPlayer game) (not . isWildChild)) $ \target -> do+    forAll (suchThat (arbitraryPlayer game) (wildChild /=)) $ \target -> do         let command = choosePlayerCommand (wildChild ^. name) (target ^. name)         let game'   = run_ (apply command) game @@ -279,15 +275,15 @@  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)+    forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> do+        let command = choosePlayersCommand (caller ^. name) (targets ^.. names)          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 scapegoat   = game ^?! players . scapegoats     let command     = choosePlayersCommand (scapegoat ^. name) [target ^. name]      not (doesPlayerExist (target ^. name) game)@@ -295,37 +291,37 @@  prop_choosePlayersCommandErrorsWhenAnyTargetIsDead :: GameAtScapegoatsTurn -> Property prop_choosePlayersCommandErrorsWhenAnyTargetIsDead (GameAtScapegoatsTurn game) = do-    let scapegoat = findByRole_ scapegoatRole (game ^. players)+    let scapegoat = game ^?! players . scapegoats -    forAll (NonEmpty <$> sublistOf (filterAlive $ game ^. players)) $ \(NonEmpty targets) ->+    forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) ->         forAll (elements targets) $ \target -> do             let game'   = killPlayer (target ^. name) game-            let command = choosePlayersCommand (scapegoat ^. name) (map (view name) targets)+            let command = choosePlayersCommand (scapegoat ^. name) (targets ^.. names)              verbose_runCommandErrors game' command  prop_choosePlayersCommandErrorsWhenNotScapegoatsTurn :: Game -> Property prop_choosePlayersCommandErrorsWhenNotScapegoatsTurn game =-    not (isScapegoatsTurn game)+    hasn't (stage . _ScapegoatsTurn) 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)+    forAll (suchThat (arbitraryPlayer game) (isn't scapegoat)) $ \caller ->+    forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> do+        let command = choosePlayersCommand (caller ^. name) (targets ^.. names)          verbose_runCommandErrors game command  prop_choosePlayersCommandSetsAllowedVoters :: GameAtScapegoatsTurn -> Property prop_choosePlayersCommandSetsAllowedVoters (GameAtScapegoatsTurn game) = do-    let scapegoat = findByRole_ scapegoatRole (game ^. players)+    let scapegoat = game ^?! players . scapegoats -    forAll (NonEmpty <$> sublistOf (filterAlive $ game ^. players)) $ \(NonEmpty targets) -> do-        let command = choosePlayersCommand (scapegoat ^. name) (map (view name) targets)+    forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> do+        let command = choosePlayersCommand (scapegoat ^. name) (targets ^.. names)         let game'   = run_ (apply command) game -        game' ^. allowedVoters === map (view name) targets+        game' ^. allowedVoters === targets ^.. names  prop_choosePlayersCommandResetsScapegoatBlamed :: GameAtScapegoatsTurn -> Property prop_choosePlayersCommandResetsScapegoatBlamed (GameAtScapegoatsTurn game) = do@@ -334,7 +330,7 @@  prop_healCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property prop_healCommandErrorsWhenGameIsOver (GameAtGameOver game) = do-    let witch   = findByRole_ witchRole (game ^. players)+    let witch   = game ^?! players . witches     let command = healCommand $ witch ^. name      verbose_runCommandErrors game command@@ -354,28 +350,29 @@  prop_healCommandErrorsWhenNoTargetIsDevoured :: GameAtWitchsTurn -> Property prop_healCommandErrorsWhenNoTargetIsDevoured (GameAtWitchsTurn game) = do-    let witch   = findByRole_ witchRole (game ^. players)+    let witch   = game ^?! players . witches     let command = healCommand $ witch ^. name      verbose_runCommandErrors game command  prop_healCommandErrorsWhenNotWitchsTurn :: Game -> Property prop_healCommandErrorsWhenNotWitchsTurn game = do-    let witch   = findByRole_ witchRole (game ^. players)+    let witch   = game ^?! players . witches     let command = healCommand $ witch ^. name -    not (isWitchsTurn game) ==> verbose_runCommandErrors game command+    hasn't (stage . _WitchsTurn) game+        ==> verbose_runCommandErrors game command  prop_healCommandErrorsWhenCallerHasHealed :: GameWithHeal -> Property prop_healCommandErrorsWhenCallerHasHealed (GameWithHeal game) = do-    let witch   = findByRole_ witchRole (game ^. players)+    let witch   = game ^?! players . witches     let command = healCommand $ witch ^. name      verbose_runCommandErrors game command  prop_healCommandErrorsWhenCallerNotWitch :: GameWithDevourEvent -> Property prop_healCommandErrorsWhenCallerNotWitch (GameWithDevourEvent game) =-    forAll (suchThat (arbitraryPlayer game) (not . isWitch)) $ \caller -> do+    forAll (suchThat (arbitraryPlayer game) (isn't witch)) $ \caller -> do         let command = healCommand (caller ^. name)          verbose_runCommandErrors game command@@ -409,7 +406,7 @@  prop_passCommandErrorsWhenNotWitchsTurn :: Game -> Property prop_passCommandErrorsWhenNotWitchsTurn game =-    not (isWitchsTurn game)+    hasn't (stage . _WitchsTurn) game     ==> forAll (arbitraryPassCommand game) $ verbose_runCommandErrors game . getBlind  prop_passCommandUpdatesPasses :: GameAtWitchsTurn -> Property@@ -433,7 +430,7 @@  prop_poisonCommandErrorsWhenTargetDoesNotExist :: GameAtWitchsTurn -> Player -> Property prop_poisonCommandErrorsWhenTargetDoesNotExist (GameAtWitchsTurn game) target = do-    let witch   = findByRole_ witchRole (game ^. players)+    let witch   = game ^?! players . witches     let command = poisonCommand (witch ^. name) (target ^. name)      not (doesPlayerExist (target ^. name) game)@@ -441,7 +438,7 @@  prop_poisonCommandErrorsWhenCallerIsDead :: GameAtWitchsTurn -> Property prop_poisonCommandErrorsWhenCallerIsDead (GameAtWitchsTurn game) = do-    let witch = findByRole_ witchRole (game ^. players)+    let witch = game ^?! players . witches      forAll (arbitraryPlayer game) $ \target -> do         let game'   = killPlayer (witch ^. name) game@@ -451,7 +448,7 @@  prop_poisonCommandErrorsWhenTargetIsDead :: GameAtWitchsTurn -> Property prop_poisonCommandErrorsWhenTargetIsDead (GameAtWitchsTurn game) = do-    let witch = findByRole_ witchRole (game ^. players)+    let witch = game ^?! players . witches      forAll (arbitraryPlayer game) $ \target -> do         let game'   = killPlayer (target ^. name) game@@ -461,21 +458,20 @@  prop_poisonCommandErrorsWhenTargetIsDevoured :: GameWithDevourEvent -> Property prop_poisonCommandErrorsWhenTargetIsDevoured (GameWithDevourEvent game) = do-    let (DevourEvent targetName) = fromJust $ getDevourEvent game--    let witch   = findByRole_ witchRole (game ^. players)-    let command = poisonCommand (witch ^. name) targetName+    let witchsName  = game ^?! players . witches . name+    let targetName  = game ^?! events . traverse . _DevourEvent+    let command     = poisonCommand witchsName targetName      verbose_runCommandErrors game command  prop_poisonCommandErrorsWhenNotWitchsTurn :: Game -> Property prop_poisonCommandErrorsWhenNotWitchsTurn game =-    not (isWitchsTurn game)+    hasn't (stage . _WitchsTurn) game     ==> forAll (arbitraryPoisonCommand game) $ verbose_runCommandErrors game . getBlind  prop_poisonCommandErrorsWhenCallerHasPoisoned :: GameWithPoison -> Property prop_poisonCommandErrorsWhenCallerHasPoisoned (GameWithPoison game) = do-    let witch = findByRole_ witchRole (game ^. players)+    let witch = game ^?! players . witches      forAll (arbitraryPlayer game) $ \target -> do         let command = poisonCommand (witch ^. name) (target ^. name)@@ -484,7 +480,7 @@  prop_poisonCommandErrorsWhenCallerNotWitch :: GameAtWitchsTurn -> Property prop_poisonCommandErrorsWhenCallerNotWitch (GameAtWitchsTurn game) =-    forAll (suchThat (arbitraryPlayer game) (not . isWitch)) $ \caller ->+    forAll (suchThat (arbitraryPlayer game) (isn't witch)) $ \caller ->     forAll (arbitraryPlayer game) $ \target -> do         let command = poisonCommand (caller ^. name) (target ^. name) @@ -514,7 +510,7 @@  prop_protectCommandErrorsWhenTargetDoesNotExist :: GameAtDefendersTurn -> Player -> Property prop_protectCommandErrorsWhenTargetDoesNotExist (GameAtDefendersTurn game) target = do-    let defender    = findByRole_ defenderRole (game ^. players)+    let defender    = game ^?! players . defenders     let command     = protectCommand (defender ^. name) (target ^. name)      not (doesPlayerExist (target ^. name) game)@@ -522,7 +518,7 @@  prop_protectCommandErrorsWhenCallerIsDead :: GameAtDefendersTurn -> Property prop_protectCommandErrorsWhenCallerIsDead (GameAtDefendersTurn game) = do-    let defender    = findByRole_ defenderRole (game ^. players)+    let defender    = game ^?! players . defenders     let game'       = killPlayer (defender ^. name) game      forAll (arbitraryPlayer game') $ \target -> do@@ -532,7 +528,7 @@  prop_protectCommandErrorsWhenTargetIsDead :: GameAtDefendersTurn -> Property prop_protectCommandErrorsWhenTargetIsDead (GameAtDefendersTurn game) = do-    let defender = findByRole_ defenderRole (game ^. players)+    let defender = game ^?! players . defenders      forAll (arbitraryPlayer game) $ \target -> do         let game'   = killPlayer (target ^. name) game@@ -542,12 +538,12 @@  prop_protectCommandErrorsWhenNotDefendersTurn :: Game -> Property prop_protectCommandErrorsWhenNotDefendersTurn game =-    not (isDefendersTurn game)+    hasn't (stage . _DefendersTurn) game     ==> forAll (arbitraryProtectCommand game) $ verbose_runCommandErrors game . getBlind  prop_protectCommandErrorsWhenCallerNotDefender :: GameAtDefendersTurn -> Property prop_protectCommandErrorsWhenCallerNotDefender (GameAtDefendersTurn game) =-    forAll (suchThat (arbitraryPlayer game) (not . isDefender)) $ \caller ->+    forAll (suchThat (arbitraryPlayer game) (isn't defender)) $ \caller ->     forAll (arbitraryPlayer game) $ \target -> do         let command = protectCommand (caller ^. name) (target ^. name) @@ -557,7 +553,7 @@ prop_protectCommandErrorsWhenTargetIsPriorProtect (GameWithProtect game) = do     let game' = game & protect .~ Nothing -    let defender    = findByRole_ defenderRole (game' ^. players)+    let defender    = game ^?! players . defenders     let command     = protectCommand (defender ^. name) (fromJust $ game' ^. priorProtect)      verbose_runCommandErrors game' command@@ -591,50 +587,57 @@  prop_quitCommandKillsPlayer :: Game -> Property prop_quitCommandKillsPlayer game =-    not (isGameOver game)+    hasn't (stage . _GameOver) game     ==> forAll (arbitraryQuitCommand game) $ \(Blind command) -> do         let game' = run_ (apply command) game -        length (filterDead $ game' ^. players) == 1+        length (game' ^.. players . traverse . dead) == 1 +prop_quitCommandClearsAllegianceChosenWhenCallerIsWolfHound :: GameWithAllegianceChosen -> Bool+prop_quitCommandClearsAllegianceChosenWhenCallerIsWolfHound (GameWithAllegianceChosen game) = do+    let wolfHoundsName  = game ^?! players . wolfHounds . name+    let command         = quitCommand wolfHoundsName++    isNothing $ run_ (apply command) game ^. allegianceChosen+ prop_quitCommandClearsHealWhenCallerIsWitch :: GameWithHeal -> Bool prop_quitCommandClearsHealWhenCallerIsWitch (GameWithHeal game) = do-    let witch   = findByRole_ witchRole (game ^. players)+    let witch   = game ^?! players . witches     let command = quitCommand (witch ^. name)      not $ run_ (apply command) game ^. heal  prop_quitCommandClearsHealUsedWhenCallerIsWitch :: GameWithHeal -> Bool prop_quitCommandClearsHealUsedWhenCallerIsWitch (GameWithHeal game) = do-    let witch   = findByRole_ witchRole (game ^. players)+    let witch   = game ^?! players . witches     let command = quitCommand (witch ^. name)      not $ run_ (apply command) game ^. healUsed  prop_quitCommandClearsPoisonWhenCallerIsWitch :: GameWithPoison -> Bool prop_quitCommandClearsPoisonWhenCallerIsWitch (GameWithPoison game) = do-    let witch   = findByRole_ witchRole (game ^. players)+    let witch   = game ^?! players . witches     let command = quitCommand (witch ^. name)      isNothing $ run_ (apply command) game ^. poison  prop_quitCommandClearsPoisonUsedWhenCallerIsWitch :: GameWithPoison -> Bool prop_quitCommandClearsPoisonUsedWhenCallerIsWitch (GameWithPoison game) = do-    let witch   = findByRole_ witchRole (game ^. players)+    let witch   = game ^?! players . witches     let command = quitCommand (witch ^. name)      not $ run_ (apply command) game ^. poisonUsed  prop_quitCommandClearsPriorProtectWhenCallerIsDefender :: GameWithProtect -> Bool prop_quitCommandClearsPriorProtectWhenCallerIsDefender (GameWithProtect game) = do-    let defender    = findByRole_ defenderRole (game ^. players)+    let defender    = game ^?! players . defenders     let command     = quitCommand (defender ^. name)      isNothing $ run_ (apply command) game ^. priorProtect  prop_quitCommandClearsProtectWhenCallerIsDefender :: GameWithProtect -> Bool prop_quitCommandClearsProtectWhenCallerIsDefender (GameWithProtect game) = do-    let defender    = findByRole_ defenderRole (game ^. players)+    let defender    = game ^?! players . defenders     let command     = quitCommand (defender ^. name)      isNothing $ run_ (apply command) game ^. protect@@ -655,17 +658,18 @@  prop_quitCommandClearsRoleModelWhenCallerIsWildChild :: GameWithRoleModel -> Bool prop_quitCommandClearsRoleModelWhenCallerIsWildChild (GameWithRoleModel game) = do-    let wildChild   = findByRole_ wildChildRole (game ^. players)+    let wildChild   = game ^?! players . wildChildren     let command     = quitCommand (wildChild ^. name)      isNothing $ run_ (apply command) game ^. roleModel -prop_quitCommandSetsAngelsRoleWhenCallerIsAngel :: Game -> Bool-prop_quitCommandSetsAngelsRoleWhenCallerIsAngel game = do-    let angel   = findByRole_ angelRole (game ^. players)-    let command = quitCommand (angel ^. name)+prop_quitCommandSetsAngelsAllegianceWhenCallerIsAngel :: Game -> Bool+prop_quitCommandSetsAngelsAllegianceWhenCallerIsAngel game = do+    let angelsName  = game ^?! players . angels . name+    let command     = quitCommand angelsName+    let game'       = run_ (apply command) game -    isSimpleVillager $ findByName_ (angel ^. name) (run_ (apply command) game ^. players)+    is villager $ game' ^?! players . angels  prop_seeCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property prop_seeCommandErrorsWhenGameIsOver (GameAtGameOver game) =@@ -681,7 +685,7 @@  prop_seeCommandErrorsWhenTargetDoesNotExist :: GameAtSeersTurn -> Player -> Property prop_seeCommandErrorsWhenTargetDoesNotExist (GameAtSeersTurn game) target = do-    let seer    = findByRole_ seerRole (game ^. players)+    let seer    = game ^?! players . seers     let command = seeCommand (seer ^. name) (target ^. name)      not (doesPlayerExist (target ^. name) game)@@ -689,7 +693,7 @@  prop_seeCommandErrorsWhenCallerIsDead :: GameAtSeersTurn -> Property prop_seeCommandErrorsWhenCallerIsDead (GameAtSeersTurn game) = do-    let seer    = findByRole_ seerRole (game ^. players)+    let seer    = game ^?! players . seers     let game'   = killPlayer (seer ^. name) game      forAll (arbitraryPlayer game') $ \target -> do@@ -699,7 +703,7 @@  prop_seeCommandErrorsWhenTargetIsDead :: GameAtSeersTurn -> Property prop_seeCommandErrorsWhenTargetIsDead (GameAtSeersTurn game) = do-    let seer = findByRole_ seerRole (game ^. players)+    let seer = game ^?! players . seers      forAll (arbitraryPlayer game) $ \target -> do         let game'   = killPlayer (target ^. name) game@@ -709,12 +713,12 @@  prop_seeCommandErrorsWhenNotSeersTurn :: Game -> Property prop_seeCommandErrorsWhenNotSeersTurn game =-    not (isSeersTurn game)+    hasn't (stage . _SeersTurn) game     ==> forAll (arbitrarySeeCommand game) $ verbose_runCommandErrors game . getBlind  prop_seeCommandErrorsWhenCallerNotSeer :: GameAtSeersTurn -> Property prop_seeCommandErrorsWhenCallerNotSeer (GameAtSeersTurn game) =-    forAll (suchThat (arbitraryPlayer game) (not . isSeer)) $ \caller ->+    forAll (suchThat (arbitraryPlayer game) (isn't seer)) $ \caller ->     forAll (arbitraryPlayer game) $ \target -> do         let command = seeCommand (caller ^. name) (target ^. name) @@ -765,12 +769,12 @@  prop_voteDevourCommandErrorsWhenNotWerewolvesTurn :: Game -> Property prop_voteDevourCommandErrorsWhenNotWerewolvesTurn game =-    not (isWerewolvesTurn game)+    hasn't (stage . _WerewolvesTurn) game     ==> forAll (arbitraryVoteDevourCommand game) $ verbose_runCommandErrors game . getBlind  prop_voteDevourCommandErrorsWhenCallerNotWerewolf :: GameAtWerewolvesTurn -> Property prop_voteDevourCommandErrorsWhenCallerNotWerewolf (GameAtWerewolvesTurn game) =-    forAll (suchThat (arbitraryPlayer game) (not . isWerewolf)) $ \caller ->+    forAll (suchThat (arbitraryPlayer game) (isn't werewolf)) $ \caller ->     forAll (arbitraryPlayer game) $ \target -> do         let command = voteDevourCommand (caller ^. name) (target ^. name) @@ -779,7 +783,7 @@ prop_voteDevourCommandErrorsWhenCallerHasVoted :: GameWithDevourVotes -> Property prop_voteDevourCommandErrorsWhenCallerHasVoted (GameWithDevourVotes game) =     forAll (arbitraryWerewolf game) $ \caller ->-    forAll (suchThat (arbitraryPlayer game) (not . isWerewolf)) $ \target -> do+    forAll (suchThat (arbitraryPlayer game) (isn't werewolf)) $ \target -> do         let command = voteDevourCommand (caller ^. name) (target ^. name)          verbose_runCommandErrors game command@@ -837,7 +841,7 @@  prop_voteLynchCommandErrorsWhenNotVillagesTurn :: Game -> Property prop_voteLynchCommandErrorsWhenNotVillagesTurn game =-    not (isVillagesTurn game)+    hasn't (stage . _VillagesTurn) game     ==> forAll (arbitraryVoteLynchCommand game) $ verbose_runCommandErrors game . getBlind  prop_voteLynchCommandErrorsWhenCallerHasVoted :: GameWithLynchVotes -> Property@@ -865,7 +869,16 @@          verbose_runCommandErrors game command     where-        caller = findByRole_ villageIdiotRole (game ^. players)+        caller = game ^?! players . villageIdiots++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 = game ^?! players . villageIdiots  prop_voteLynchCommandUpdatesVotes :: GameAtVillagesTurn -> Property prop_voteLynchCommandUpdatesVotes (GameAtVillagesTurn game) =

@@ -5,7 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-} {-# LANGUAGE OverloadedStrings #-}  module Game.Werewolf.Test.Engine (@@ -13,7 +12,7 @@     allEngineTests, ) where -import Control.Lens         hiding (elements)+import Control.Lens         hiding (elements, isn't) import Control.Monad.Except import Control.Monad.Writer @@ -21,25 +20,18 @@ import           Data.List.Extra import qualified Data.Map          as Map import           Data.Maybe-import           Data.Text         (Text) -import           Game.Werewolf.Command-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+import Game.Werewolf.Command+import Game.Werewolf.Engine+import Game.Werewolf.Game+import Game.Werewolf.Player+import Game.Werewolf.Role           hiding (name)+import Game.Werewolf.Test.Arbitrary+import Game.Werewolf.Test.Util  import Prelude hiding (round)  import Test.QuickCheck-import Test.QuickCheck.Monadic import Test.Tasty import Test.Tasty.QuickCheck @@ -54,11 +46,11 @@     , testProperty "check stage skips wolf-hound's turn when no wolf-hound"     prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound     , testProperty "check stage does nothing when game over"                    prop_checkStageDoesNothingWhenGameOver -    , testProperty "check defender's turn advances to wolf-hound's turn"    prop_checkDefendersTurnAdvancesToWolfHoundsTurn+    , testProperty "check defender's turn advances to werewolves' turn"     prop_checkDefendersTurnAdvancesToWerewolvesTurn     , 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 advances to wolf-hound's turn"       prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn     , 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@@ -66,8 +58,8 @@     , testProperty "check seer's turn resets sees"                      prop_checkSeersTurnResetsSee     , testProperty "check seer's turn does nothing unless seen"         prop_checkSeersTurnDoesNothingUnlessSeen -    , testProperty "check sunrise increments round"     prop_checkSunriseIncrementsRound-    , testProperty "check sunrise sets angel's role"    prop_checkSunriseSetsAngelsRole+    , testProperty "check sunrise increments round"         prop_checkSunriseIncrementsRound+    , testProperty "check sunrise sets angel's allegiance"  prop_checkSunriseSetsAngelsAllegiance      , testProperty "check sunset sets wild-child's allegiance when role model dead" prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead @@ -103,116 +95,111 @@     , testProperty "check witch's turn resets poison"                           prop_checkWitchsTurnResetsPoison     , testProperty "check witch's turn clears passes"                           prop_checkWitchsTurnClearsPasses -    , testProperty "check wolf-hound's turn advances to werewolves' turn"   prop_checkWolfHoundsTurnAdvancesToWerewolvesTurn-    , testProperty "check wolf-hound's turn advances when no wolf-hound"    prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound-    , testProperty "check wolf-hound's turn does nothing unless chosen"     prop_checkWolfHoundsTurnDoesNothingUnlessChosen+    , testProperty "check wolf-hound's turn advances to seer's turn"                prop_checkWolfHoundsTurnAdvancesToSeersTurn+    , testProperty "check wolf-hound's turn advances when no wolf-hound"            prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound+    , testProperty "check wolf-hound's turn sets wolf-hound's allegiance"           prop_checkWolfHoundsTurnSetsWolfHoundsAllegiance+    , testProperty "check wolf-hound's turn does nothing unless allegiance chosen"  prop_checkWolfHoundsTurnDoesNothingUnlessAllegianceChosen -    , testProperty "check game over advances stage when zero allegiances alive" prop_checkGameOverAdvancesStageWhenZeroAllegiancesAlive-    , testProperty "check game over advances stage when one allegiance alive" prop_checkGameOverAdvancesStageWhenOneAllegianceAlive+    , testProperty "check game over advances stage when one allegiance alive"                   prop_checkGameOverAdvancesStageWhenOneAllegianceAlive     -- TODO (hjw): pending     --, 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 "check game over advances stage when after first round and angel dead"       prop_checkGameOverAdvancesStageWhenAfterFirstRoundAndAngelDead+    , testProperty "check game over does nothing when angel dead but aligned with villagers"    prop_checkGameOverDoesNothingWhenAngelDeadButAlignedWithVillagers      , 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 "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 prop_checkStageSkipsDefendersTurnWhenNoDefender (GameWithRoleModel game) =-    isWolfHoundsTurn $ run_ checkStage game'+    hasn't (stage . _DefendersTurn) game'     where-        defendersName   = findByRole_ defenderRole (game ^. players) ^. name-        game'           = killPlayer defendersName game+        defendersName   = game ^?! players . defenders . name+        game'           = run_ (apply (quitCommand defendersName) >> checkStage) game -prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat :: GameAtScapegoatsTurn -> Bool-prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat (GameAtScapegoatsTurn game) =-    isScapegoatsTurn $ run_ checkStage game+prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat :: GameWithLynchVotes -> Bool+prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat (GameWithLynchVotes game) =+    hasn't (stage . _ScapegoatsTurn) game'+    where+        scapegoatsName  = game ^?! players . scapegoats . name+        game'           = run_ (apply (quitCommand scapegoatsName) >> checkStage) game -prop_checkStageSkipsSeersTurnWhenNoSeer :: GameWithLynchVotes -> Property+prop_checkStageSkipsSeersTurnWhenNoSeer :: GameWithLynchVotes -> Bool prop_checkStageSkipsSeersTurnWhenNoSeer (GameWithLynchVotes game) =-    isAlive (findByRole_ angelRole $ run_ checkStage game' ^. players)-    ==> isScapegoatsTurn game' || isWildChildsTurn game' || isDefendersTurn game'+    hasn't (stage . _SeersTurn) game'     where-        seersName   = findByRole_ seerRole (game ^. players) ^. name+        seersName   = game ^?! players . seers . 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'+        hasn't (stage . _VillagesTurn) (run_ (apply passCommand >> checkStage) game')     where         game' = game & allowedVoters .~ []  prop_checkStageSkipsWildChildsTurnWhenNoWildChild :: GameWithSee -> Bool prop_checkStageSkipsWildChildsTurnWhenNoWildChild (GameWithSee game) =-    isDefendersTurn $ run_ checkStage game'+    hasn't (stage . _WildChildsTurn) game'     where-        wildChildsName  = findByRole_ wildChildRole (game ^. players) ^. name-        game'           = killPlayer wildChildsName game+        wildChildsName  = game ^?! players . wildChildren . name+        game'           = run_ (apply (quitCommand wildChildsName) >> checkStage) game  prop_checkStageSkipsWitchsTurnWhenNoWitch :: GameWithDevourVotes -> Property prop_checkStageSkipsWitchsTurnWhenNoWitch (GameWithDevourVotes game) =-    isNothing (findByRole angelRole $ run_ checkStage game' ^. players)-    ==> isVillagesTurn $ run_ checkStage game'+    null (run_ checkStage game' ^.. players . angels . dead)+    ==> hasn't (stage . _WitchsTurn) game'     where-        witchsName  = findByRole_ witchRole (game ^. players) ^. name-        game'       = killPlayer witchsName game+        witchsName  = game ^?! players . witches . name+        game'       = run_ (apply (quitCommand witchsName) >> checkStage) game  prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound :: GameWithProtect -> Bool prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound (GameWithProtect game) =-    isWerewolvesTurn $ run_ checkStage game'+    hasn't (stage . _WolfHoundsTurn) game'     where-        wolfHoundsName  = findByRole_ wolfHoundRole (game ^. players) ^. name-        game'           = killPlayer wolfHoundsName game+        wolfHoundsName  = game ^?! players . wolfHounds . name+        game'           = run_ (apply (quitCommand wolfHoundsName) >> checkStage) game  prop_checkStageDoesNothingWhenGameOver :: GameAtGameOver -> Property prop_checkStageDoesNothingWhenGameOver (GameAtGameOver game) =     run_ checkStage game === game -prop_checkDefendersTurnAdvancesToWolfHoundsTurn :: GameWithProtect -> Bool-prop_checkDefendersTurnAdvancesToWolfHoundsTurn (GameWithProtect game) =-    isWolfHoundsTurn $ run_ checkStage game+prop_checkDefendersTurnAdvancesToWerewolvesTurn :: GameWithProtect -> Bool+prop_checkDefendersTurnAdvancesToWerewolvesTurn (GameWithProtect game) =+    has (stage . _WerewolvesTurn) (run_ checkStage game)  prop_checkDefendersTurnAdvancesWhenNoDefender :: GameAtDefendersTurn -> Bool prop_checkDefendersTurnAdvancesWhenNoDefender (GameAtDefendersTurn game) = do-    let defender    = findByRole_ defenderRole (game ^. players)+    let defender    = game ^?! players . defenders     let command     = quitCommand $ defender ^. name -    not . isDefendersTurn $ run_ (apply command >> checkStage) game+    hasn't (stage . _DefendersTurn) (run_ (apply command >> checkStage) game)  prop_checkDefendersTurnDoesNothingUnlessProtected :: GameAtDefendersTurn -> Bool prop_checkDefendersTurnDoesNothingUnlessProtected (GameAtDefendersTurn game) =-    isDefendersTurn $ run_ checkStage game+    has (stage . _DefendersTurn) (run_ checkStage game) -prop_checkScapegoatsTurnAdvancesToSeersTurn :: GameWithAllowedVoters -> Bool-prop_checkScapegoatsTurnAdvancesToSeersTurn (GameWithAllowedVoters game) =-    isSeersTurn $ run_ checkStage game+prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn :: GameWithAllowedVoters -> Bool+prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn (GameWithAllowedVoters game) =+    has (stage . _WolfHoundsTurn) (run_ checkStage game)  prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed :: GameAtScapegoatsTurn -> Bool prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed (GameAtScapegoatsTurn game) =-    isScapegoatsTurn $ run_ checkStage game+    has (stage . _ScapegoatsTurn) (run_ checkStage game)  prop_checkSeersTurnAdvancesToWildChildsTurn :: GameWithSee -> Bool prop_checkSeersTurnAdvancesToWildChildsTurn (GameWithSee game) =-    isWildChildsTurn $ run_ checkStage game+    has (stage . _WildChildsTurn) (run_ checkStage game)  prop_checkSeersTurnAdvancesWhenNoSeer :: GameAtSeersTurn -> Bool prop_checkSeersTurnAdvancesWhenNoSeer (GameAtSeersTurn game) = do-    let seer    = findByRole_ seerRole (game ^. players)+    let seer    = game ^?! players . seers     let command = quitCommand $ seer ^. name -    not . isSeersTurn $ run_ (apply command >> checkStage) game+    hasn't (stage . _SeersTurn) (run_ (apply command >> checkStage) game)  prop_checkSeersTurnResetsSee :: GameWithSee -> Bool prop_checkSeersTurnResetsSee (GameWithSee game) =@@ -220,37 +207,36 @@  prop_checkSeersTurnDoesNothingUnlessSeen :: GameAtSeersTurn -> Bool prop_checkSeersTurnDoesNothingUnlessSeen (GameAtSeersTurn game) =-    isSeersTurn $ run_ checkStage game+    has (stage . _SeersTurn) (run_ checkStage game)  prop_checkSunriseIncrementsRound :: GameAtSunrise -> Property prop_checkSunriseIncrementsRound (GameAtSunrise game) =     run_ checkStage game ^. round === game ^. round + 1 -prop_checkSunriseSetsAngelsRole :: GameAtSunrise -> Bool-prop_checkSunriseSetsAngelsRole (GameAtSunrise game) = do-    let angel = findByRole_ angelRole (game ^. players)+prop_checkSunriseSetsAngelsAllegiance :: GameAtSunrise -> Bool+prop_checkSunriseSetsAngelsAllegiance (GameAtSunrise game) = do     let game' = run_ checkStage game -    isSimpleVillager $ findByName_ (angel ^. name) (game' ^. players)+    is villager $ game' ^?! players . angels  prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead :: GameWithRoleModelAtVillagesTurn -> Property prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead (GameWithRoleModelAtVillagesTurn game) = do     let game' = foldr (\player -> run_ (apply $ voteLynchCommand (player ^. name) (roleModel' ^. name))) game (game ^. players) -    not (isAngel roleModel' || isVillageIdiot roleModel')-        ==> isWerewolf $ findByRole_ wildChildRole (run_ checkStage game' ^. players)+    isn't angel roleModel' && isn't villageIdiot roleModel'+        ==> is werewolf $ run_ checkStage game' ^?! players . wildChildren     where-        roleModel' = findByName_ (fromJust $ game ^. roleModel) (game ^. players)+        roleModel' = game ^?! players . traverse . filteredBy name (fromJust $ game ^. roleModel)  prop_checkVillagesTurnAdvancesToScapegoatsTurn :: GameWithScapegoatBlamed -> Bool prop_checkVillagesTurnAdvancesToScapegoatsTurn (GameWithScapegoatBlamed game) =-    isScapegoatsTurn $ run_ checkStage game+    has (stage . _ScapegoatsTurn) (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+    && isn't villageIdiot target+    ==> length (run_ checkStage game ^.. players . traverse . dead) == 1     where         target = head $ getVoteResult game @@ -258,24 +244,24 @@ 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+    none (is dead) (run_ checkStage game' ^. players)     where-        villageIdiot = findByRole_ villageIdiotRole (game ^. players)+        villageIdiot = game ^?! players . villageIdiots  -- TODO (hjw): tidy this test prop_checkVillagesTurnLynchesNoOneWhenConflictedAndNoScapegoats :: Game -> Property prop_checkVillagesTurnLynchesNoOneWhenConflictedAndNoScapegoats game =     forAll (runArbitraryCommands n game') $ \game'' ->     length (getVoteResult game'') > 1-    ==> length (filterDead $ run_ checkStage game'' ^. players) == length (filterDead $ game' ^. players)+    ==> run_ checkStage game'' ^. players == game' ^. players     where-        scapegoatsName  = findByRole_ scapegoatRole (game ^. players) ^. name+        scapegoatsName  = game ^?! players . scapegoats . name         game'           = killPlayer scapegoatsName game & stage .~ VillagesTurn         n               = length $ game' ^. players  prop_checkVillagesTurnLynchesScapegoatWhenConflicted :: GameAtScapegoatsTurn -> Bool prop_checkVillagesTurnLynchesScapegoatWhenConflicted (GameAtScapegoatsTurn game) =-    isDead . findByRole_ scapegoatRole $ run_ checkStage game ^. players+    is dead $ run_ checkStage game ^?! players . scapegoats  prop_checkVillagesTurnResetsVotes :: GameWithLynchVotes -> Bool prop_checkVillagesTurnResetsVotes (GameWithLynchVotes game) =@@ -283,45 +269,45 @@  prop_checkVillagesTurnSetsAllowedVoters :: GameWithLynchVotes -> Property prop_checkVillagesTurnSetsAllowedVoters (GameWithLynchVotes game) =-    game' ^. allowedVoters === map (view name) expectedAllowedVoters+    game' ^. allowedVoters === expectedAllowedVoters ^.. names     where         game' = run_ checkStage game         expectedAllowedVoters-            | game' ^. villageIdiotRevealed = filter (not . isVillageIdiot) $ game' ^. players-            | otherwise                     = filterAlive $ game' ^. players+            | game' ^. villageIdiotRevealed = filter (isn't villageIdiot) $ game' ^. players+            | otherwise                     = game' ^.. players . traverse . alive  prop_checkVillagesTurnDoesNothingUnlessAllVoted :: GameAtVillagesTurn -> Property prop_checkVillagesTurnDoesNothingUnlessAllVoted (GameAtVillagesTurn game) =     forAll (runArbitraryCommands n game) $ \game' ->-    isVillagesTurn $ run_ checkStage game'+    has (stage . _VillagesTurn) (run_ checkStage game')     where         n = length (game ^. players) - 1  prop_checkWerewolvesTurnAdvancesToWitchsTurn :: GameWithDevourVotes -> Property prop_checkWerewolvesTurnAdvancesToWitchsTurn (GameWithDevourVotes game) =     length (getVoteResult game) == 1-    ==> isWitchsTurn $ run_ checkStage game+    ==> has (stage . _WitchsTurn) (run_ checkStage game)  prop_checkWerewolvesTurnSkipsWitchsTurnWhenHealedAndPoisoned :: GameWithDevourVotes -> Bool prop_checkWerewolvesTurnSkipsWitchsTurnWhenHealedAndPoisoned (GameWithDevourVotes game) =-    not . isWitchsTurn $ run_ checkStage game'+    hasn't (stage . _WitchsTurn) (run_ checkStage game')     where         game' = game & healUsed .~ True & poisonUsed .~ True  prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus :: GameWithDevourVotes -> Property prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus (GameWithDevourVotes game) =     length (getVoteResult game) == 1-    ==> isJust . getDevourEvent $ run_ checkStage game+    ==> has (events . traverse . _DevourEvent) (run_ checkStage game)  prop_checkWerewolvesTurnKillsNoOneWhenConflicted :: GameWithDevourVotes -> Property prop_checkWerewolvesTurnKillsNoOneWhenConflicted (GameWithDevourVotes game) =     length (getVoteResult game) > 1-    ==> isNothing . getDevourEvent $ run_ checkStage game+    ==> hasn't (events . traverse . _DevourEvent) (run_ checkStage game)  prop_checkWerewolvesTurnKillsNoOneWhenTargetDefended :: GameWithProtectAndDevourVotes -> Property prop_checkWerewolvesTurnKillsNoOneWhenTargetDefended (GameWithProtectAndDevourVotes game) =     length (getVoteResult game) == 1-    ==> isNothing . getDevourEvent $ run_ checkStage game'+    ==> hasn't (events . traverse . _DevourEvent) (run_ checkStage game')     where         target  = head $ getVoteResult game         game'   = game & protect .~ Just (target ^. name)@@ -337,56 +323,56 @@ prop_checkWerewolvesTurnDoesNothingUnlessAllVoted :: GameAtWerewolvesTurn -> Property prop_checkWerewolvesTurnDoesNothingUnlessAllVoted (GameAtWerewolvesTurn game) =     forAll (runArbitraryCommands n game) $ \game' ->-    isWerewolvesTurn $ run_ checkStage game'+    has (stage . _WerewolvesTurn) (run_ checkStage game')     where-        n = length (filterWerewolves $ game ^. players) - 1+        n = length (game ^.. players . werewolves) - 1  prop_checkWildChildsTurnAdvancesToDefendersTurn :: GameAtWildChildsTurn -> Property prop_checkWildChildsTurnAdvancesToDefendersTurn (GameAtWildChildsTurn game) =     forAll (arbitraryChoosePlayerCommand game) $ \(Blind command) ->-    isDefendersTurn $ run_ (apply command >> checkStage) game+    has (stage . _DefendersTurn) (run_ (apply command >> checkStage) game)  prop_checkWildChildsTurnAdvancesWhenNoWildChild :: GameAtWildChildsTurn -> Bool prop_checkWildChildsTurnAdvancesWhenNoWildChild (GameAtWildChildsTurn game) = do-    let wildChild   = findByRole_ wildChildRole (game ^. players)+    let wildChild   = game ^?! players . wildChildren     let command     = quitCommand $ wildChild ^. name -    not . isWildChildsTurn $ run_ (apply command >> checkStage) game+    hasn't (stage . _WildChildsTurn) (run_ (apply command >> checkStage) game)  prop_checkWildChildsTurnDoesNothingUnlessRoleModelChosen :: GameAtWildChildsTurn -> Bool prop_checkWildChildsTurnDoesNothingUnlessRoleModelChosen (GameAtWildChildsTurn game) =-    isWildChildsTurn $ run_ checkStage game+    has (stage . _WildChildsTurn) (run_ checkStage game)  prop_checkWitchsTurnAdvancesToVillagesTurn :: GameAtWitchsTurn -> Property prop_checkWitchsTurnAdvancesToVillagesTurn (GameAtWitchsTurn game) =     forAll (arbitraryPassCommand game) $ \(Blind command) ->-    isVillagesTurn $ run_ (apply command >> checkStage) game+    has (stage . _VillagesTurn) (run_ (apply command >> checkStage) game)  prop_checkWitchsTurnAdvancesWhenNoWitch :: GameAtWitchsTurn -> Bool prop_checkWitchsTurnAdvancesWhenNoWitch (GameAtWitchsTurn game) = do-    let witch   = findByRole_ witchRole (game ^. players)+    let witch   = game ^?! players . witches     let command = quitCommand $ witch ^. name -    not . isWitchsTurn $ run_ (apply command >> checkStage) game+    hasn't (stage . _WitchsTurn) (run_ (apply command >> checkStage) game)  prop_checkWitchsTurnHealsDevoureeWhenHealed :: GameWithHeal -> Property prop_checkWitchsTurnHealsDevoureeWhenHealed (GameWithHeal game) =     forAll (arbitraryPassCommand game) $ \(Blind command) ->-    null . filterDead $ run_ (apply command >> checkStage) game ^. players+    none (is dead) (run_ (apply command >> checkStage) game ^. players)  prop_checkWitchsTurnKillsOnePlayerWhenPoisoned :: GameWithPoison -> Property prop_checkWitchsTurnKillsOnePlayerWhenPoisoned (GameWithPoison game) =     forAll (arbitraryPassCommand game) $ \(Blind command) ->-    length (filterDead $ run_ (apply command >> checkStage) game ^. players) == 1+    length (run_ (apply command >> checkStage) game ^.. players . traverse . dead) == 1  prop_checkWitchsTurnDoesNothingWhenPassed :: GameAtWitchsTurn -> Property prop_checkWitchsTurnDoesNothingWhenPassed (GameAtWitchsTurn game) =     forAll (arbitraryPassCommand game) $ \(Blind command) ->-    null . filterDead $ run_ (apply command >> checkStage) game ^. players+    none (is dead) $ run_ (apply command >> checkStage) game ^. players  prop_checkWitchsTurnDoesNothingUnlessActionedOrPassed :: GameAtWitchsTurn -> Bool prop_checkWitchsTurnDoesNothingUnlessActionedOrPassed (GameAtWitchsTurn game) =-    isWitchsTurn $ run_ checkStage game+    has (stage . _WitchsTurn) (run_ checkStage game)  prop_checkWitchsTurnResetsHeal :: GameWithHeal -> Property prop_checkWitchsTurnResetsHeal (GameWithHeal game) =@@ -403,46 +389,55 @@     forAll (arbitraryPassCommand game) $ \(Blind command) ->     null $ run_ (apply command >> checkStage) game ^. passes -prop_checkWolfHoundsTurnAdvancesToWerewolvesTurn :: GameAtWolfHoundsTurn -> Property-prop_checkWolfHoundsTurnAdvancesToWerewolvesTurn (GameAtWolfHoundsTurn game) =+prop_checkWolfHoundsTurnAdvancesToSeersTurn :: GameAtWolfHoundsTurn -> Property+prop_checkWolfHoundsTurnAdvancesToSeersTurn (GameAtWolfHoundsTurn game) =     forAll (arbitraryChooseAllegianceCommand game) $ \(Blind command) ->-    isWerewolvesTurn $ run_ (apply command >> checkStage) game+    has (stage . _SeersTurn) (run_ (apply command >> checkStage) game)  prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound :: GameAtWolfHoundsTurn -> Bool prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound (GameAtWolfHoundsTurn game) = do-    let wolfHound   = findByRole_ wolfHoundRole (game ^. players)+    let wolfHound   = game ^?! players . wolfHounds     let command     = quitCommand $ wolfHound ^. name -    not . isWolfHoundsTurn $ run_ (apply command >> checkStage) game+    hasn't (stage . _WolfHoundsTurn) (run_ (apply command >> checkStage) game) -prop_checkWolfHoundsTurnDoesNothingUnlessChosen :: GameAtWolfHoundsTurn -> Bool-prop_checkWolfHoundsTurnDoesNothingUnlessChosen (GameAtWolfHoundsTurn game) =-    isWolfHoundsTurn $ run_ checkStage game+prop_checkWolfHoundsTurnSetsWolfHoundsAllegiance :: GameWithAllegianceChosen -> Property+prop_checkWolfHoundsTurnSetsWolfHoundsAllegiance (GameWithAllegianceChosen game) =+    game' ^?! players . wolfHounds . role . allegiance === fromJust (game' ^. allegianceChosen)+    where+        game' = run_ checkStage game -prop_checkGameOverAdvancesStageWhenZeroAllegiancesAlive :: GameWithZeroAllegiancesAlive -> Bool-prop_checkGameOverAdvancesStageWhenZeroAllegiancesAlive (GameWithZeroAllegiancesAlive game) =-    isGameOver $ run_ checkGameOver game+prop_checkWolfHoundsTurnDoesNothingUnlessAllegianceChosen :: GameAtWolfHoundsTurn -> Bool+prop_checkWolfHoundsTurnDoesNothingUnlessAllegianceChosen (GameAtWolfHoundsTurn game) =+    has (stage . _WolfHoundsTurn) (run_ checkStage game)  prop_checkGameOverAdvancesStageWhenOneAllegianceAlive :: GameWithOneAllegianceAlive -> Property prop_checkGameOverAdvancesStageWhenOneAllegianceAlive (GameWithOneAllegianceAlive game) =-    forAll (sublistOf . filterAlive $ game ^. players) $ \players' -> do-        let game' = foldr killPlayer game (map (view name) players')+    forAll (sublistOf $ game ^.. players . traverse . alive) $ \players' -> do+        let game' = foldr killPlayer game (players' ^.. names) -        isGameOver $ run_ checkGameOver game'+        has (stage . _GameOver) $ run_ checkGameOver game'  -- TODO (hjw): pending --prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive :: GameWithDeadPlayers -> Property --prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive (GameWithDeadPlayers game) = --    length (nub . map (view $ role . allegiance) . filterAlive $ game ^. players) > 1---    ==> not . isGameOver $ run_ checkGameOver game+--    ==> not . is gameOver $ run_ checkGameOver game -prop_checkGameOverAdvancesStageWhenSecondRoundAndAngelDead :: GameOnSecondRound -> Bool-prop_checkGameOverAdvancesStageWhenSecondRoundAndAngelDead (GameOnSecondRound game) = do-    let angel = findByRole_ angelRole (game ^. players)-    let game' = killPlayer (angel ^. name) game+prop_checkGameOverAdvancesStageWhenAfterFirstRoundAndAngelDead :: GameOnSecondRound -> Bool+prop_checkGameOverAdvancesStageWhenAfterFirstRoundAndAngelDead (GameOnSecondRound game) = do+    let angelsName  = game ^?! players . angels . name+    let game'       = killPlayer angelsName game -    isGameOver $ run_ checkGameOver game'+    has (stage . _GameOver) $ run_ checkGameOver game' +prop_checkGameOverDoesNothingWhenAngelDeadButAlignedWithVillagers :: GameOnSecondRound -> Bool+prop_checkGameOverDoesNothingWhenAngelDeadButAlignedWithVillagers (GameOnSecondRound game) = do+    let angelsName  = game ^?! players . angels . name+    let game'       = killPlayer angelsName game & players . traverse . filteredBy name angelsName . role . allegiance .~ Villagers++    hasn't (stage . _GameOver) $ run_ checkGameOver game'+ prop_startGameUsesGivenPlayers :: Property prop_startGameUsesGivenPlayers =     forAll arbitraryPlayerSet $ \players' ->@@ -468,44 +463,5 @@  prop_startGameErrorsWhenMoreThan1OfARestrictedRole :: [Player] -> Property prop_startGameErrorsWhenMoreThan1OfARestrictedRole players =-    any (\role -> length (filterByRole role players) > 1) restrictedRoles+    any (\role' -> length (players ^.. traverse . filteredBy role role') > 1) restrictedRoles     ==> isLeft . runExcept . runWriterT $ startGame "" players--prop_createPlayersUsesGivenPlayerNames :: [Text] -> [Role] -> Property-prop_createPlayersUsesGivenPlayerNames playerNames extraRoles = monadicIO $ do-    players <- createPlayers playerNames (padRoles extraRoles (length playerNames))--    return $ playerNames == map (view name) players--prop_createPlayersUsesGivenRoles :: [Text] -> [Role] -> Property-prop_createPlayersUsesGivenRoles playerNames extraRoles = monadicIO $ do-    let roles = padRoles extraRoles (length playerNames)--    players <- createPlayers playerNames roles--    return $ roles == map (view role) players--prop_createPlayersCreatesAlivePlayers :: [Text] -> [Role] -> Property-prop_createPlayersCreatesAlivePlayers playerNames extraRoles = monadicIO $ do-    players <- createPlayers playerNames (padRoles extraRoles (length playerNames))--    return $ all isAlive players--prop_padRolesReturnsNRoles :: [Role] -> Int -> Property-prop_padRolesReturnsNRoles extraRoles n = monadicIO $ do-    let roles = padRoles extraRoles n--    return $ length roles == n--prop_padRolesUsesGivenRoles :: [Role] -> Int -> Property-prop_padRolesUsesGivenRoles extraRoles n = monadicIO $ do-    let roles = padRoles extraRoles n--    return $ extraRoles `isSubsequenceOf` roles--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` 5 + 1

@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-}- module Game.Werewolf.Test.Game (     -- * Tests     allGameTests,@@ -14,12 +12,11 @@  import Control.Lens -import qualified Data.Map   as Map-import           Data.Maybe+import Data.Maybe -import Game.Werewolf.Internal.Game-import Game.Werewolf.Internal.Player-import Game.Werewolf.Test.Arbitrary  ()+import Game.Werewolf.Game+import Game.Werewolf.Player+import Game.Werewolf.Test.Arbitrary ()  import Prelude hiding (round) @@ -49,25 +46,25 @@  prop_newGameStartsAtVillagesTurnWhenAngelInPlay :: [Player] -> Property prop_newGameStartsAtVillagesTurnWhenAngelInPlay players =-    any isAngel players-    ==> isVillagesTurn (newGame players)+    has angels players+    ==> has (stage . _VillagesTurn) (newGame players)  prop_newGameStartsAtSunsetWhenNoAngelInPlay :: [Player] -> Property prop_newGameStartsAtSunsetWhenNoAngelInPlay players =-    none isAngel players-    ==> isSunset (newGame players)+    hasn't angels players+    ==> has (stage . _Sunset) (newGame players)  prop_newGameStartsOnFirstRound :: [Player] -> Bool prop_newGameStartsOnFirstRound players = isFirstRound $ newGame players  prop_newGameStartsWithEventsEmpty :: [Player] -> Bool-prop_newGameStartsWithEventsEmpty players = null $ newGame players ^. events+prop_newGameStartsWithEventsEmpty players = has (events . _Empty) (newGame players)  prop_newGameStartsWithPassesEmpty :: [Player] -> Bool-prop_newGameStartsWithPassesEmpty players = null $ newGame players ^. passes+prop_newGameStartsWithPassesEmpty players = has (passes . _Empty) (newGame players)  prop_newGameStartsWithAllowedVotersFull :: [Player] -> Property-prop_newGameStartsWithAllowedVotersFull players = newGame players ^. allowedVoters === map (view name) players+prop_newGameStartsWithAllowedVotersFull players = newGame players ^. allowedVoters === players ^.. names  prop_newGameStartsWithHealFalse :: [Player] -> Bool prop_newGameStartsWithHealFalse players = not $ newGame players ^. heal@@ -98,7 +95,7 @@     not $ newGame players ^. villageIdiotRevealed  prop_newGameStartsWithVotesEmpty :: [Player] -> Bool-prop_newGameStartsWithVotesEmpty players = Map.null $ newGame players ^. votes+prop_newGameStartsWithVotesEmpty players = has (votes . _Empty) (newGame players)  prop_newGameUsesGivenPlayers :: [Player] -> Bool prop_newGameUsesGivenPlayers players' = newGame players' ^. players == players'

@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-}- module Game.Werewolf.Test.Player (     -- * Tests     allPlayerTests,@@ -16,9 +14,9 @@  import Data.Text -import Game.Werewolf.Internal.Player+import Game.Werewolf.Player import Game.Werewolf.Role-import Game.Werewolf.Test.Arbitrary  ()+import Game.Werewolf.Test.Arbitrary ()  import Test.Tasty import Test.Tasty.QuickCheck

@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-}- module Game.Werewolf.Test.Util (     -- * Utility functions     run, run_,

@@ -1,5 +1,5 @@ name:           werewolf-version:        0.4.6.1+version:        0.4.7.0  author:         Henry J. Wylde maintainer:     public@hjwylde.com@@ -28,29 +28,32 @@     hs-source-dirs: app/     ghc-options:    -threaded -with-rtsopts=-N     other-modules:-        Werewolf.Commands.Choose,-        Werewolf.Commands.Circle,-        Werewolf.Commands.End,-        Werewolf.Commands.Heal,-        Werewolf.Commands.Help,-        Werewolf.Commands.Interpret,-        Werewolf.Commands.Pass,-        Werewolf.Commands.Ping,-        Werewolf.Commands.Poison,-        Werewolf.Commands.Protect,-        Werewolf.Commands.Quit,-        Werewolf.Commands.See,-        Werewolf.Commands.Start,-        Werewolf.Commands.Status,-        Werewolf.Commands.Version,-        Werewolf.Commands.Vote,-        Werewolf.Messages,-        Werewolf.Options,-        Werewolf.Version,+        Werewolf.Commands.Choose+        Werewolf.Commands.Circle+        Werewolf.Commands.End+        Werewolf.Commands.Heal+        Werewolf.Commands.Help+        Werewolf.Commands.Interpret+        Werewolf.Commands.Pass+        Werewolf.Commands.Ping+        Werewolf.Commands.Poison+        Werewolf.Commands.Protect+        Werewolf.Commands.Quit+        Werewolf.Commands.See+        Werewolf.Commands.Start+        Werewolf.Commands.Status+        Werewolf.Commands.Version+        Werewolf.Commands.Vote+        Werewolf.Game+        Werewolf.Messages+        Werewolf.Options+        Werewolf.Version         Paths_werewolf      default-language: Haskell2010     other-extensions:+        FlexibleContexts,+        MultiParamTypeClasses,         OverloadedStrings     build-depends:         aeson >= 0.8 && < 0.11,@@ -70,18 +73,16 @@ 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+        Game.Werewolf.Command+        Game.Werewolf.Engine+        Game.Werewolf.Game+        Game.Werewolf.Player+        Game.Werewolf.Response         Game.Werewolf.Role     other-modules:         Game.Werewolf.Messages+        Game.Werewolf.Util      default-language: Haskell2010     other-extensions:@@ -90,7 +91,7 @@         FlexibleContexts,         MultiParamTypeClasses,         OverloadedStrings,-        RankNTypes,+        Rank2Types,         TemplateHaskell     build-depends:         aeson >= 0.8 && < 0.11,@@ -100,9 +101,7 @@         extra == 1.4.*,         filepath == 1.4.*,         lens >= 4.12 && < 4.14,-        MonadRandom == 0.4.*,         mtl == 2.2.*,-        random-shuffle,         text == 1.2.*,         transformers == 0.4.*