werewolf 1.0.2.2 → 1.1.0.0

raw patch · 73 files changed

+2343/−3404 lines, 73 filesdep −QuickCheckdep −tastydep −tasty-quickcheckPVP ok

version bump matches the API change (PVP)

Dependencies removed: QuickCheck, tasty, tasty-quickcheck

API changes (from Hackage documentation)

Files

• CHANGELOG.md +28/−1
• README.md +4/−1
• app/Game/Werewolf/Command.hs +48/−0
• app/Game/Werewolf/Command/Global.hs +50/−0
• app/Game/Werewolf/Command/Hunter.hs +42/−0
• app/Game/Werewolf/Command/Oracle.hs +35/−0
• app/Game/Werewolf/Command/Orphan.hs +36/−0
• app/Game/Werewolf/Command/Protector.hs +38/−0
• app/Game/Werewolf/Command/Scapegoat.hs +41/−0
• app/Game/Werewolf/Command/Seer.hs +35/−0
• app/Game/Werewolf/Command/Status.hs +90/−0
• app/Game/Werewolf/Command/Villager.hs +60/−0
• app/Game/Werewolf/Command/Werewolf.hs +67/−0
• app/Game/Werewolf/Command/Witch.hs +63/−0
• app/Game/Werewolf/Engine.hs +233/−0
• app/Game/Werewolf/Messages.hs +661/−0
• app/Game/Werewolf/Util.hs +208/−0
• app/Main.hs +4/−0
• app/Werewolf/Command/Boot.hs +3/−1
• app/Werewolf/Command/Choose.hs +4/−1
• app/Werewolf/Command/Circle.hs +2/−1
• app/Werewolf/Command/Divine.hs +53/−0
• app/Werewolf/Command/End.hs +5/−2
• app/Werewolf/Command/Heal.hs +3/−1
• app/Werewolf/Command/Help.hs +15/−15
• app/Werewolf/Command/Pass.hs +3/−1
• app/Werewolf/Command/Ping.hs +2/−1
• app/Werewolf/Command/Poison.hs +3/−1
• app/Werewolf/Command/Protect.hs +3/−1
• app/Werewolf/Command/Quit.hs +3/−1
• app/Werewolf/Command/See.hs +3/−1
• app/Werewolf/Command/Start.hs +25/−4
• app/Werewolf/Command/Status.hs +2/−1
• app/Werewolf/Command/Unvote.hs +54/−0
• app/Werewolf/Command/Vote.hs +4/−1
• app/Werewolf/Game.hs +0/−78
• app/Werewolf/Messages.hs +0/−7
• app/Werewolf/Options.hs +11/−0
• app/Werewolf/System.hs +82/−0
• src/Control/Lens/Extra.hs +14/−1
• src/Game/Werewolf.hs +0/−4
• src/Game/Werewolf/Command.hs +0/−48
• src/Game/Werewolf/Command/Global.hs +0/−49
• src/Game/Werewolf/Command/Hunter.hs +0/−41
• src/Game/Werewolf/Command/Orphan.hs +0/−35
• src/Game/Werewolf/Command/Protector.hs +0/−37
• src/Game/Werewolf/Command/Scapegoat.hs +0/−40
• src/Game/Werewolf/Command/Seer.hs +0/−34
• src/Game/Werewolf/Command/Status.hs +0/−105
• src/Game/Werewolf/Command/Villager.hs +0/−41
• src/Game/Werewolf/Command/Werewolf.hs +0/−48
• src/Game/Werewolf/Command/Witch.hs +0/−60
• src/Game/Werewolf/Engine.hs +0/−272
• src/Game/Werewolf/Game.hs +109/−145
• src/Game/Werewolf/Messages.hs +0/−621
• src/Game/Werewolf/Player.hs +74/−14
• src/Game/Werewolf/Response.hs +1/−1
• src/Game/Werewolf/Role.hs +99/−26
• src/Game/Werewolf/Util.hs +0/−194
• test/app/Main.hs +0/−23
• test/src/Game/Werewolf/Test/Arbitrary.hs +0/−429
• test/src/Game/Werewolf/Test/Command.hs +0/−34
• test/src/Game/Werewolf/Test/Command/Choose.hs +0/−199
• test/src/Game/Werewolf/Test/Command/Heal.hs +0/−74
• test/src/Game/Werewolf/Test/Command/Pass.hs +0/−51
• test/src/Game/Werewolf/Test/Command/Poison.hs +0/−105
• test/src/Game/Werewolf/Test/Command/Protect.hs +0/−98
• test/src/Game/Werewolf/Test/Command/Quit.hs +0/−45
• test/src/Game/Werewolf/Test/Command/See.hs +0/−86
• test/src/Game/Werewolf/Test/Command/Vote.hs +0/−181
• test/src/Game/Werewolf/Test/Engine.hs +0/−51
• test/src/Game/Werewolf/Test/Util.hs +0/−34
• werewolf.cabal +23/−58

@@ -1,7 +1,34 @@ # Changelog +**N.B.**, prior to v1 a change was considered *breaking* if it altered how an interface interacts+    with the werewolf binary.+Post v1 a change is further considered breaking if the state file format is incompatible with the+    previous version.+ ### Upcoming +### v1.1.0.0++*Major*++* Moved majority of library classes to app/. ([#208](https://github.com/hjwylde/werewolf/issues/208))+* Changed the Fallen Angel to be a true Loner. ([#173](https://github.com/hjwylde/werewolf/issues/173))+* Added the Oracle role. ([#141](https://github.com/hjwylde/werewolf/issues/141))+* Removed the event concept. ([#147](https://github.com/hjwylde/werewolf/issues/147))++*Minor*++* Added private message to players when they die. ([#188](https://github.com/hjwylde/werewolf/issues/188))+* Added the Medusa role. ([#99](https://github.com/hjwylde/werewolf/issues/99))+* Added `unvote` command. ([#213](https://github.com/hjwylde/werewolf/issues/213))+* Removed public knowledge of Villagers and Werewolves that have voted. ([#214](https://github.com/hjwylde/werewolf/issues/214))+* Added the Spiteful Ghost role. ([#206](https://github.com/hjwylde/werewolf/issues/206))++*Revisions*++* Updated the Scapegoat's turn messages to be clear that they may choose more than 1 player. ([#185](https://github.com/hjwylde/werewolf/issues/185))+* Updated Beholder's balance to 1.+ ### v1.0.2.2  *Revisions*@@ -367,7 +394,7 @@  *Minor* -* Added a Scapegoat role. ([#40](https://github.com/hjwylde/werewolf/issues/40))+* Added the Scapegoat role. ([#40](https://github.com/hjwylde/werewolf/issues/40)) * Added a `status` command. ([#18](https://github.com/hjwylde/werewolf/issues/18))  *Revisions*

@@ -8,7 +8,7 @@  A game engine for playing werewolf within an arbitrary chat client. Werewolf is a well known social party game, commonly also called Mafia.-See the [Wikipedia article](https://en.wikipedia.org/wiki/Mafia_(party_game)) for a rundown on it's+See the [Wikipedia article](https://en.wikipedia.org/wiki/Mafia_(party_game)) for a rundown on its     gameplay and history.  If you're here just to play werewolf, you may wish to skip straight to@@ -49,6 +49,7 @@ The Loners must complete their own objective.  * Fallen Angel+* Spiteful Ghost  **The Villagers:** @@ -65,6 +66,8 @@ * Hunter * Jester * Lycan+* Medusa+* Oracle * Protector * Scapegoat * Seer

@@ -0,0 +1,48 @@+{-|+Module      : Game.Werewolf.Command+Description : Command data structure.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Command data structures.+-}++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types            #-}++module Game.Werewolf.Command (+    -- * Command+    Command(..),++    -- ** Instances+    noopCommand,++    -- ** Validation+    validatePlayer,+) where++import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.State+import Control.Monad.Writer++import Data.Text (Text)++import Game.Werewolf.Game     hiding (getPendingVoters)+import Game.Werewolf.Messages+import Game.Werewolf.Response+import Game.Werewolf.Util++data Command = Command { apply :: forall m . (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => m () }++noopCommand :: Command+noopCommand = Command $ return ()++validatePlayer :: (MonadError [Message] m, MonadState Game m) => Text -> Text -> m ()+validatePlayer callerName name = do+    whenM isGameOver                $ throwError [gameIsOverMessage callerName]+    unlessM (doesPlayerExist name)  $ throwError [playerDoesNotExistMessage callerName name]+    whenM (isPlayerDead name)       $ throwError [if callerName == name then playerIsDeadMessage callerName else targetIsDeadMessage callerName name]

@@ -0,0 +1,50 @@+{-|+Module      : Game.Werewolf.Command.Global+Description : Global commands.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Global commands.+-}++module Game.Werewolf.Command.Global (+    -- * Commands+    bootCommand, quitCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.Writer++import qualified Data.Map   as Map+import           Data.Maybe+import           Data.Text  (Text)++import Game.Werewolf+import Game.Werewolf.Command+import Game.Werewolf.Messages+import Game.Werewolf.Util++bootCommand :: Text -> Text -> Command+bootCommand callerName targetName = Command $ do+    validatePlayer callerName callerName+    validatePlayer callerName targetName+    whenM (uses (boots . at targetName) $ elem callerName . fromMaybe []) $+        throwError [playerHasAlreadyVotedToBootMessage callerName targetName]++    boots %= Map.insertWith (++) targetName [callerName]++    tell [playerVotedToBootMessage callerName targetName]++quitCommand :: Text -> Command+quitCommand callerName = Command $ do+    validatePlayer callerName callerName++    caller <- findPlayerBy_ name callerName++    tell [playerQuitMessage caller]++    removePlayer callerName

@@ -0,0 +1,42 @@+{-|+Module      : Game.Werewolf.Command.Hunter+Description : Hunter commands.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Hunter commands.+-}++module Game.Werewolf.Command.Hunter (+    -- * Commands+    chooseCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.Writer++import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Command+import Game.Werewolf.Messages+import Game.Werewolf.Util++chooseCommand :: Text -> Text -> Command+chooseCommand callerName targetName = Command $ do+    whenM isGameOver                        $ throwError [gameIsOverMessage callerName]+    unlessM (doesPlayerExist callerName)    $ throwError [playerDoesNotExistMessage callerName callerName]+    unlessM (isPlayerHunter callerName)     $ throwError [playerCannotDoThatMessage callerName]+    unlessM isHuntersTurn                   $ throwError [playerCannotDoThatRightNowMessage callerName]+    validatePlayer callerName targetName++    target <- findPlayerBy_ name targetName++    tell [playerShotMessage target]+    killPlayer targetName++    hunterRetaliated .= True

@@ -0,0 +1,35 @@+{-|+Module      : Game.Werewolf.Command.Oracle+Description : Oracle commands.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Seer commands.+-}++module Game.Werewolf.Command.Oracle (+    -- * Commands+    divineCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra++import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Command+import Game.Werewolf.Messages+import Game.Werewolf.Util++divineCommand :: Text -> Text -> Command+divineCommand callerName targetName = Command $ do+    validatePlayer callerName callerName+    unlessM (isPlayerOracle callerName) $ throwError [playerCannotDoThatMessage callerName]+    unlessM isOraclesTurn               $ throwError [playerCannotDoThatRightNowMessage callerName]+    validatePlayer callerName targetName++    divine .= Just targetName

@@ -0,0 +1,36 @@+{-|+Module      : Game.Werewolf.Command.Orphan+Description : Orphan commands.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Orphan commands.+-}++module Game.Werewolf.Command.Orphan (+    -- * Commands+    chooseCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra++import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Command+import Game.Werewolf.Messages+import Game.Werewolf.Util++chooseCommand :: Text -> Text -> Command+chooseCommand callerName targetName = Command $ do+    validatePlayer callerName callerName+    unlessM (isPlayerOrphan callerName) $ throwError [playerCannotDoThatMessage callerName]+    unlessM isOrphansTurn               $ throwError [playerCannotDoThatRightNowMessage callerName]+    when (callerName == targetName)     $ throwError [playerCannotChooseSelfMessage callerName]+    validatePlayer callerName targetName++    roleModel .= Just targetName

@@ -0,0 +1,38 @@+{-|+Module      : Game.Werewolf.Command.Protector+Description : Protector commands.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Protector commands.+-}++module Game.Werewolf.Command.Protector (+    -- * Commands+    protectCommand,+) where++import Control.Lens+import Control.Lens.Extra+import Control.Monad.Except+import Control.Monad.Extra++import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Command+import Game.Werewolf.Messages+import Game.Werewolf.Util++protectCommand :: Text -> Text -> Command+protectCommand callerName targetName = Command $ do+    validatePlayer callerName callerName+    unlessM (isPlayerProtector callerName)                      $ throwError [playerCannotDoThatMessage callerName]+    unlessM isProtectorsTurn                                    $ throwError [playerCannotDoThatRightNowMessage callerName]+    validatePlayer callerName targetName+    whenM (hasuse $ priorProtect . traverse . only targetName)  $ throwError [playerCannotProtectSamePlayerTwiceInARowMessage callerName]++    priorProtect    .= Just targetName+    protect         .= Just targetName

@@ -0,0 +1,41 @@+{-|+Module      : Game.Werewolf.Command.Scapegoat+Description : Scapegoat commands.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Scapegoat commands.+-}++module Game.Werewolf.Command.Scapegoat (+    -- * Commands+    chooseCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra++import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Command+import Game.Werewolf.Messages+import Game.Werewolf.Util++chooseCommand :: Text -> [Text] -> Command+chooseCommand callerName targetNames = Command $ do+    whenM isGameOver                        $ throwError [gameIsOverMessage callerName]+    unlessM (doesPlayerExist callerName)    $ throwError [playerDoesNotExistMessage callerName callerName]+    unlessM (isPlayerScapegoat callerName)  $ throwError [playerCannotDoThatMessage callerName]+    unlessM isScapegoatsTurn                $ throwError [playerCannotDoThatRightNowMessage callerName]+    when (null targetNames)                 $ throwError [playerMustChooseAtLeastOneTargetMessage callerName]+    when (callerName `elem` targetNames)    $ throwError [playerCannotChooseSelfMessage callerName]+    forM_ targetNames $ validatePlayer callerName+    whenM (use jesterRevealed &&^ anyM isPlayerJester targetNames) $+        throwError [playerCannotChooseJesterMessage callerName]++    allowedVoters   .= targetNames+    scapegoatBlamed .= False

@@ -0,0 +1,35 @@+{-|+Module      : Game.Werewolf.Command.Seer+Description : Seer commands.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Seer commands.+-}++module Game.Werewolf.Command.Seer (+    -- * Commands+    seeCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra++import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Command+import Game.Werewolf.Messages+import Game.Werewolf.Util++seeCommand :: Text -> Text -> Command+seeCommand callerName targetName = Command $ do+    validatePlayer callerName callerName+    unlessM (isPlayerSeer callerName)   $ throwError [playerCannotDoThatMessage callerName]+    unlessM isSeersTurn                 $ throwError [playerCannotDoThatRightNowMessage callerName]+    validatePlayer callerName targetName++    see .= Just targetName

@@ -0,0 +1,90 @@+{-|+Module      : Game.Werewolf.Command.Status+Description : Status commands.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Status commands.+-}++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}++module Game.Werewolf.Command.Status (+    -- * Commands+    circleCommand, pingCommand, statusCommand,+) where++import Control.Lens+import Control.Monad.State+import Control.Monad.Writer++import Data.List+import Data.Text (Text)++import           Game.Werewolf          hiding (getPendingVoters)+import           Game.Werewolf.Command+import           Game.Werewolf.Messages+import qualified Game.Werewolf.Role     as Role+import           Game.Werewolf.Util++circleCommand :: Text -> Bool -> Command+circleCommand callerName includeDead = Command $ do+        players' <- toListOf (players . traverse . if includeDead then id else alive) <$> get++        tell [circleMessage callerName players']++pingCommand :: Text -> Command+pingCommand callerName = Command $ use stage >>= \stage' -> case stage' of+    FerinasGrunt        -> return ()+    GameOver            -> tell [gameIsOverMessage callerName]+    HuntersTurn1        -> pingRole hunterRole+    HuntersTurn2        -> pingRole hunterRole+    Lynching            -> return ()+    OraclesTurn         -> pingRole oracleRole+    OrphansTurn         -> pingRole orphanRole+    ProtectorsTurn      -> pingRole protectorRole+    ScapegoatsTurn      -> pingRole scapegoatRole+    SeersTurn           -> pingRole seerRole+    Sunrise             -> return ()+    Sunset              -> return ()+    VillageDrunksTurn   -> pingRole villageDrunkRole+    VillagesTurn        -> pingVillagers+    WerewolvesTurn      -> pingWerewolves+    WitchsTurn          -> pingRole witchRole++pingRole :: (MonadState Game m, MonadWriter [Message] m) => Role -> m ()+pingRole role' = do+    player <- findPlayerBy_ role role'++    tell [pingRoleMessage $ role' ^. Role.name]+    tell [pingPlayerMessage $ player ^. name]++pingVillagers :: (MonadState Game m, MonadWriter [Message] m) => m ()+pingVillagers = do+    allowedVoterNames <- use allowedVoters+    pendingVoterNames <- toListOf names <$> getPendingVoters++    tell [pingRoleMessage "village"]+    tell $ map pingPlayerMessage (allowedVoterNames `intersect` pendingVoterNames)++pingWerewolves :: (MonadState Game m, MonadWriter [Message] m) => m ()+pingWerewolves = do+    pendingVoters <- getPendingVoters++    tell [pingRoleMessage "Werewolves"]+    tell $ map pingPlayerMessage (pendingVoters ^.. werewolves . name)++statusCommand :: Text -> Command+statusCommand callerName = Command $ use stage >>= \stage' -> case stage' of+    GameOver    -> tell [gameIsOverMessage callerName]+    _           -> tell . statusMessages stage' =<< use players+    where+        statusMessages stage players =+            currentStageMessages callerName stage +++            [ rolesInGameMessage (Just callerName) (players ^.. roles)+            , playersInGameMessage callerName players+            ]

@@ -0,0 +1,60 @@+{-|+Module      : Game.Werewolf.Command.Villager+Description : Villager commands.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Villager commands.+-}++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Game.Werewolf.Command.Villager (+    -- * Commands+    unvoteCommand, voteCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.State+import Control.Monad.Writer++import qualified Data.Map   as Map+import           Data.Maybe+import           Data.Text  (Text)++import Game.Werewolf+import Game.Werewolf.Command+import Game.Werewolf.Messages+import Game.Werewolf.Util++unvoteCommand :: Text -> Command+unvoteCommand callerName = Command $ do+    validateCommand callerName+    whenM (isNothing <$> getPlayerVote callerName) $ throwError [playerHasNotVotedMessage callerName]++    votes %= Map.delete callerName++    whenJustM (preuse $ players . crookedSenators . alive) $ \crookedSenator ->+        tell [playerRescindedVoteMessage (crookedSenator ^. name) callerName]++voteCommand :: Text -> Text -> Command+voteCommand callerName targetName = Command $ do+    validateCommand callerName+    whenM (isJust <$> getPlayerVote callerName) $ throwError [playerHasAlreadyVotedMessage callerName]+    validatePlayer callerName targetName++    votes %= Map.insert callerName targetName++    whenJustM (preuse $ players . crookedSenators . alive) $ \crookedSenator ->+        tell [playerMadeLynchVoteMessage (Just $ crookedSenator ^. name) callerName targetName]++validateCommand :: (MonadError [Message] m, MonadState Game m) => Text -> m ()+validateCommand callerName = do+    validatePlayer callerName callerName+    whenM (uses allowedVoters (callerName `notElem`))   $ throwError [playerCannotDoThatMessage callerName]+    unlessM isVillagesTurn                              $ throwError [playerCannotDoThatRightNowMessage callerName]

@@ -0,0 +1,67 @@+{-|+Module      : Game.Werewolf.Command.Werewolf+Description : Werewolf commands.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Werewolf commands.+-}++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Game.Werewolf.Command.Werewolf (+    -- * Commands+    unvoteCommand, voteCommand,++    -- ** Validation+    validatePlayer,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.State+import Control.Monad.Writer++import           Data.List+import qualified Data.Map   as Map+import           Data.Maybe+import           Data.Text  (Text)++import Game.Werewolf+import Game.Werewolf.Command+import Game.Werewolf.Messages+import Game.Werewolf.Util++unvoteCommand :: Text -> Command+unvoteCommand callerName = Command $ do+    validateCommand callerName+    whenM (isNothing <$> getPlayerVote callerName) $ throwError [playerHasNotVotedMessage callerName]++    votes %= Map.delete callerName++    aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get++    tell [playerRescindedVoteMessage werewolfName callerName | werewolfName <- aliveWerewolfNames \\ [callerName]]++voteCommand :: Text -> Text -> Command+voteCommand callerName targetName = Command $ do+    validateCommand callerName+    whenM (isJust <$> getPlayerVote callerName) $ throwError [playerHasAlreadyVotedMessage callerName]+    validatePlayer callerName targetName+    whenM (isPlayerWerewolf targetName)         $ throwError [playerCannotDevourAnotherWerewolfMessage callerName]++    votes %= Map.insert callerName targetName++    aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get++    tell [playerMadeDevourVoteMessage werewolfName callerName targetName | werewolfName <- aliveWerewolfNames \\ [callerName]]++validateCommand :: (MonadError [Message] m, MonadState Game m) => Text -> m ()+validateCommand callerName = do+    validatePlayer callerName callerName+    unlessM (isPlayerWerewolf callerName)   $ throwError [playerCannotDoThatMessage callerName]+    unlessM isWerewolvesTurn                $ throwError [playerCannotDoThatRightNowMessage callerName]

@@ -0,0 +1,63 @@+{-|+Module      : Game.Werewolf.Command.Witch+Description : Witch commands.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Witch commands.+-}++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Game.Werewolf.Command.Witch (+    -- * Commands+    healCommand, passCommand, poisonCommand,+) where++import Control.Lens+import Control.Lens.Extra+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.State++import Data.Map  as Map+import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Command+import Game.Werewolf.Messages+import Game.Werewolf.Util++healCommand :: Text -> Command+healCommand callerName = Command $ do+    validateCommand callerName+    whenM (use healUsed)        $ throwError [playerHasAlreadyHealedMessage callerName]+    whenM (hasn'tuse votee)     $ throwError [playerCannotDoThatRightNowMessage callerName]++    healUsed    .= True+    votes       .= Map.empty++passCommand :: Text -> Command+passCommand callerName = Command $ do+    validateCommand callerName++    passed .= True++poisonCommand :: Text -> Text -> Command+poisonCommand callerName targetName = Command $ do+    validateCommand callerName+    whenM (use poisonUsed)                      $ throwError [playerHasAlreadyPoisonedMessage callerName]+    validatePlayer callerName targetName+    whenM (hasuse $ votee . named targetName)   $ throwError [playerCannotDoThatMessage callerName]++    poison      .= Just targetName+    poisonUsed  .= True++validateCommand :: (MonadError [Message] m, MonadState Game m) => Text -> m ()+validateCommand callerName = do+    validatePlayer callerName callerName+    unlessM (isPlayerWitch callerName)  $ throwError [playerCannotDoThatMessage callerName]+    unlessM isWitchsTurn                $ throwError [playerCannotDoThatRightNowMessage callerName]

@@ -0,0 +1,233 @@+{-|+Module      : Game.Werewolf.Engine+Description : Engine functions.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Engine functions.+-}++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Game.Werewolf.Engine (+    -- * Loop+    checkStage, checkGameOver,+) where++import Control.Lens         hiding (cons, isn't)+import Control.Lens.Extra+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.Random+import Control.Monad.State+import Control.Monad.Writer++import           Data.List.Extra+import qualified Data.Map        as Map+import           Data.Maybe++import Game.Werewolf.Game     hiding (getAllowedVoters, getPendingVoters, hasAnyoneWon,+                               hasFallenAngelWon, hasVillagersWon, hasWerewolvesWon)+import Game.Werewolf.Messages+import Game.Werewolf.Player+import Game.Werewolf.Response+import Game.Werewolf.Role     hiding (name)+import Game.Werewolf.Util++import Prelude hiding (round)++checkStage :: (MonadRandom m, MonadState Game m, MonadWriter [Message] m) => m ()+checkStage = do+    game <- get+    checkBoots >> checkStage'+    game' <- get++    when (game /= game') checkStage++checkBoots :: (MonadState Game m, MonadWriter [Message] m) => m ()+checkBoots = do+    alivePlayerCount <- length . toListOf (players . traverse . alive) <$> get++    booteeNames <- uses boots $ Map.keys . Map.filter (\voters -> length voters > alivePlayerCount `div` 2)+    bootees     <- mapM (findPlayerBy_ name) booteeNames++    forM_ (filter (is alive) bootees) $ \bootee -> do+        tell [playerBootedMessage bootee]++        removePlayer (bootee ^. name)++checkStage' :: (MonadRandom m, MonadState Game m, MonadWriter [Message] m) => m ()+checkStage' = use stage >>= \stage' -> case stage' of+    FerinasGrunt -> do+        druid       <- findPlayerBy_ role druidRole+        players'    <- filter (isn't alphaWolf) <$> getAdjacentAlivePlayers (druid ^. name)++        when (has werewolves players' || has lycans players') $ tell [ferinaGruntsMessage]++        advanceStage++    GameOver -> return ()++    HuntersTurn1 -> whenM (use hunterRetaliated) advanceStage++    HuntersTurn2 -> whenM (use hunterRetaliated) advanceStage++    Lynching -> do+        lynchVotee =<< preuse votee++        allVoters       <- ifM (use jesterRevealed)+            (uses players $ filter (isn't jester))+            (use players)+        allowedVoters   .= allVoters ^.. traverse . alive . name++        votes .= Map.empty++        advanceStage++    OraclesTurn -> do+        whenM (hasuse $ players . oracles . dead) advanceStage++        whenM (isJust <$> use divine) advanceStage++    OrphansTurn -> do+        whenM (hasuse $ players . orphans . dead) advanceStage++        whenM (isJust <$> use roleModel) advanceStage++    ProtectorsTurn -> do+        whenM (hasuse $ players . protectors . dead) advanceStage++        whenM (isJust <$> use protect) advanceStage++    ScapegoatsTurn -> unlessM (use scapegoatBlamed) $ do+        allowedVoters' <- use allowedVoters+        tell [scapegoatChoseAllowedVotersMessage allowedVoters']++        advanceStage++    SeersTurn -> do+        whenM (hasuse $ players . seers . dead) advanceStage++        whenM (isJust <$> use see) advanceStage++    Sunrise -> do+        round += 1++        devourVotee =<< preuse votee++        whenJustM (use poison) $ \targetName -> do+            target <- findPlayerBy_ name targetName++            killPlayer targetName+            tell [playerPoisonedMessage target]++        whenJustM (preuse $ players . seers . alive) $ \seer -> do+            target <- use see >>= findPlayerBy_ name . fromJust++            when (is alive target) $ tell [playerSeenMessage (seer ^. name) target]++        whenJustM (preuse $ players . oracles . alive) $ \oracle -> do+            target <- use divine >>= findPlayerBy_ name . fromJust++            when (is alive target) $ tell [playerDivinedMessage (oracle ^. name) target]++        divine  .= Nothing+        poison  .= Nothing+        protect .= Nothing+        see     .= Nothing+        votes   .= Map.empty++        advanceStage++    Sunset -> do+        whenJustM (use roleModel) $ \roleModelsName -> do+            orphan <- findPlayerBy_ role orphanRole++            whenM (isPlayerDead roleModelsName &&^ return (is alive orphan) &&^ return (is villager orphan)) $ do+                aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get++                setPlayerAllegiance (orphan ^. name) Werewolves++                tell $ orphanJoinedPackMessages (orphan ^. name) aliveWerewolfNames++        advanceStage++    VillageDrunksTurn -> do+        aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get++        randomAllegiance <- getRandomAllegiance+        players . villageDrunks . role . allegiance .= randomAllegiance++        villageDrunk <- findPlayerBy_ role villageDrunkRole++        if is villager villageDrunk+            then tell [villageDrunkJoinedVillageMessage $ villageDrunk ^. name]+            else tell $ villageDrunkJoinedPackMessages (villageDrunk ^. name) aliveWerewolfNames++        advanceStage++    VillagesTurn -> whenM (null <$> liftM2 intersect getAllowedVoters getPendingVoters) $ do+        tell . map (uncurry $ playerMadeLynchVoteMessage Nothing) =<< uses votes Map.toList++        advanceStage++    WerewolvesTurn -> whenM (none (is werewolf) <$> getPendingVoters) $ do+        whenM (liftM2 (==) (use protect) (preuses votee $ view name)) $ votes .= Map.empty++        advanceStage++    WitchsTurn -> do+        whenM (hasuse $ players . witches . dead) advanceStage++        whenM (use healUsed &&^ use poisonUsed) advanceStage+        whenM (use passed)                      advanceStage++lynchVotee :: (MonadState Game m, MonadWriter [Message] m) => Maybe Player -> m ()+lynchVotee (Just votee)+    | is jester votee       = do+        jesterRevealed .= True++        tell [jesterLynchedMessage $ votee ^. name]+    | is fallenAngel votee  = do+        fallenAngelLynched .= True++        tell [playerLynchedMessage votee]+    | otherwise             = do+        killPlayer (votee ^. name)+        tell [playerLynchedMessage votee]+lynchVotee _            = preuse (players . scapegoats . alive) >>= \mScapegoat -> case mScapegoat of+    Just scapegoat  -> do+        scapegoatBlamed .= True++        killPlayer (scapegoat ^. name)+        tell [scapegoatLynchedMessage (scapegoat ^. name)]+    _               -> tell [noPlayerLynchedMessage]++devourVotee :: (MonadState Game m, MonadWriter [Message] m) => Maybe Player -> m ()+devourVotee Nothing         = tell [noPlayerDevouredMessage]+devourVotee (Just votee)    = do+    killPlayer (votee ^. name)+    tell [playerDevouredMessage votee]++    when (is medusa votee) . whenJustM (getFirstAdjacentAliveWerewolf $ votee ^. name) $ \werewolf -> do+        killPlayer (werewolf ^. name)+        tell [playerTurnedToStoneMessage werewolf]++advanceStage :: (MonadState Game m, MonadWriter [Message] m) => m ()+advanceStage = do+    game        <- get+    nextStage   <- ifM hasAnyoneWon+        (return GameOver)+        (return . head $ filter (stageAvailable game) (drop1 $ dropWhile (game ^. stage /=) stageCycle))++    stage   .= nextStage+    boots   .= Map.empty+    passed  .= False++    tell . stageMessages =<< get++checkGameOver :: (MonadState Game m, MonadWriter [Message] m) => m ()+checkGameOver = whenM hasAnyoneWon $ stage .= GameOver >> get >>= tell . gameOverMessages

@@ -0,0 +1,661 @@+{-|+Module      : Game.Werewolf.Messages+Description : Suite of messages used throughout the game.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++A 'Message' is used to relay information back to either all players or a single player. This module+defines suite of messages used throughout the werewolf game, including both game play messages and+binary errors.++@werewolf@ was designed to be ambivalent to the playing chat client. The response-message structure+reflects this by staying away from anything that could be construed as client-specific. This+includes features such as emoji support.+-}++{-# LANGUAGE OverloadedStrings #-}++module Game.Werewolf.Messages (+    -- * Generic messages+    newGameMessages, stageMessages, gameOverMessages, playerQuitMessage, gameIsOverMessage,+    playerKilledMessage,++    -- ** Error messages+    playerDoesNotExistMessage, playerCannotDoThatMessage, playerCannotDoThatRightNowMessage,+    playerIsDeadMessage, targetIsDeadMessage,++    -- * Boot messages+    playerVotedToBootMessage, playerBootedMessage,++    -- ** Error messages+    playerHasAlreadyVotedToBootMessage,++    -- * Circle messages+    circleMessage,++    -- * Ping messages+    pingPlayerMessage, pingRoleMessage,++    -- * Status messages+    currentStageMessages, rolesInGameMessage, playersInGameMessage,++    -- * Druid's turn messages+    ferinaGruntsMessage,++    -- * Hunter's turn messages+    playerShotMessage,++    -- * Oracle's turn messages+    playerDivinedMessage,++    -- * Orphan's turn messages+    orphanJoinedPackMessages,++    -- * Protector's turn messages++    -- ** Error messages+    playerCannotProtectSamePlayerTwiceInARowMessage,++    -- * Scapegoat's turn messages+    scapegoatChoseAllowedVotersMessage,++    -- ** Error messages+    playerMustChooseAtLeastOneTargetMessage, playerCannotChooseJesterMessage,++    -- * Seer's turn messages+    playerSeenMessage,++    -- * Village Drunk's turn messages+    villageDrunkJoinedVillageMessage, villageDrunkJoinedPackMessages,++    -- * Villages' turn messages+    playerMadeLynchVoteMessage, playerRescindedVoteMessage, playerLynchedMessage,+    noPlayerLynchedMessage, jesterLynchedMessage, scapegoatLynchedMessage,++    -- ** Error messages+    playerHasAlreadyVotedMessage, playerHasNotVotedMessage,++    -- * Werewolves' turn messages+    playerMadeDevourVoteMessage, playerDevouredMessage, playerTurnedToStoneMessage,+    noPlayerDevouredMessage,++    -- ** Error messages+    playerCannotDevourAnotherWerewolfMessage,++    -- ** Error messages+    playerCannotChooseSelfMessage,++    -- * Witch's turn messages+    playerPoisonedMessage,++    -- ** Error messages+    playerHasAlreadyHealedMessage, playerHasAlreadyPoisonedMessage,+) where++import Control.Arrow+import Control.Lens+import Control.Lens.Extra++import           Data.List.Extra+import           Data.String.Humanise+import           Data.Text            (Text)+import qualified Data.Text            as T++import           Game.Werewolf.Game+import           Game.Werewolf.Player+import           Game.Werewolf.Response+import           Game.Werewolf.Role     hiding (name)+import qualified Game.Werewolf.Role     as Role++newGameMessages :: Game -> [Message]+newGameMessages game = concat+    [ [newPlayersInGameMessage $ players' ^.. names]+    , [rolesInGameMessage Nothing $ players' ^.. roles]+    , map newPlayerMessage players'+    , beholderMessages+    , spitefulGhostMessages+    , trueVillagerMessages+    , fallenAngelMessages+    , stageMessages game+    ]+    where+        players'                = game ^. players+        beholderMessages        = case (,) <$> players' ^? beholders <*> players' ^? seers of+            Just (beholder, seer)   -> [beholderMessage (beholder ^. name) (seer ^. name)]+            _                       -> []+        spitefulGhostMessages   = case players' ^? spitefulGhosts of+            Just spitefulGhost  -> [spitefulGhostMessage (spitefulGhost ^. name) (players' \\ [spitefulGhost])]+            _                   -> []+        trueVillagerMessages    = case players' ^? trueVillagers of+            Just trueVillager   -> [trueVillagerMessage $ trueVillager ^. name]+            _                   -> []+        fallenAngelMessages     = if has fallenAngels players'+            then [fallenAngelMessage]+            else []++newPlayersInGameMessage :: [Text] -> Message+newPlayersInGameMessage playerNames = publicMessage $ T.concat+    ["A new game of werewolf is starting with ", concatList playerNames, "!"]++newPlayerMessage :: Player -> Message+newPlayerMessage player = privateMessage (player ^. name) $ T.intercalate "\n"+    [ T.concat ["You're ", article playerRole, " ", playerRole ^. Role.name, "."]+    , playerRole ^. description+    , playerRole ^. rules+    ]+    where+        playerRole = player ^. role++beholderMessage :: Text -> Text -> Message+beholderMessage to seerName = privateMessage to $ T.concat+    [ "The Seer has always been held in high regard among the Villagers. Few are as lucky as you to"+    , " know the Seer, ", seerName, ", personally."+    ]++spitefulGhostMessage :: Text -> [Player] -> Message+spitefulGhostMessage to players = privateMessage to $ T.concat+    [ "Being ethereal seldom has it's benefits. Perhaps however this knowledge of the townsfolks' "+    , "natures will bring you some joy in the afterlife: ", playerNamesWithRoles, "."+    ]+    where+        playerNamesWithRoles = concatList $ map+            (\player -> T.concat [player ^. name, " (", player ^. role . Role.name, ")"])+            players++trueVillagerMessage :: Text -> Message+trueVillagerMessage name = publicMessage $ T.unwords+    [ "Unguarded advice is seldom given, for advice is a dangerous gift, even from the wise to the"+    , "wise, and all courses may run ill. Yet as you feel like you need help, I begrudgingly leave"+    , "you with this:", name, "is the True Villager."+    ]++fallenAngelMessage :: Message+fallenAngelMessage = publicMessage $ T.unwords+    [ "Alas, again I regrettably yield advice: an angelic menace walks among you. Do not cast your"+    , "votes lightly, for they will relish in this opportunity to be free from their terrible"+    , "nightmare."+    ]++stageMessages :: Game -> [Message]+stageMessages game = case game ^. stage of+    FerinasGrunt        -> []+    GameOver            -> []+    HuntersTurn1        -> huntersTurnMessages huntersName+    HuntersTurn2        -> huntersTurnMessages huntersName+    Lynching            -> []+    OraclesTurn         -> oraclesTurnMessages oraclesName+    OrphansTurn         -> orphansTurnMessages orphansName+    ProtectorsTurn      -> protectorsTurnMessages protectorsName+    ScapegoatsTurn      -> scapegoatsTurnMessages scapegoatsName+    SeersTurn           -> seersTurnMessages seersName+    Sunrise             -> [sunriseMessage]+    Sunset              -> [nightFallsMessage]+    VillageDrunksTurn   -> [villageDrunksTurnMessage]+    VillagesTurn        -> villagesTurnMessages+    WerewolvesTurn      -> if is firstRound game+        then firstWerewolvesTurnMessages aliveWerewolfNames+        else werewolvesTurnMessages aliveWerewolfNames+    WitchsTurn          -> witchsTurnMessages game+    where+        players'            = game ^. players+        huntersName         = players' ^?! hunters . name+        oraclesName         = players' ^?! oracles . name+        orphansName         = players' ^?! orphans . name+        protectorsName      = players' ^?! protectors . name+        scapegoatsName      = players' ^?! scapegoats . name+        seersName           = players' ^?! seers . name+        aliveWerewolfNames  = players' ^.. werewolves . alive . name++huntersTurnMessages :: Text -> [Message]+huntersTurnMessages huntersName =+    [ publicMessage $ T.unwords ["Just before", huntersName, "was murdered they let off a shot."]+    , privateMessage huntersName "Whom do you `choose` to kill with your last shot?"+    ]++oraclesTurnMessages :: Text -> [Message]+oraclesTurnMessages to =+    [ publicMessage "The Oracle wakes up."+    , privateMessage to "Whose role would you like to `divine`?"+    ]++orphansTurnMessages :: Text -> [Message]+orphansTurnMessages to =+    [ publicMessage "The Orphan wakes up."+    , privateMessage to "Whom do you `choose` to be your role model?"+    ]++protectorsTurnMessages :: Text -> [Message]+protectorsTurnMessages to =+    [ publicMessage "The Protector wakes up."+    , privateMessage to "Whom would you like to `protect`?"+    ]++scapegoatsTurnMessages :: Text -> [Message]+scapegoatsTurnMessages scapegoatsName =+    [ publicMessage "Just before the Scapegoat burns to a complete crisp, they cry out a dying wish."+    , publicMessage $ T.concat [scapegoatsName, ", which players do you `choose` to vote on the next day?"]+    ]++seersTurnMessages :: Text -> [Message]+seersTurnMessages to =+    [ publicMessage "The Seer wakes up."+    , privateMessage to "Whose allegiance would you like to `see`?"+    ]++villageDrunksTurnMessage :: Message+villageDrunksTurnMessage = publicMessage "The Village Drunk sobers up."++sunriseMessage :: Message+sunriseMessage = publicMessage "The sun rises. Everybody wakes up and opens their eyes..."++nightFallsMessage :: Message+nightFallsMessage = publicMessage "Night falls, the village is asleep."++villagesTurnMessages :: [Message]+villagesTurnMessages =+    [ publicMessage "As the village gathers in the square the Town Clerk calls for a vote."+    , publicMessage "Whom would you like to `vote` to lynch?"+    ]++firstWerewolvesTurnMessages :: [Text] -> [Message]+firstWerewolvesTurnMessages tos =+    [privateMessage to $ packMessage to | length tos > 1, to <- tos]+    ++ werewolvesTurnMessages tos+    where+        packMessage werewolfName    = T.unwords+            [ "You feel restless, like an old curse is keeping you from sleep. It seems you're not"+            , "the only one...", packNames werewolfName+            , conjugateToBe (length tos - 1), "also emerging from their"+            , tryPlural (length tos - 1) "home"+            ]+        packNames werewolfName      = concatList $ tos \\ [werewolfName]++werewolvesTurnMessages :: [Text] -> [Message]+werewolvesTurnMessages tos =+    publicMessage "The Werewolves wake up, transform and choose a new victim."+    : groupMessages tos "Whom would you like to `vote` to devour?"++witchsTurnMessages :: Game -> [Message]+witchsTurnMessages game = concat+    [ [wakeUpMessage]+    , devourMessages+    , healMessages+    , poisonMessages+    , [passMessage]+    ]+    where+        witchsName      = game ^?! players . witches . name+        wakeUpMessage   = publicMessage "The Witch wakes up."+        passMessage     = privateMessage witchsName "Type `pass` to end your turn."+        devourMessages  = case game ^? votee of+            Just votee ->+                [ privateMessage witchsName $+                    T.unwords ["You see", votee ^. name, "sprawled outside bleeding uncontrollably."]+                ]+            _               -> []+        healMessages+            | game ^. healUsed  = []+            | hasn't votee game = []+            | otherwise         = [privateMessage witchsName "Would you like to `heal` them?"]+        poisonMessages+            | game ^. poisonUsed    = []+            | otherwise             = [privateMessage witchsName "Would you like to `poison` anyone?"]++gameOverMessages :: Game -> [Message]+gameOverMessages game+    | hasFallenAngelWon game    = concat+        [ [publicMessage "You should have heeded my warning, for now the Fallen Angel has been set free!"]+        , [publicMessage "The game is over! The Fallen Angel has won."]+        , [playerRolesMessage]+        , [playerWonMessage fallenAngelsName]+        , map playerLostMessage (game ^.. players . names \\ [fallenAngelsName])+        ]+    | hasVillagersWon game      = concat+        [ [publicMessage "The game is over! The Villagers have won."]+        , [playerRolesMessage]+        , playerWonMessages+        , playerContributedMessages+        , playerLostMessages+        ]+    | hasWerewolvesWon game     = concat+        [ [publicMessage "The game is over! The Werewolves have won."]+        , [playerRolesMessage]+        , playerWonMessages+        , playerContributedMessages+        , playerLostMessages+        ]+    | otherwise             = undefined+    where+        playerRolesMessage = publicMessage $ T.concat+            [ "As I know you're all wondering who lied to you, here's the role allocations: "+            , concatList $ map+                (\player -> T.concat [player ^. name, " (", player ^. role . Role.name, ")"])+                (game ^. players)+            , "."+            ]++        winningAllegiance+            | hasVillagersWon game      = Villagers+            | hasWerewolvesWon game     = Werewolves+            | otherwise                 = undefined++        winningPlayers  = game ^.. players . traverse . filteredBy (role . allegiance) winningAllegiance+        losingPlayers   = game ^. players \\ winningPlayers++        playerWonMessages           = map playerWonMessage (winningPlayers ^.. traverse . alive . name)+        playerContributedMessages   = map playerContributedMessage (winningPlayers ^.. traverse . dead . name)+        playerLostMessages          = map playerLostMessage (losingPlayers ^.. names)++        fallenAngelsName = game ^?! players . fallenAngels . name++playerWonMessage :: Text -> Message+playerWonMessage to = privateMessage to "Victory! You won!"++playerContributedMessage :: Text -> Message+playerContributedMessage to = privateMessage to "Your team won, but you died. Congratulations?"++playerLostMessage :: Text -> Message+playerLostMessage to = privateMessage to "Feck, you lost this time round."++playerQuitMessage :: Player -> Message+playerQuitMessage player = publicMessage $ T.unwords [playerName, "the", playerRole, "has quit!"]+    where+        playerName = player ^. name+        playerRole = player ^. role . Role.name++gameIsOverMessage :: Text -> Message+gameIsOverMessage to = privateMessage to "The game is over!"++playerKilledMessage :: Text -> Message+playerKilledMessage to = privateMessage to "Guh, you've been killed!"++playerDoesNotExistMessage :: Text -> Text -> Message+playerDoesNotExistMessage to name = privateMessage to $ T.unwords ["Player", name, "does not exist."]++playerCannotDoThatMessage :: Text -> Message+playerCannotDoThatMessage to = privateMessage to "You cannot do that!"++playerCannotDoThatRightNowMessage :: Text -> Message+playerCannotDoThatRightNowMessage to = privateMessage to "You cannot do that right now!"++playerIsDeadMessage :: Text -> Message+playerIsDeadMessage to = privateMessage to "Sshh, you're meant to be dead!"++targetIsDeadMessage :: Text -> Text -> Message+targetIsDeadMessage to targetName = privateMessage to $ T.unwords [targetName, "is already dead!"]++playerVotedToBootMessage :: Text -> Text -> Message+playerVotedToBootMessage playerName targetName = publicMessage $ T.concat+    [playerName, " voted to boot ", targetName, "!"]++playerBootedMessage :: Player -> Message+playerBootedMessage player = publicMessage $ T.unwords+    [ playerName, "the", playerRole ^. Role.name+    , "has been booted from the game!"+    ]+    where+        playerName = player ^. name+        playerRole = player ^. role++playerHasAlreadyVotedToBootMessage :: Text -> Text -> Message+playerHasAlreadyVotedToBootMessage to targetName = privateMessage to $ T.concat+    ["You've already voted to boot ", targetName, "!"]++circleMessage :: Text -> [Player] -> Message+circleMessage to players = privateMessage to $ T.intercalate "\n"+    [ "The players are sitting in the following order:"+    , T.intercalate " <-> " (map playerName (players ++ [head players]))+    ]+    where+        playerName player = T.concat [player ^. name, if is dead player then " (dead)" else ""]++pingPlayerMessage :: Text -> Message+pingPlayerMessage to = privateMessage to "Waiting on you..."++pingRoleMessage :: Text -> Message+pingRoleMessage roleName = publicMessage $ T.concat ["Waiting on the ", roleName, "..."]++currentStageMessages :: Text -> Stage -> [Message]+currentStageMessages _ FerinasGrunt = []+currentStageMessages to GameOver    = [gameIsOverMessage to]+currentStageMessages _ Lynching     = []+currentStageMessages _ Sunrise      = []+currentStageMessages _ Sunset       = []+currentStageMessages to turn        = [privateMessage to $ T.concat+    [ "It's currently the ", humanise turn, "."+    ]]++rolesInGameMessage :: Maybe Text -> [Role] -> Message+rolesInGameMessage mTo roles = Message mTo $ T.concat+    [ "The roles in play are "+    , concatList $ map (\(role, count) ->+        T.concat [role ^. Role.name, " (", T.pack $ show count, ")"])+        roleCounts+    , " for a total balance of ", T.pack $ show totalBalance, "."+    ]+    where+        roleCounts      = map (head &&& length) (groupSortOn (view Role.name) roles)+        totalBalance    = sumOf (traverse . balance) roles++playersInGameMessage :: Text -> [Player] -> Message+playersInGameMessage to players = privateMessage to . T.intercalate "\n" $+    alivePlayersText : [deadPlayersText | any (is dead) players]+    where+        alivePlayers    = players ^.. traverse . alive+        deadPlayers     = players ^.. traverse . dead++        alivePlayersText            = T.concat+            [ "The following players are still alive: "+            , concatList $ map (\player -> if is trueVillager player then playerNameWithRole player else player ^. name) alivePlayers, "."+            ]+        deadPlayersText             = T.concat+            [ "The following players are dead: "+            , concatList $ map playerNameWithRole deadPlayers, "."+            ]+        playerNameWithRole player   = T.concat [player ^. name, " (", player ^. role . Role.name, ")"]++ferinaGruntsMessage :: Message+ferinaGruntsMessage = publicMessage+    "Ferina wakes from her slumber, disturbed and on edge. She loudly grunts as she smells danger."++playerShotMessage :: Player -> Message+playerShotMessage target = publicMessage $ T.unwords+    [ targetName, "the", targetRole, "slumps down to the ground, hands clutching at their chest"+    , "while blood slips between their fingers and pools around them."+    ]+    where+        targetName = target ^. name+        targetRole = target ^. role . Role.name++playerDivinedMessage :: Text -> Player -> Message+playerDivinedMessage to player = privateMessage to $ T.concat+    [playerName, " is ", article playerRole, " ", playerRole ^. Role.name, "."]+    where+        playerName = player ^. name+        playerRole = player ^. role++orphanJoinedPackMessages :: Text -> [Text] -> [Message]+orphanJoinedPackMessages orphansName werewolfNames =+    privateMessage orphansName (T.unwords+        [ "The death of your role model is distressing. Without second thought you abandon the"+        , "Villagers and run off into the woods, towards a new home. As you arrive you see the"+        , tryPlural (length werewolfNames) "face", "of"+        , concatList werewolfNames, "waiting for you."+        ])+    : groupMessages werewolfNames (T.unwords+        [ orphansName, "the Orphan scampers off into the woods. Without their role model they have"+        , "abandoned the village and are in search of a new home. You welcome them into your pack."+        ])++playerCannotProtectSamePlayerTwiceInARowMessage :: Text -> Message+playerCannotProtectSamePlayerTwiceInARowMessage to =+    privateMessage to "You cannot protect the same player twice in a row!"++scapegoatChoseAllowedVotersMessage :: [Text] -> Message+scapegoatChoseAllowedVotersMessage allowedVoters = publicMessage $ T.unwords+    [ "On the next day only", concatList allowedVoters, "shall be allowed to vote. The Town Crier,"+    , "realising how foolish it was to kill the Scapegoat, grants them this wish."+    ]++playerMustChooseAtLeastOneTargetMessage :: Text -> Message+playerMustChooseAtLeastOneTargetMessage to =+    privateMessage to "You must choose at least 1 target!"++playerCannotChooseJesterMessage :: Text -> Message+playerCannotChooseJesterMessage to =+    privateMessage to "You cannot choose the Jester!"++playerSeenMessage :: Text -> Player -> Message+playerSeenMessage to player = privateMessage to $ T.concat+    [playerName, " is aligned with ", article, humanise allegiance', "."]+    where+        playerName  = player ^. name+        allegiance'+            | is alphaWolf player   = Villagers+            | is lycan player       = Werewolves+            | otherwise             = player ^. role . allegiance+        article     = if allegiance' == NoOne then "" else "the "++villageDrunkJoinedVillageMessage :: Text -> Message+villageDrunkJoinedVillageMessage to = privateMessage to $ T.unwords+    [ "Somehow you managed to avoid getting killed while in your drunken stupor. Thank God for"+    , "that, maybe now you can actually help the village."+    ]++villageDrunkJoinedPackMessages :: Text -> [Text] -> [Message]+villageDrunkJoinedPackMessages villageDrunksName werewolfNames =+    privateMessage villageDrunksName (T.concat+        [ "As you start to feel sober for the first time in days a new thirst begins to take hold."+        , " The bloodthirst starts to bring back memories, memories of your true home with "+        , concatList werewolfNames, "."+        ])+    : groupMessages werewolfNames (T.unwords+        [ villageDrunksName+        , "the Village Drunk has finally sobered up and remembered their true home."+        ])++playerMadeLynchVoteMessage :: Maybe Text -> Text -> Text -> Message+playerMadeLynchVoteMessage mTo voterName targetName = Message mTo $ T.concat+    [ voterName, " voted to lynch ", targetName, "."+    ]++playerRescindedVoteMessage :: Text -> Text -> Message+playerRescindedVoteMessage to voterName = privateMessage to $ T.unwords+    [ voterName, "rescinded their vote."+    ]++playerLynchedMessage :: Player -> Message+playerLynchedMessage player+    | is simpleWerewolf player+        || is alphaWolf player  = publicMessage $ T.concat+        [ playerName, " is tied up to a pyre and set alight. As they scream their body starts to "+        , "contort and writhe, transforming into ", article playerRole, " "+        , playerRole ^. Role.name, ".", " Thankfully they go limp before breaking free of their "+        , "restraints."+        ]+    | otherwise                 = publicMessage $ T.concat+        [ playerName, " is tied up to a pyre and set alight. Eventually the screams start to die "+        , "and with their last breath, they reveal themselves as ", article playerRole, " "+        , playerRole ^. Role.name, "."+        ]+    where+        playerName = player ^. name+        playerRole = player ^. role++noPlayerLynchedMessage :: Message+noPlayerLynchedMessage = publicMessage $ T.unwords+    [ "Daylight is wasted as the townsfolk squabble over whom to tie up. Looks like no-one is being"+    , "burned this day."+    ]++jesterLynchedMessage :: Text -> Message+jesterLynchedMessage name = publicMessage $ T.concat+    [ "Just as the townsfolk tie ", name, " up to the pyre, a voice in the crowd yells out."+    , " \"We can't burn ", name, "! He's the joke of the town!\" "+    , name, " the Jester is quickly untied and apologised to."+    ]++scapegoatLynchedMessage :: Text -> Message+scapegoatLynchedMessage name = publicMessage $ T.unwords+    [ "The townsfolk squabble over whom to tie up. Just as they are about to call it a day"+    , "they notice that", name, "has been acting awfully suspicious."+    , "Not wanting to take any chances,", name, "is promptly tied to a pyre and burned alive."+    ]++playerHasAlreadyVotedMessage :: Text -> Message+playerHasAlreadyVotedMessage to = privateMessage to "You've already voted!"++playerHasNotVotedMessage :: Text -> Message+playerHasNotVotedMessage to = privateMessage to "You haven't voted yet!"++playerMadeDevourVoteMessage :: Text -> Text -> Text -> Message+playerMadeDevourVoteMessage to voterName targetName = privateMessage to $ T.concat+    [ voterName, " voted to devour ", targetName, "."+    ]++playerDevouredMessage :: Player -> Message+playerDevouredMessage player = publicMessage $ T.concat+    [ "As you open them you notice a door broken down and "+    , playerName, "'s guts half devoured and spilling out over the cobblestones."+    , " From the look of their personal effects, you deduce they were "+    , article playerRole, " ", playerRole ^. Role.name, "."+    ]+    where+        playerName = player ^. name+        playerRole = player ^. role++playerTurnedToStoneMessage :: Player -> Message+playerTurnedToStoneMessage player = publicMessage $ T.unwords+    [ "Next to them you see a stone", playerRole, "statue, cold to the touch.", playerName+    , "must have looked into the eyes of the Medusa at the very end."+    ]+    where+        playerName = player ^. name+        playerRole = player ^. role . Role.name++noPlayerDevouredMessage :: Message+noPlayerDevouredMessage = publicMessage $ T.unwords+    [ "Surprisingly you see everyone present at the town square."+    , "Perhaps the Werewolves have left Fougères?"+    ]++playerCannotDevourAnotherWerewolfMessage :: Text -> Message+playerCannotDevourAnotherWerewolfMessage to = privateMessage to "You cannot devour another Werewolf!"++playerCannotChooseSelfMessage :: Text -> Message+playerCannotChooseSelfMessage to = privateMessage to "You cannot choose yourself!"++playerPoisonedMessage :: Player -> Message+playerPoisonedMessage player = publicMessage $ T.unwords+    [ "Upon further discovery, it looks like the Witch struck in the night."+    , playerName, "the", playerRole, "is hanging over the side of their bed, poisoned."+    ]+    where+        playerName = player ^. name+        playerRole = player ^. role . Role.name++playerHasAlreadyHealedMessage :: Text -> Message+playerHasAlreadyHealedMessage to = privateMessage to "You've already healed someone!"++playerHasAlreadyPoisonedMessage :: Text -> Message+playerHasAlreadyPoisonedMessage to = privateMessage to "You've already poisoned someone!"++article :: Role -> Text+article role+    | role `elem` restrictedRoles   = "the"+    | otherwise                     = "a"++concatList :: [Text] -> Text+concatList []       = ""+concatList [word]   = word+concatList words    = T.unwords [T.intercalate ", " (init words), "and", last words]++conjugateToBe :: Int -> Text+conjugateToBe 1 = "is"+conjugateToBe _ = "are"++tryPlural :: Int -> Text -> Text+tryPlural 1 word = word+tryPlural _ word = T.snoc word 's'

@@ -0,0 +1,208 @@+{-|+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, removePlayer, setPlayerAllegiance, getRandomAllegiance,++    -- ** Searches+    findPlayerBy_, getAdjacentAlivePlayers, getFirstAdjacentAliveWerewolf, getPlayerVote,+    getAllowedVoters, getPendingVoters,++    -- ** Queries+    isGameOver, isHuntersTurn, isOraclesTurn, isOrphansTurn, isProtectorsTurn, isScapegoatsTurn,+    isSeersTurn, isSunrise, isVillagesTurn, isWerewolvesTurn, isWitchsTurn,+    hasAnyoneWon, hasFallenAngelWon, hasVillagersWon, hasWerewolvesWon,++    -- * Player++    -- ** Queries+    doesPlayerExist,+    isPlayerHunter, isPlayerJester, isPlayerOracle, isPlayerOrphan, isPlayerProtector,+    isPlayerScapegoat, isPlayerSeer, isPlayerWitch,+    isPlayerWerewolf,+    isPlayerAlive, isPlayerDead,+) where++import Control.Lens         hiding (isn't)+import Control.Lens.Extra+import Control.Monad.Extra+import Control.Monad.Random+import Control.Monad.State  hiding (state)+import Control.Monad.Writer++import           Data.List+import qualified Data.Map   as Map+import           Data.Maybe+import           Data.Text  (Text)++import           Game.Werewolf.Game     hiding (getAllowedVoters, getPendingVoters, hasAnyoneWon,+                                         hasFallenAngelWon, hasVillagersWon, hasWerewolvesWon)+import qualified Game.Werewolf.Game     as Game+import           Game.Werewolf.Messages+import           Game.Werewolf.Player+import           Game.Werewolf.Response+import           Game.Werewolf.Role     hiding (name)++import Prelude hiding (round)++killPlayer :: (MonadState Game m, MonadWriter [Message] m) => Text -> m ()+killPlayer name = do+    tell [playerKilledMessage name]++    players . traverse . named name . state .= Dead++removePlayer :: (MonadState Game m, MonadWriter [Message] m) => Text -> m ()+removePlayer name' = do+    killPlayer name'++    votes %= Map.delete name'++    player <- findPlayerBy_ name name'++    when (is orphan player)         $ roleModel .= Nothing+    when (is protector player)      $ do+        protect         .= Nothing+        priorProtect    .= Nothing+    when (is seer player)           $ see .= Nothing+    when (is witch player)          $ do+        healUsed    .= False+        poison      .= Nothing+        poisonUsed  .= False++-- | Fudges the player's allegiance. This function is useful for roles such as the Orphan where+--   they align themselves differently given some trigger.+setPlayerAllegiance :: MonadState Game m => Text -> Allegiance -> m ()+setPlayerAllegiance name allegiance' = modify $ players . traverse . named name . role . allegiance .~ allegiance'++-- | Get a random allegiance (either Villagers or Werewolves).+getRandomAllegiance :: MonadRandom m => m Allegiance+getRandomAllegiance = fromList [(Villagers, 0.5), (Werewolves, 0.5)]++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++getFirstAdjacentAliveWerewolf :: MonadState Game m => Text -> m (Maybe Player)+getFirstAdjacentAliveWerewolf name = do+    players'            <- toListOf (players . traverse) <$> get+    let index           = fromJust $ elemIndex name (players' ^.. names)+    let filteredPlayers = dropWhile (isn't werewolf) (drop index (players' ++ players') ^.. traverse . alive)++    return $ listToMaybe filteredPlayers++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++isGameOver :: MonadState Game m => m Bool+isGameOver = hasuse $ stage . _GameOver++isHuntersTurn :: MonadState Game m => m Bool+isHuntersTurn = orM+    [ hasuse $ stage . _HuntersTurn1+    , hasuse $ stage . _HuntersTurn2+    ]++isOraclesTurn :: MonadState Game m => m Bool+isOraclesTurn = hasuse $ stage . _OraclesTurn++isOrphansTurn :: MonadState Game m => m Bool+isOrphansTurn = hasuse $ stage . _OrphansTurn++isProtectorsTurn :: MonadState Game m => m Bool+isProtectorsTurn = hasuse $ stage . _ProtectorsTurn++isScapegoatsTurn :: MonadState Game m => m Bool+isScapegoatsTurn = hasuse $ stage . _ScapegoatsTurn++isSeersTurn :: MonadState Game m => m Bool+isSeersTurn = hasuse $ stage . _SeersTurn++isSunrise :: MonadState Game m => m Bool+isSunrise = hasuse $ stage . _Sunrise++isVillagesTurn :: MonadState Game m => m Bool+isVillagesTurn = hasuse $ stage . _VillagesTurn++isWerewolvesTurn :: MonadState Game m => m Bool+isWerewolvesTurn = hasuse $ stage . _WerewolvesTurn++isWitchsTurn :: MonadState Game m => m Bool+isWitchsTurn = hasuse $ stage . _WitchsTurn++hasAnyoneWon :: MonadState Game m => m Bool+hasAnyoneWon = gets Game.hasAnyoneWon++hasFallenAngelWon :: MonadState Game m => m Bool+hasFallenAngelWon = gets Game.hasFallenAngelWon++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 = hasuse $ players . traverse . named name++isPlayerHunter :: MonadState Game m => Text -> m Bool+isPlayerHunter name' = is hunter <$> findPlayerBy_ name name'++isPlayerJester :: MonadState Game m => Text -> m Bool+isPlayerJester name' = is jester <$> findPlayerBy_ name name'++isPlayerOracle :: MonadState Game m => Text -> m Bool+isPlayerOracle name' = is oracle <$> findPlayerBy_ name name'++isPlayerOrphan :: MonadState Game m => Text -> m Bool+isPlayerOrphan name' = is orphan <$> findPlayerBy_ name name'++isPlayerProtector :: MonadState Game m => Text -> m Bool+isPlayerProtector name' = is protector <$> 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'++isPlayerWitch :: MonadState Game m => Text -> m Bool+isPlayerWitch name' = is witch <$> 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'

@@ -23,6 +23,7 @@ import qualified Werewolf.Command.Boot      as Boot import qualified Werewolf.Command.Choose    as Choose import qualified Werewolf.Command.Circle    as Circle+import qualified Werewolf.Command.Divine    as Divine import qualified Werewolf.Command.End       as End import qualified Werewolf.Command.Heal      as Heal import qualified Werewolf.Command.Help      as Help@@ -35,6 +36,7 @@ import qualified Werewolf.Command.See       as See import qualified Werewolf.Command.Start     as Start import qualified Werewolf.Command.Status    as Status+import qualified Werewolf.Command.Unvote    as Unvote import qualified Werewolf.Command.Version   as Version import qualified Werewolf.Command.Vote      as Vote import           Werewolf.Options@@ -58,6 +60,7 @@     Choose options                      -> Choose.handle callerName tag options     Boot options                        -> Boot.handle callerName tag options     Circle options                      -> Circle.handle callerName tag options+    Divine options                      -> Divine.handle callerName tag options     End options                         -> End.handle callerName tag options     Heal                                -> Heal.handle callerName tag     Help options                        -> Help.handle callerName tag options@@ -70,5 +73,6 @@     See options                         -> See.handle callerName tag options     Start options                       -> Start.handle callerName tag options     Status                              -> Status.handle callerName tag+    Unvote                              -> Unvote.handle callerName tag     Version                             -> Version.handle callerName     Vote options                        -> Vote.handle callerName tag options

@@ -26,10 +26,12 @@ import Data.Text (Text)  import Game.Werewolf+import Game.Werewolf.Command import Game.Werewolf.Command.Global+import Game.Werewolf.Engine -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  data Options = Options     { argTarget :: Text

@@ -29,12 +29,15 @@ import Data.Text (Text)  import Game.Werewolf+import Game.Werewolf.Command import Game.Werewolf.Command.Hunter    as Hunter import Game.Werewolf.Command.Orphan    as Orphan import Game.Werewolf.Command.Scapegoat as Scapegoat+import Game.Werewolf.Engine+import Game.Werewolf.Messages -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  data Options = Options     { args :: [Text]

@@ -25,10 +25,11 @@ import Data.Text (Text)  import Game.Werewolf+import Game.Werewolf.Command import Game.Werewolf.Command.Status -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  data Options = Options     { optIncludeDead :: Bool

@@ -0,0 +1,53 @@+{-|+Module      : Werewolf.Command.Divine+Description : Options and handler for the divine subcommand.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Options and handler for the divine subcommand.+-}++module Werewolf.Command.Divine (+    -- * Options+    Options(..),++    -- * Handle+    handle,+) where++import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.Random+import Control.Monad.State+import Control.Monad.Writer++import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Command+import Game.Werewolf.Command.Oracle+import Game.Werewolf.Engine++import Werewolf.Messages+import Werewolf.System++data Options = Options+    { argTarget :: Text+    } deriving (Eq, Show)++handle :: (MonadIO m, MonadRandom m) => Text -> Text -> Options -> m ()+handle callerName tag (Options targetName) = do+    unlessM (doesGameExist tag) $ exitWith failure+        { messages = [noGameRunningMessage callerName]+        }++    game <- readGame tag++    let command = divineCommand callerName targetName++    result <- runExceptT . runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game+    case result of+        Left errorMessages      -> exitWith failure { messages = errorMessages }+        Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = messages }

@@ -19,6 +19,7 @@     handle, ) where +import Control.Lens import Control.Monad.Extra import Control.Monad.IO.Class @@ -26,9 +27,10 @@ import qualified Data.Text as T  import Game.Werewolf+import Game.Werewolf.Messages -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  data Options = Options     { optForce :: Bool@@ -41,11 +43,12 @@     unless force $ do         game <- readGame tag -        unless (doesPlayerExist callerName game) $+        unless (has (players . traverse . named callerName) game) $             exitWith failure { messages = [playerCannotDoThatMessage callerName] }      deleteGame tag      exitWith success { messages = [gameEndedMessage] }     where+        -- TODO (hjw): move this to Messages         gameEndedMessage = publicMessage $ T.concat ["Game ended by ", callerName, "."]

@@ -25,10 +25,12 @@ import Data.Text (Text)  import Game.Werewolf+import Game.Werewolf.Command import Game.Werewolf.Command.Witch+import Game.Werewolf.Engine -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  handle :: (MonadIO m, MonadRandom m) => Text -> Text -> m () handle callerName tag = do

@@ -20,7 +20,6 @@ ) where  import Control.Lens-import Control.Lens.Extra import Control.Monad.Extra import Control.Monad.IO.Class @@ -29,10 +28,10 @@ import           Data.Text     (Text) import qualified Data.Text     as T -import           Game.Werewolf      hiding (Command)+import           Game.Werewolf import qualified Game.Werewolf.Role as Role -import Werewolf.Game+import Werewolf.System  data Options = Options     { argCommand :: Maybe Command@@ -87,11 +86,16 @@       ]     , [ "Standard commands:"       , "- `vote PLAYER`"+      , "- `unvote`"       ]     , whenPlayerHasRole callerName mGame hunterRole       [ "Hunter commands:"       , "- `choose PLAYER`"       ]+    , whenPlayerHasRole callerName mGame oracleRole+      [ "Oracle commands:"+      , "- `divine PLAYER`"+      ]     , whenPlayerHasRole callerName mGame orphanRole       [ "Orphan commands:"       , "- `choose PLAYER`"@@ -142,13 +146,7 @@         ]       ]     , filter (/= "")-      [ T.concat-        [ "A game begins at night and follows a standard cycle."-        , whenRoleInPlay mGame fallenAngelRole-            " (N.B., when the Fallen Angel is in play the game begins with the village vote.)"-        ]-      , whenRoleInPlay mGame fallenAngelRole-        "- (When the Fallen Angel is in play) the village votes to lynch a suspect."+      [ "A game begins at night and follows a standard cycle."       , "- The village falls asleep."       , whenRoleInPlay mGame orphanRole         "- (First round only) the Orphan wakes up and chooses a role model."@@ -156,6 +154,8 @@         "- (Third round only) the Village Drunk sobers up and remembers their allegiance."       , whenRoleInPlay mGame seerRole         "- The Seer wakes up and sees someone's allegiance."+      , whenRoleInPlay mGame oracleRole+        "- The Oracle wakes up and divines someone's role."       , whenRoleInPlay mGame protectorRole         "- The Protector wakes up and protects someone."       , "- The Werewolves wake up and vote to devour a victim."@@ -201,13 +201,13 @@     ]  whenPlayerHasRole :: Monoid m => Text -> Maybe Game -> Role -> m -> m-whenPlayerHasRole _ Nothing _ m                         = m+whenPlayerHasRole _ Nothing _ m                 = m whenPlayerHasRole callerName (Just game) role' m-    | hasn't (players . names . only callerName) game   = mempty-    | hasn't (role . only role') player                 = mempty-    | otherwise                                         = m+    | hasn't (players . traverse . named callerName) game  = mempty+    | hasn't (role . only role') player         = mempty+    | otherwise                                 = m      where-        player = game ^?! players . traverse . filteredBy name callerName+        player = game ^?! players . traverse . named callerName  ifRoleInPlay :: Maybe Game -> Role -> a -> a -> a ifRoleInPlay Nothing _ true _               = true

@@ -23,10 +23,12 @@ import Data.Text (Text)  import Game.Werewolf+import Game.Werewolf.Command import Game.Werewolf.Command.Witch+import Game.Werewolf.Engine -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  handle :: (MonadIO m, MonadRandom m) => Text -> Text -> m () handle callerName tag = do

@@ -22,10 +22,11 @@ import Data.Text (Text)  import Game.Werewolf+import Game.Werewolf.Command import Game.Werewolf.Command.Status -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  handle :: MonadIO m => Text -> Text -> m () handle callerName tag = do

@@ -26,10 +26,12 @@ import Data.Text (Text)  import Game.Werewolf+import Game.Werewolf.Command import Game.Werewolf.Command.Witch+import Game.Werewolf.Engine -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  data Options = Options     { argTarget :: Text

@@ -26,10 +26,12 @@ import Data.Text (Text)  import Game.Werewolf+import Game.Werewolf.Command import Game.Werewolf.Command.Protector+import Game.Werewolf.Engine -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  data Options = Options     { argTarget :: Text

@@ -23,10 +23,12 @@ import Data.Text (Text)  import Game.Werewolf+import Game.Werewolf.Command import Game.Werewolf.Command.Global+import Game.Werewolf.Engine -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  handle :: (MonadIO m, MonadRandom m) => Text -> Text -> m () handle callerName tag = do

@@ -26,10 +26,12 @@ import Data.Text (Text)  import Game.Werewolf+import Game.Werewolf.Command import Game.Werewolf.Command.Seer+import Game.Werewolf.Engine -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  data Options = Options     { argTarget :: Text

@@ -32,13 +32,14 @@ import           Data.Text (Text) import qualified Data.Text as T -import Game.Werewolf      hiding (name)-import Game.Werewolf.Role+import Game.Werewolf+import Game.Werewolf.Engine+import Game.Werewolf.Role   as Role  import System.Random.Shuffle -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  data Options = Options     { optExtraRoles  :: ExtraRoles@@ -86,6 +87,26 @@     Nothing     -> throwError [roleDoesNotExistMessage callerName roleName]  findByName :: Text -> Maybe Role-findByName name' = restrictedRoles ^? traverse . filtered ((sanitise name' ==) . T.toLower . sanitise . view name)+findByName name' = restrictedRoles ^? traverse . filtered ((sanitise name' ==) . T.toLower . sanitise . view Role.name)     where         sanitise = T.replace " " "-"++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++createPlayers :: [Text] -> [Role] -> [Player]+createPlayers = zipWith newPlayer

@@ -22,10 +22,11 @@ import Data.Text (Text)  import Game.Werewolf+import Game.Werewolf.Command import Game.Werewolf.Command.Status -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  handle :: MonadIO m => Text -> Text -> m () handle callerName tag = do

@@ -0,0 +1,54 @@+{-|+Module      : Werewolf.Command.Unvote+Description : Handler for the unvote subcommand.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++Handler for the unvote subcommand.+-}++module Werewolf.Command.Unvote (+    -- * Handle+    handle,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.Random+import Control.Monad.State+import Control.Monad.Writer++import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Command+import Game.Werewolf.Command.Villager as Villager+import Game.Werewolf.Command.Werewolf as Werewolf+import Game.Werewolf.Engine+import Game.Werewolf.Messages++import Werewolf.Messages+import Werewolf.System++handle :: (MonadIO m, MonadRandom m) => Text -> Text -> m ()+handle callerName tag = do+    unlessM (doesGameExist tag) $ exitWith failure+        { messages = [noGameRunningMessage callerName]+        }++    game <- readGame tag++    command <- case game ^. stage of+            VillagesTurn    -> return $ Villager.unvoteCommand callerName+            WerewolvesTurn  -> return $ Werewolf.unvoteCommand callerName+            _               -> exitWith failure+                { messages = [playerCannotDoThatRightNowMessage callerName]+                }++    result <- runExceptT . runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game+    case result of+        Left errorMessages      -> exitWith failure { messages = errorMessages }+        Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = messages }

@@ -27,11 +27,14 @@ import Data.Text (Text)  import Game.Werewolf+import Game.Werewolf.Command import Game.Werewolf.Command.Villager as Villager import Game.Werewolf.Command.Werewolf as Werewolf+import Game.Werewolf.Engine+import Game.Werewolf.Messages -import Werewolf.Game import Werewolf.Messages+import Werewolf.System  data Options = Options     { argTarget :: Text

@@ -1,78 +0,0 @@-{-|-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-    filePath, readGame, writeGame, deleteGame, writeOrDeleteGame, doesGameExist,-) where--import Control.Lens         hiding (cons)-import Control.Monad.Except--import           Data.List.Extra-import           Data.Text       (Text)-import qualified Data.Text       as T--import Game.Werewolf--import Prelude hiding (round)--import System.Directory-import System.FilePath--createPlayers :: [Text] -> [Role] -> [Player]-createPlayers = zipWith newPlayer--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--filePath :: MonadIO m => Text -> m FilePath-filePath tag = (</> ".werewolf" </> T.unpack tag) <$> liftIO getHomeDirectory--readGame :: MonadIO m => Text -> m Game-readGame tag = liftIO . fmap read $ filePath tag >>= readFile--writeGame :: MonadIO m => Text -> Game -> m ()-writeGame tag game = liftIO $ filePath tag >>= \tag -> do-    createDirectoryIfMissing True (dropFileName tag)--    writeFile tag (show game)--deleteGame :: MonadIO m => Text -> m ()-deleteGame tag = liftIO $ filePath tag >>= removeFile--writeOrDeleteGame :: MonadIO m => Text -> Game -> m ()-writeOrDeleteGame tag game-    | has (stage . _GameOver) game  = deleteGame tag-    | otherwise                     = writeGame tag game--doesGameExist :: MonadIO m => Text -> m Bool-doesGameExist tag = liftIO $ filePath tag >>= doesFileExist

@@ -17,7 +17,6 @@      -- ** Error messages     noGameRunningMessage, gameAlreadyRunningMessage, roleDoesNotExistMessage,-    playerCannotDoThatMessage, playerCannotDoThatRightNowMessage, ) where  import           Data.Text    (Text)@@ -38,9 +37,3 @@  roleDoesNotExistMessage :: Text -> Text -> Message roleDoesNotExistMessage to name = privateMessage to $ T.unwords ["Role", name, "does not exist."]--playerCannotDoThatMessage :: Text -> Message-playerCannotDoThatMessage to = privateMessage to "You cannot do that!"--playerCannotDoThatRightNowMessage :: Text -> Message-playerCannotDoThatRightNowMessage to = privateMessage to "You cannot do that right now!"

@@ -26,6 +26,7 @@ import qualified Werewolf.Command.Boot      as Boot import qualified Werewolf.Command.Choose    as Choose import qualified Werewolf.Command.Circle    as Circle+import qualified Werewolf.Command.Divine    as Divine import qualified Werewolf.Command.End       as End import qualified Werewolf.Command.Help      as Help import qualified Werewolf.Command.Interpret as Interpret@@ -48,6 +49,7 @@     = Boot Boot.Options     | Choose Choose.Options     | Circle Circle.Options+    | Divine Divine.Options     | End End.Options     | Heal     | Help Help.Options@@ -60,6 +62,7 @@     | See See.Options     | Start Start.Options     | Status+    | Unvote     | Version     | Vote Vote.Options     deriving (Eq, Show)@@ -96,6 +99,7 @@         [ command "boot"        $ info (helper <*> boot)        (fullDesc <> progDesc "Vote to boot a player")         , command "choose"      $ info (helper <*> choose)      (fullDesc <> progDesc "Choose an allegiance or player(s)")         , command "circle"      $ info (helper <*> circle)      (fullDesc <> progDesc "Get the game circle")+        , command "divine"      $ info (helper <*> divine)      (fullDesc <> progDesc "Divine a player's role")         , command "end"         $ info (helper <*> end)         (fullDesc <> progDesc "End the current game")         , command "heal"        $ info (helper <*> heal)        (fullDesc <> progDesc "Heal the devoured player")         , command "help"        $ info (helper <*> help_)       (fullDesc <> progDesc "Help documents")@@ -108,6 +112,7 @@         , command "see"         $ info (helper <*> see)         (fullDesc <> progDesc "See a player's allegiance")         , command "start"       $ info (helper <*> start)       (fullDesc <> progDesc "Start a new game")         , command "status"      $ info (helper <*> status)      (fullDesc <> progDesc "Get the status of the current game")+        , command "unvote"      $ info (helper <*> unvote)      (fullDesc <> progDesc "Rescind a vote")         , command "version"     $ info (helper <*> version)     (fullDesc <> progDesc "Show this engine's version")         , command "vote"        $ info (helper <*> vote)        (fullDesc <> progDesc "Vote against a player")         ])@@ -125,6 +130,9 @@         , help "Include dead players"         ]) +divine :: Parser Command+divine = Divine . Divine.Options <$> playerArgument+ end :: Parser Command end = End . End.Options     <$> switch (mconcat@@ -189,6 +197,9 @@  status :: Parser Command status = pure Status++unvote :: Parser Command+unvote = pure Unvote  version :: Parser Command version = pure Version

@@ -0,0 +1,82 @@+{-|+Module      : Werewolf.System+Description : System functions for working with a game state file.++Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com++This module defines a few system functions for working with a game state file.+-}++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}++module Werewolf.System (+    -- * Game++    -- ** Creating anew+    startGame,++    -- ** Working with an existing+    filePath, readGame, writeGame, deleteGame, writeOrDeleteGame, doesGameExist,+) where++import Control.Lens         hiding (cons)+import Control.Lens.Extra+import Control.Monad.Except+import Control.Monad.Writer++import           Data.List+import           Data.Text (Text)+import qualified Data.Text as T++import Game.Werewolf+import Game.Werewolf.Messages+import Game.Werewolf.Role     as Role++import Prelude hiding (round)++import System.Directory+import System.FilePath++startGame :: (MonadError [Message] m, MonadWriter [Message] m) => Text -> [Player] -> m Game+startGame callerName players = do+    -- TODO (hjw): move the messages to Messages+    when (playerNames /= nub playerNames)   $ throwError [privateMessage callerName "Player names must be unique."]+    when (length players < 7)               $ throwError [privateMessage callerName "Must have at least 7 players."]+    forM_ restrictedRoles $ \role' ->+        when (length (players ^.. traverse . filteredBy role role') > 1) $+            throwError [privateMessage callerName $ T.concat ["Cannot have more than 1 ", role' ^. Role.name, "."]]++    let game = newGame players++    tell $ newGameMessages game++    return game+    where+        playerNames = players ^.. names++filePath :: MonadIO m => Text -> m FilePath+filePath tag = (</> ".werewolf" </> T.unpack tag) <$> liftIO getHomeDirectory++readGame :: MonadIO m => Text -> m Game+readGame tag = liftIO . fmap read $ filePath tag >>= readFile++writeGame :: MonadIO m => Text -> Game -> m ()+writeGame tag game = liftIO $ filePath tag >>= \tag -> do+    createDirectoryIfMissing True (dropFileName tag)++    writeFile tag (show game)++deleteGame :: MonadIO m => Text -> m ()+deleteGame tag = liftIO $ filePath tag >>= removeFile++writeOrDeleteGame :: MonadIO m => Text -> Game -> m ()+writeOrDeleteGame tag game+    | has (stage . _GameOver) game  = deleteGame tag+    | otherwise                     = writeGame tag game++doesGameExist :: MonadIO m => Text -> m Bool+doesGameExist tag = liftIO $ filePath tag >>= doesFileExist

@@ -13,13 +13,14 @@  module Control.Lens.Extra (     -- * Folds-    is, isn't,+    is, isn't, hasuse, hasn'tuse,      -- * Traversals     filteredBy, ) where  import Control.Lens hiding (isn't)+import Control.Monad.State  import Data.Monoid @@ -34,6 +35,18 @@ --   @'isn't' = 'hasn't'@ isn't :: Getting All s a -> s -> Bool isn't = hasn't++-- | Check to see if this 'Fold' or 'Traversal' matches 1 or more entries in the current state.+--+--   @'hasuse' = 'gets' . 'has'@+hasuse :: MonadState s m => Getting Any s a -> m Bool+hasuse = gets . has++-- | Check to see if this 'Fold' or 'Traversal' has no matches in the current state.+--+--   @'hasn'tuse' = 'gets' . 'hasn't'@+hasn'tuse :: MonadState s m => Getting All s a -> m Bool+hasn'tuse = gets . hasn't  -- | A companion to 'filtered' that, rather than using a predicate, filters on the given lens for -- matches.

@@ -8,8 +8,6 @@  Re-exports all of the public modules under /Game.Werewolf/. These are: -* "Game.Werewolf.Command"-* "Game.Werewolf.Engine" * "Game.Werewolf.Game" * "Game.Werewolf.Player" * "Game.Werewolf.Response"@@ -23,8 +21,6 @@     module Werewolf ) where -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

@@ -1,48 +0,0 @@-{-|-Module      : Game.Werewolf.Command-Description : Command data structure.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Command data structures.--}--{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE Rank2Types            #-}--module Game.Werewolf.Command (-    -- * Command-    Command(..),--    -- ** Instances-    noopCommand,--    -- ** Validation-    validatePlayer,-) where--import Control.Monad.Except-import Control.Monad.Extra-import Control.Monad.State  hiding (state)-import Control.Monad.Writer--import Data.Text (Text)--import Game.Werewolf.Game     hiding (doesPlayerExist, getPendingVoters, getVoteResult, killPlayer)-import Game.Werewolf.Messages-import Game.Werewolf.Response-import Game.Werewolf.Util--data Command = Command { apply :: forall m . (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => m () }--noopCommand :: Command-noopCommand = Command $ return ()--validatePlayer :: (MonadError [Message] m, MonadState Game m) => Text -> Text -> m ()-validatePlayer callerName name = do-    whenM isGameOver                $ throwError [gameIsOverMessage callerName]-    unlessM (doesPlayerExist name)  $ throwError [playerDoesNotExistMessage callerName name]-    whenM (isPlayerDead name)       $ throwError [if callerName == name then playerIsDeadMessage callerName else targetIsDeadMessage callerName name]

@@ -1,49 +0,0 @@-{-|-Module      : Game.Werewolf.Command.Global-Description : Global commands.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Global commands.--}--module Game.Werewolf.Command.Global (-    -- * Commands-    bootCommand, quitCommand,-) where--import Control.Lens-import Control.Monad.Except-import Control.Monad.Extra-import Control.Monad.Writer--import qualified Data.Map   as Map-import           Data.Maybe-import           Data.Text  (Text)--import Game.Werewolf-import Game.Werewolf.Messages-import Game.Werewolf.Util--bootCommand :: Text -> Text -> Command-bootCommand callerName targetName = Command $ do-    validatePlayer callerName callerName-    validatePlayer callerName targetName-    whenM (uses (boots . at targetName) $ elem callerName . fromMaybe []) $-        throwError [playerHasAlreadyVotedToBootMessage callerName targetName]--    boots %= Map.insertWith (++) targetName [callerName]--    tell [playerVotedToBootMessage callerName targetName]--quitCommand :: Text -> Command-quitCommand callerName = Command $ do-    validatePlayer callerName callerName--    caller <- findPlayerBy_ name callerName--    tell [playerQuitMessage caller]--    removePlayer callerName

@@ -1,41 +0,0 @@-{-|-Module      : Game.Werewolf.Command.Hunter-Description : Hunter commands.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Hunter commands.--}--module Game.Werewolf.Command.Hunter (-    -- * Commands-    chooseCommand,-) where--import Control.Lens-import Control.Monad.Except-import Control.Monad.Extra-import Control.Monad.Writer--import Data.Text (Text)--import Game.Werewolf          hiding (doesPlayerExist, killPlayer)-import Game.Werewolf.Messages-import Game.Werewolf.Util--chooseCommand :: Text -> Text -> Command-chooseCommand callerName targetName = Command $ do-    whenM isGameOver                        $ throwError [gameIsOverMessage callerName]-    unlessM (doesPlayerExist callerName)    $ throwError [playerDoesNotExistMessage callerName callerName]-    unlessM (isPlayerHunter callerName)     $ throwError [playerCannotDoThatMessage callerName]-    unlessM isHuntersTurn                   $ throwError [playerCannotDoThatRightNowMessage callerName]-    validatePlayer callerName targetName--    target <- findPlayerBy_ name targetName--    tell [playerShotMessage target]-    killPlayer targetName--    hunterRetaliated .= True

@@ -1,35 +0,0 @@-{-|-Module      : Game.Werewolf.Command.Orphan-Description : Orphan commands.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Orphan commands.--}--module Game.Werewolf.Command.Orphan (-    -- * Commands-    chooseCommand,-) where--import Control.Lens-import Control.Monad.Except-import Control.Monad.Extra--import Data.Text (Text)--import Game.Werewolf-import Game.Werewolf.Messages-import Game.Werewolf.Util--chooseCommand :: Text -> Text -> Command-chooseCommand callerName targetName = Command $ do-    validatePlayer callerName callerName-    unlessM (isPlayerOrphan callerName) $ throwError [playerCannotDoThatMessage callerName]-    unlessM isOrphansTurn               $ throwError [playerCannotDoThatRightNowMessage callerName]-    when (callerName == targetName)     $ throwError [playerCannotChooseSelfMessage callerName]-    validatePlayer callerName targetName--    roleModel .= Just targetName

@@ -1,37 +0,0 @@-{-|-Module      : Game.Werewolf.Command.Protector-Description : Protector commands.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Protector commands.--}--module Game.Werewolf.Command.Protector (-    -- * Commands-    protectCommand,-) where--import Control.Lens-import Control.Monad.Except-import Control.Monad.Extra-import Control.Monad.State  hiding (state)--import Data.Text (Text)--import Game.Werewolf-import Game.Werewolf.Messages-import Game.Werewolf.Util--protectCommand :: Text -> Text -> Command-protectCommand callerName targetName = Command $ do-    validatePlayer callerName callerName-    unlessM (isPlayerProtector callerName)                          $ throwError [playerCannotDoThatMessage callerName]-    unlessM isProtectorsTurn                                        $ throwError [playerCannotDoThatRightNowMessage callerName]-    validatePlayer callerName targetName-    whenM (has (priorProtect . traverse . only targetName) <$> get) $ throwError [playerCannotProtectSamePlayerTwiceInARowMessage callerName]--    priorProtect    .= Just targetName-    protect         .= Just targetName

@@ -1,40 +0,0 @@-{-|-Module      : Game.Werewolf.Command.Scapegoat-Description : Scapegoat commands.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Scapegoat commands.--}--module Game.Werewolf.Command.Scapegoat (-    -- * Commands-    chooseCommand,-) where--import Control.Lens-import Control.Monad.Except-import Control.Monad.Extra--import Data.Text (Text)--import Game.Werewolf          hiding (doesPlayerExist)-import Game.Werewolf.Messages-import Game.Werewolf.Util--chooseCommand :: Text -> [Text] -> Command-chooseCommand callerName targetNames = Command $ do-    whenM isGameOver                        $ throwError [gameIsOverMessage callerName]-    unlessM (doesPlayerExist callerName)    $ throwError [playerDoesNotExistMessage callerName callerName]-    unlessM (isPlayerScapegoat callerName)  $ throwError [playerCannotDoThatMessage callerName]-    unlessM isScapegoatsTurn                $ throwError [playerCannotDoThatRightNowMessage callerName]-    when (null targetNames)                 $ throwError [playerMustChooseAtLeastOneTargetMessage callerName]-    when (callerName `elem` targetNames)    $ throwError [playerCannotChooseSelfMessage callerName]-    forM_ targetNames $ validatePlayer callerName-    whenM (use jesterRevealed &&^ anyM isPlayerJester targetNames) $-        throwError [playerCannotChooseJesterMessage callerName]--    allowedVoters   .= targetNames-    scapegoatBlamed .= False

@@ -1,34 +0,0 @@-{-|-Module      : Game.Werewolf.Command.Seer-Description : Seer commands.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Seer commands.--}--module Game.Werewolf.Command.Seer (-    -- * Commands-    seeCommand,-) where--import Control.Lens-import Control.Monad.Except-import Control.Monad.Extra--import Data.Text (Text)--import Game.Werewolf-import Game.Werewolf.Messages-import Game.Werewolf.Util--seeCommand :: Text -> Text -> Command-seeCommand callerName targetName = Command $ do-    validatePlayer callerName callerName-    unlessM (isPlayerSeer callerName)       $ throwError [playerCannotDoThatMessage callerName]-    unlessM isSeersTurn                     $ throwError [playerCannotDoThatRightNowMessage callerName]-    validatePlayer callerName targetName--    see .= Just targetName

@@ -1,105 +0,0 @@-{-|-Module      : Game.Werewolf.Command.Status-Description : Status commands.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Status commands.--}--{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}--module Game.Werewolf.Command.Status (-    -- * Commands-    circleCommand, pingCommand, statusCommand,-) where--import Control.Lens-import Control.Monad.Extra-import Control.Monad.State  hiding (state)-import Control.Monad.Writer--import Data.List-import Data.Text (Text)--import           Game.Werewolf          hiding (doesPlayerExist, getPendingVoters)-import           Game.Werewolf.Messages-import qualified Game.Werewolf.Role     as Role-import           Game.Werewolf.Util--circleCommand :: Text -> Bool -> Command-circleCommand callerName includeDead = Command $ do-        players' <- toListOf (players . traverse . if includeDead then id else alive) <$> get--        tell [circleMessage callerName players']--pingCommand :: Text -> Command-pingCommand callerName = Command $ use stage >>= \stage' -> case stage' of-    FerinasGrunt        -> return ()-    GameOver            -> tell [gameIsOverMessage callerName]-    HuntersTurn1        -> pingRole hunterRole-    HuntersTurn2        -> pingRole hunterRole-    Lynching            -> return ()-    OrphansTurn         -> pingRole orphanRole-    ProtectorsTurn      -> pingRole protectorRole-    ScapegoatsTurn      -> pingRole scapegoatRole-    SeersTurn           -> pingRole seerRole-    Sunrise             -> return ()-    Sunset              -> return ()-    VillageDrunksTurn   -> pingRole villageDrunkRole-    VillagesTurn        -> pingVillagers-    WerewolvesTurn      -> pingWerewolves-    WitchsTurn          -> pingRole witchRole--pingRole :: (MonadState Game m, MonadWriter [Message] m) => Role -> m ()-pingRole role' = do-    player <- findPlayerBy_ role role'--    tell [pingRoleMessage $ role' ^. Role.name]-    tell [pingPlayerMessage $ player ^. name]--pingVillagers :: (MonadState Game m, MonadWriter [Message] m) => m ()-pingVillagers = do-    allowedVoterNames <- use allowedVoters-    pendingVoterNames <- toListOf names <$> getPendingVoters--    tell [waitingOnMessage Nothing $ allowedVoterNames `intersect` pendingVoterNames]-    tell $ map pingPlayerMessage (allowedVoterNames `intersect` pendingVoterNames)--pingWerewolves :: (MonadState Game m, MonadWriter [Message] m) => m ()-pingWerewolves = do-    pendingVoters <- getPendingVoters--    tell [pingRoleMessage "Werewolves"]-    tell $ map pingPlayerMessage (pendingVoters ^.. werewolves . name)--statusCommand :: Text -> Command-statusCommand callerName = Command $ use stage >>= \stage' -> case stage' of-    FerinasGrunt    -> return ()-    GameOver        -> tell [gameIsOverMessage callerName]-    Lynching        -> return ()-    Sunrise         -> return ()-    Sunset          -> return ()-    VillagesTurn    -> do-        allowedVoterNames <- use allowedVoters-        pendingVoterNames <- toListOf names <$> getPendingVoters--        tell . standardStatusMessages stage' =<< use players-        tell [waitingOnMessage (Just callerName) (allowedVoterNames `intersect` pendingVoterNames)]-    WerewolvesTurn  -> do-        pendingVoterNames <- toListOf (werewolves . name) <$> getPendingVoters--        tell . standardStatusMessages stage' =<< use players-        whenM (doesPlayerExist callerName &&^ isPlayerWerewolf callerName) $-            tell [waitingOnMessage (Just callerName) pendingVoterNames]-    _               -> tell . standardStatusMessages stage' =<< use players-    where-        standardStatusMessages stage players =-            currentStageMessages callerName stage ++-            [ rolesInGameMessage (Just callerName) (players ^.. roles)-            , playersInGameMessage callerName players-            ]

@@ -1,41 +0,0 @@-{-|-Module      : Game.Werewolf.Command.Villager-Description : Villager commands.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Villager commands.--}--module Game.Werewolf.Command.Villager (-    -- * Commands-    voteCommand,-) where--import Control.Lens-import Control.Monad.Except-import Control.Monad.Extra-import Control.Monad.Writer--import qualified Data.Map   as Map-import           Data.Maybe-import           Data.Text  (Text)--import Game.Werewolf-import Game.Werewolf.Messages-import Game.Werewolf.Util--voteCommand :: Text -> Text -> Command-voteCommand callerName targetName = Command $ do-    validatePlayer callerName callerName-    whenM (uses allowedVoters (callerName `notElem`))   $ throwError [playerCannotDoThatMessage callerName]-    unlessM isVillagesTurn                              $ throwError [playerCannotDoThatRightNowMessage callerName]-    whenM (isJust <$> getPlayerVote callerName)         $ throwError [playerHasAlreadyVotedMessage callerName]-    validatePlayer callerName targetName--    votes %= Map.insert callerName targetName--    whenJustM (preuse $ players . crookedSenators . alive) $ \crookedSenator ->-        tell [playerMadeLynchVoteMessage (Just $ crookedSenator ^. name) callerName targetName]

@@ -1,48 +0,0 @@-{-|-Module      : Game.Werewolf.Command.Werewolf-Description : Werewolf commands.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Werewolf commands.--}--module Game.Werewolf.Command.Werewolf (-    -- * Commands-    voteCommand,--    -- ** Validation-    validatePlayer,-) where--import Control.Lens-import Control.Monad.Except-import Control.Monad.Extra-import Control.Monad.State  hiding (state)-import Control.Monad.Writer--import           Data.List-import qualified Data.Map   as Map-import           Data.Maybe-import           Data.Text  (Text)--import Game.Werewolf-import Game.Werewolf.Messages-import Game.Werewolf.Util--voteCommand :: Text -> Text -> Command-voteCommand callerName targetName = Command $ do-    validatePlayer callerName 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]--    votes %= Map.insert callerName targetName--    aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get--    tell [playerMadeDevourVoteMessage werewolfName callerName targetName | werewolfName <- aliveWerewolfNames \\ [callerName]]

@@ -1,60 +0,0 @@-{-|-Module      : Game.Werewolf.Command.Witch-Description : Witch commands.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Witch commands.--}--{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module Game.Werewolf.Command.Witch (-    -- * Commands-    healCommand, passCommand, poisonCommand,-) where--import Control.Lens-import Control.Monad.Except-import Control.Monad.Extra-import Control.Monad.State  hiding (state)--import Data.Text (Text)--import Game.Werewolf-import Game.Werewolf.Messages-import Game.Werewolf.Util--healCommand :: Text -> Command-healCommand callerName = Command $ do-    validateCommand callerName-    whenM (use healUsed)                                        $ throwError [playerHasAlreadyHealedMessage callerName]-    whenM (hasn't (events . traverse . _DevourEvent) <$> get)   $ throwError [playerCannotDoThatRightNowMessage callerName]--    heal        .= True-    healUsed    .= True--passCommand :: Text -> Command-passCommand callerName = Command $ do-    validateCommand callerName--    passed .= True--poisonCommand :: Text -> Text -> Command-poisonCommand callerName targetName = Command $ do-    validateCommand callerName-    whenM (use poisonUsed)                                                      $ throwError [playerHasAlreadyPoisonedMessage callerName]-    validatePlayer callerName targetName-    whenM (has (events . traverse . _DevourEvent . only targetName) <$> get)    $ throwError [playerCannotDoThatMessage callerName]--    poison      .= Just targetName-    poisonUsed  .= True--validateCommand :: (MonadError [Message] m, MonadState Game m) => Text -> m ()-validateCommand callerName = do-    validatePlayer callerName callerName-    unlessM (isPlayerWitch callerName)  $ throwError [playerCannotDoThatMessage callerName]-    unlessM isWitchsTurn                $ throwError [playerCannotDoThatRightNowMessage callerName]

@@ -1,272 +0,0 @@-{-|-Module      : Game.Werewolf.Engine-Description : Engine functions.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Engine functions.--}--{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}--module Game.Werewolf.Engine (-    -- * Loop-    checkStage, checkGameOver,--    -- * Game-    startGame,-) where--import Control.Lens         hiding (cons, isn't)-import Control.Lens.Extra-import Control.Monad.Except-import Control.Monad.Extra-import Control.Monad.Random-import Control.Monad.State-import Control.Monad.Writer--import           Data.List.Extra-import qualified Data.Map        as Map-import           Data.Maybe-import           Data.Text       (Text)-import qualified Data.Text       as T--import           Game.Werewolf.Game     hiding (doesPlayerExist, getAllowedVoters, getPendingVoters,-                                         getVoteResult, hasAnyoneWon, hasFallenAngelWon,-                                         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)--checkStage :: (MonadRandom m, MonadState Game m, MonadWriter [Message] m) => m ()-checkStage = do-    game <- get-    checkBoots >> checkStage' >> checkEvents-    game' <- get--    when (game /= game') checkStage--checkBoots :: (MonadState Game m, MonadWriter [Message] m) => m ()-checkBoots = do-    alivePlayerCount <- length . toListOf (players . traverse . alive) <$> get--    booteeNames <- uses boots $ Map.keys . Map.filter (\voters -> length voters > alivePlayerCount `div` 2)-    bootees     <- mapM (findPlayerBy_ name) booteeNames--    forM_ (filter (is alive) bootees) $ \bootee -> do-        tell [playerBootedMessage bootee]--        removePlayer (bootee ^. name)--checkStage' :: (MonadRandom m, MonadState Game m, MonadWriter [Message] m) => m ()-checkStage' = use stage >>= \stage' -> case stage' of-    FerinasGrunt -> do-        druid       <- findPlayerBy_ role druidRole-        players'    <- filter (isn't alphaWolf) <$> getAdjacentAlivePlayers (druid ^. name)--        when (has werewolves players' || has lycans players') $ tell [ferinaGruntsMessage]--        advanceStage--    GameOver -> return ()--    HuntersTurn1 -> whenM (use hunterRetaliated) advanceStage--    HuntersTurn2 -> whenM (use hunterRetaliated) advanceStage--    Lynching -> do-        getVoteResult >>= lynchVotees--        allVoters       <- ifM (use jesterRevealed)-            (uses players $ filter (isn't jester))-            (use players)-        allowedVoters   .= allVoters ^.. traverse . alive . name--        votes .= Map.empty--        advanceStage--    OrphansTurn -> do-        whenM (has (players . orphans . dead) <$> get) advanceStage--        whenM (isJust <$> use roleModel) advanceStage--    ProtectorsTurn -> do-        whenM (has (players . protectors . dead) <$> get) advanceStage--        whenM (isJust <$> use protect) advanceStage--    ScapegoatsTurn -> unlessM (use scapegoatBlamed) $ do-        allowedVoters' <- use allowedVoters-        tell [scapegoatChoseAllowedVotersMessage allowedVoters']--        advanceStage--    SeersTurn -> do-        whenM (has (players . seers . dead) <$> get) advanceStage--        whenM (isJust <$> use see) advanceStage--    Sunrise -> do-        round += 1--        whenJustM (preuse $ players . fallenAngels . alive) $ \fallenAngel ->-            unless (is villager fallenAngel) $ do-                tell [fallenAngelJoinedVillagersMessage]--                setPlayerAllegiance (fallenAngel ^. name) Villagers--        whenJustM (preuse $ players . seers . alive) $ \seer -> do-            target <- use see >>= findPlayerBy_ name . fromJust--            when (is alive target) $ tell [playerSeenMessage (seer ^. name) target]--        see .= Nothing--        advanceStage--    Sunset -> do-        whenJustM (use roleModel) $ \roleModelsName -> do-            orphan <- findPlayerBy_ role orphanRole--            whenM (isPlayerDead roleModelsName &&^ return (is alive orphan) &&^ return (is villager orphan)) $ do-                aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get--                setPlayerAllegiance (orphan ^. name) Werewolves--                tell $ orphanJoinedPackMessages (orphan ^. name) aliveWerewolfNames--        advanceStage--    VillageDrunksTurn -> do-        aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get--        randomAllegiance <- getRandomAllegiance-        players . villageDrunks . role . allegiance .= randomAllegiance--        villageDrunk <- findPlayerBy_ role villageDrunkRole--        if is villager villageDrunk-            then tell [villageDrunkJoinedVillageMessage $ villageDrunk ^. name]-            else tell $ villageDrunkJoinedPackMessages (villageDrunk ^. name) aliveWerewolfNames--        advanceStage--    VillagesTurn -> whenM (null <$> liftM2 intersect getAllowedVoters getPendingVoters) $ do-        tell . map (uncurry $ playerMadeLynchVoteMessage Nothing) =<< uses votes Map.toList--        advanceStage--    WerewolvesTurn -> whenM (none (is werewolf) <$> getPendingVoters) $ do-        getVoteResult >>= devourVotees--        protect .= Nothing-        votes .= Map.empty--        advanceStage--    WitchsTurn -> do-        whenM (has (players . witches . dead) <$> get) advanceStage--        whenJustM (use poison) $ \targetName -> do-            events %= (++ [PoisonEvent targetName])-            poison .= Nothing--        whenM (use heal) $ do-            devourEvent <- fromJust <$> preuse (events . traverse . filtered (is _DevourEvent))--            events  %= cons NoDevourEvent . delete devourEvent-            heal    .= False--        whenM (use healUsed &&^ use poisonUsed) advanceStage-        whenM (use passed)                      advanceStage--lynchVotees :: (MonadState Game m, MonadWriter [Message] m) => [Player] -> m ()-lynchVotees [votee]-    | is jester votee       = do-        jesterRevealed .= True--        tell [jesterLynchedMessage $ votee ^. name]-    | otherwise             = do-        killPlayer (votee ^. name)-        tell [playerLynchedMessage votee]-lynchVotees _       = preuse (players . scapegoats . alive) >>= \mScapegoat -> case mScapegoat of-    Just scapegoat  -> do-        scapegoatBlamed .= True--        killPlayer (scapegoat ^. name)-        tell [scapegoatLynchedMessage (scapegoat ^. name)]-    _               -> tell [noPlayerLynchedMessage]--devourVotees :: (MonadState Game m, MonadWriter [Message] m) => [Player] -> m ()-devourVotees [votee]    = ifM (uses protect $ maybe False (== votee ^. name))-    (events %= cons NoDevourEvent)-    (events %= cons (DevourEvent $ votee ^. name))-devourVotees _          = events %= cons NoDevourEvent--advanceStage :: (MonadState Game m, MonadWriter [Message] m) => m ()-advanceStage = do-    game        <- get-    nextStage   <- ifM hasAnyoneWon-        (return GameOver)-        (return . head $ filter (stageAvailable game) (drop1 $ dropWhile (game ^. stage /=) stageCycle))--    stage   .= nextStage-    boots   .= Map.empty-    passed  .= False--    tell . stageMessages =<< get--checkEvents :: (MonadState Game m, MonadWriter [Message] m) => m ()-checkEvents = do-    (available, pending) <- use events >>= partitionM eventAvailable--    events .= pending--    mapM_ applyEvent available--eventAvailable :: MonadState Game m => Event -> m Bool-eventAvailable (DevourEvent _)  = isSunrise-eventAvailable NoDevourEvent    = isSunrise-eventAvailable (PoisonEvent _)  = isSunrise--applyEvent :: (MonadState Game m, MonadWriter [Message] m) => Event -> m ()-applyEvent (DevourEvent targetName) = do-    target <- findPlayerBy_ name targetName--    killPlayer targetName-    tell [playerDevouredMessage target]-applyEvent NoDevourEvent            = tell [noPlayerDevouredMessage]-applyEvent (PoisonEvent targetName) = do-    target <- findPlayerBy_ name targetName--    killPlayer targetName-    tell [playerPoisonedMessage target]--checkGameOver :: (MonadState Game m, MonadWriter [Message] m) => m ()-checkGameOver = whenM hasAnyoneWon $ stage .= GameOver >> get >>= tell . gameOverMessages--startGame :: (MonadError [Message] m, MonadWriter [Message] m) => Text -> [Player] -> m Game-startGame callerName players = do-    when (playerNames /= nub playerNames)   $ throwError [privateMessage callerName "Player names must be unique."]-    when (length players < 7)               $ throwError [privateMessage callerName "Must have at least 7 players."]-    forM_ restrictedRoles $ \role' ->-        when (length (players ^.. traverse . filteredBy role role') > 1) $-            throwError [privateMessage callerName $ T.concat ["Cannot have more than 1 ", role' ^. Role.name, "."]]--    let game = newGame players--    tell $ newGameMessages game--    return game-    where-        playerNames = players ^.. names

@@ -1,48 +1,45 @@ {-| Module      : Game.Werewolf.Game-Description : Game data structure with functions for manipulating and querying the game state.+Description : Simplistic game data structure with lenses. 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 and querying the game state.+game state only changes when a /command/ is issued. Thus, this module defines the 'Game' data+structure and any fields required to keep track of the current state. -} +{-# LANGUAGE Rank2Types      #-} {-# LANGUAGE TemplateHaskell #-}  module Game.Werewolf.Game (     -- * Game     Game,-    stage, round, players, events, boots, allowedVoters, heal, healUsed, hunterRetaliated,-    jesterRevealed, passed, poison, poisonUsed, priorProtect, protect, roleModel, scapegoatBlamed,-    see, votes,+    stage, round, players, boots, allowedVoters, divine, fallenAngelLynched, healUsed,+    hunterRetaliated, jesterRevealed, passed, poison, poisonUsed, priorProtect, protect, roleModel,+    scapegoatBlamed, see, votes,      Stage(..),-    _FerinasGrunt, _GameOver, _HuntersTurn1, _HuntersTurn2, _Lynching, _OrphansTurn,+    _FerinasGrunt, _GameOver, _HuntersTurn1, _HuntersTurn2, _Lynching, _OraclesTurn, _OrphansTurn,     _ProtectorsTurn, _ScapegoatsTurn, _SeersTurn, _Sunrise, _Sunset, _VillageDrunksTurn,     _VillagesTurn, _WerewolvesTurn, _WitchsTurn,      allStages,     stageCycle, stageAvailable, -    Event(..),-    _DevourEvent, _NoDevourEvent, _PoisonEvent,-     newGame, -    -- ** Manipulations-    killPlayer,+    -- ** Getters+    votee, +    -- ** Prisms+    firstRound, secondRound, thirdRound,+     -- ** Searches-    getAllowedVoters, getPendingVoters, getVoteResult,+    getAllowedVoters, getPendingVoters,      -- ** Queries-    isFirstRound, isThirdRound,-    doesPlayerExist,     hasAnyoneWon, hasFallenAngelWon, hasVillagersWon, hasWerewolvesWon, ) where @@ -64,56 +61,43 @@ -- | 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'.+--   * the 'round' number and+--   * the 'players'. -- --   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 Orphan'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]-    , _boots            :: Map Text [Text]-    , _allowedVoters    :: [Text]           -- ^ Scapegoat-    , _heal             :: Bool             -- ^ Witch-    , _healUsed         :: Bool             -- ^ Witch-    , _hunterRetaliated :: Bool             -- ^ Hunter-    , _jesterRevealed   :: Bool             -- ^ Jester-    , _passed           :: Bool             -- ^ Witch-    , _poison           :: Maybe Text       -- ^ Witch-    , _poisonUsed       :: Bool             -- ^ Witch-    , _priorProtect     :: Maybe Text       -- ^ Protector-    , _protect          :: Maybe Text       -- ^ Protector-    , _roleModel        :: Maybe Text       -- ^ Orphan-    , _scapegoatBlamed  :: Bool             -- ^ Scapegoat-    , _see              :: Maybe Text       -- ^ Seer-    , _votes            :: Map Text Text    -- ^ Villagers and Werewolves+    { _stage              :: Stage+    , _round              :: Int+    , _players            :: [Player]+    , _boots              :: Map Text [Text]+    , _allowedVoters      :: [Text]           -- ^ Jester, Scapegoat+    , _divine             :: Maybe Text       -- ^ Oracle+    , _fallenAngelLynched :: Bool             -- ^ Fallen Angel+    , _healUsed           :: Bool             -- ^ Witch+    , _hunterRetaliated   :: Bool             -- ^ Hunter+    , _jesterRevealed     :: Bool             -- ^ Jester+    , _passed             :: Bool             -- ^ Witch+    , _poison             :: Maybe Text       -- ^ Witch+    , _poisonUsed         :: Bool             -- ^ Witch+    , _priorProtect       :: Maybe Text       -- ^ Protector+    , _protect            :: Maybe Text       -- ^ Protector+    , _roleModel          :: Maybe Text       -- ^ Orphan+    , _scapegoatBlamed    :: Bool             -- ^ Scapegoat+    , _see                :: Maybe Text       -- ^ Seer+    , _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).+-- | Most of these are fairly self-explainable (the turn stages). 'Sunrise' and 'Sunset' are+--   provided as meaningful breaks between the day and night as, for example, a 'VillagesTurn' may+--   not always be available (curse that retched Scapegoat). -----   Once the game reaches a turn stage, it requires a 'Game.Werewolf.Command.Command' to help push---   it past. Often only certain roles and commands may be performed at any given stage.-data Stage  = FerinasGrunt | GameOver | HuntersTurn1 | HuntersTurn2 | Lynching | OrphansTurn-            | ProtectorsTurn | ScapegoatsTurn | SeersTurn | Sunrise | Sunset | VillageDrunksTurn-            | VillagesTurn | WerewolvesTurn | WitchsTurn+--   Once the game reaches a turn stage, it requires a /command/ to help push it past. Often only+--   certain roles and commands may be performed at any given stage.+data Stage  = FerinasGrunt | GameOver | HuntersTurn1 | HuntersTurn2 | Lynching | OraclesTurn+            | OrphansTurn | ProtectorsTurn | ScapegoatsTurn | SeersTurn | Sunrise | Sunset+            | VillageDrunksTurn | VillagesTurn | WerewolvesTurn | WitchsTurn     deriving (Eq, Read, Show)  instance Humanise Stage where@@ -122,6 +106,7 @@     humanise HuntersTurn1       = fromString "Hunter's turn"     humanise HuntersTurn2       = fromString "Hunter's turn"     humanise Lynching           = fromString "Lynching"+    humanise OraclesTurn        = fromString "Oracle's turn"     humanise OrphansTurn        = fromString "Orphan's turn"     humanise ProtectorsTurn     = fromString "Protector's turn"     humanise ScapegoatsTurn     = fromString "Scapegoat's turn"@@ -133,42 +118,28 @@     humanise WerewolvesTurn     = fromString "Werewolves' turn"     humanise WitchsTurn         = fromString "Witch's turn" --- TODO (hjw): remove events--- | 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     -- ^ Protector, 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-    , Lynching-    , HuntersTurn1-    , ScapegoatsTurn-    , Sunset+    [ Sunset     , OrphansTurn     , VillageDrunksTurn     , SeersTurn+    , OraclesTurn     , ProtectorsTurn     , WerewolvesTurn     , WitchsTurn     , Sunrise     , HuntersTurn2     , FerinasGrunt+    , VillagesTurn+    , Lynching+    , HuntersTurn1+    , ScapegoatsTurn     , GameOver     ] @@ -191,6 +162,10 @@     has (players . hunters . dead) game     && not (game ^. hunterRetaliated) stageAvailable game Lynching            = Map.size (game ^. votes) > 0+stageAvailable game OraclesTurn         = has (players . oracles . alive) game+stageAvailable game OrphansTurn         =+    has (players . orphans . alive) game+    && isNothing (game ^. roleModel) stageAvailable game ProtectorsTurn      = has (players . protectors . alive) game stageAvailable game ScapegoatsTurn      = game ^. scapegoatBlamed stageAvailable game SeersTurn           = has (players . seers . alive) game@@ -198,103 +173,92 @@ stageAvailable _ Sunset                 = True stageAvailable game VillageDrunksTurn   =     has (players . villageDrunks . alive) game-    && isThirdRound game-stageAvailable game VillagesTurn        =-    (has (players . fallenAngels . alive) game || not (isFirstRound game))-    && any (is alive) (getAllowedVoters game)+    && is thirdRound game+stageAvailable game VillagesTurn        = any (is alive) (getAllowedVoters game) stageAvailable game WerewolvesTurn      = has (players . werewolves . alive) game-stageAvailable game OrphansTurn      =-    has (players . orphans . alive) game-    && isNothing (game ^. roleModel) stageAvailable game WitchsTurn          =     has (players . witches . alive) game     && (not (game ^. healUsed) || not (game ^. poisonUsed))  -- | Creates a new 'Game' with the given players. No validations are performed here, those are left---   to 'Game.Werewolf.Engine.startGame'.+--   to the binary. newGame :: [Player] -> Game-newGame players = game & stage .~ head (filter (stageAvailable game) stageCycle)-    where-        game = Game-            { _stage            = Sunset-            , _round            = 0-            , _players          = players-            , _events           = []-            , _boots            = Map.empty-            , _passed           = False-            , _allowedVoters    = players ^.. names-            , _heal             = False-            , _healUsed         = False-            , _hunterRetaliated = False-            , _jesterRevealed   = False-            , _poison           = Nothing-            , _poisonUsed       = False-            , _priorProtect     = Nothing-            , _protect          = Nothing-            , _roleModel        = Nothing-            , _scapegoatBlamed  = False-            , _see              = Nothing-            , _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)+newGame players = Game+    { _stage                = head stageCycle+    , _round                = 0+    , _players              = players+    , _boots                = Map.empty+    , _passed               = False+    , _allowedVoters        = players ^.. names+    , _divine               = Nothing+    , _fallenAngelLynched   = False+    , _healUsed             = False+    , _hunterRetaliated     = False+    , _jesterRevealed       = False+    , _poison               = Nothing+    , _poisonUsed           = False+    , _priorProtect         = Nothing+    , _protect              = Nothing+    , _roleModel            = Nothing+    , _scapegoatBlamed      = False+    , _see                  = Nothing+    , _votes                = Map.empty+    } --- | 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+-- | The traversal of the 'votes' victim. This is the player, if they exist, that received the+--   majority of the votes.+votee :: Fold Game Player+votee = folding $ (\players -> if length players == 1 then take 1 players else []) . getVoteResult  -- | 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.null (game ^. votes)  = []-    | otherwise                 = map (\name' -> game ^?! players . traverse . filteredBy name name') result+    | otherwise                 = game ^.. players . traverse . filtered ((`elem` result) . view name)     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+-- | The traversal of 'Game's on the first round.+firstRound :: Prism' Game Game+firstRound = prism (set round 0) $ \game -> (if game ^. round == 0 then Right else Left) game --- | @'isThirdRound' game = game ^. 'round' == 2@-isThirdRound :: Game -> Bool-isThirdRound game = game ^. round == 2+-- | The traversal of 'Game's on the second round.+secondRound :: Prism' Game Game+secondRound = prism (set round 1) $ \game -> (if game ^. round == 1 then Right else Left) game --- | Queries whether the player is in the game.-doesPlayerExist :: Text -> Game -> Bool-doesPlayerExist name = has $ players . names . only name+-- | The traversal of 'Game's on the third round.+thirdRound :: Prism' Game Game+thirdRound = prism (set round 2) $ \game -> (if game ^. round == 2 then Right else Left) game +-- | 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 . named 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+ -- | Queries whether anyone has won. hasAnyoneWon :: Game -> Bool hasAnyoneWon game = any ($ game) [hasFallenAngelWon, hasVillagersWon, hasWerewolvesWon]  -- | Queries whether the Fallen Angel has won. The Fallen Angel wins if they manage to get---   themselves killed on the first round.------   N.B., we check that the Fallen Angel isn't a 'villager' as the Fallen Angel's role is altered---   if they don't win.+--   themselves lynched by the Villagers. hasFallenAngelWon :: Game -> Bool-hasFallenAngelWon game = has (players . fallenAngels) game && is dead fallenAngel && isn't villager fallenAngel-    where-        fallenAngel = game ^?! players . fallenAngels+hasFallenAngelWon game = game ^. fallenAngelLynched  -- | Queries whether the 'Villagers' have won. The 'Villagers' win if they are the only players --   surviving.+--+--   N.B., the Fallen Angel is not considered when determining whether the 'Villagers' have won. hasVillagersWon :: Game -> Bool-hasVillagersWon = allOf (players . traverse . alive) (is villager)+hasVillagersWon = allOf (players . traverse . alive) (\player -> is villager player || is fallenAngel player)  -- | Queries whether the 'Werewolves' have won. The 'Werewolves' win if they are the only players --   surviving.

@@ -1,621 +0,0 @@-{-|-Module      : Game.Werewolf.Messages-Description : Suite of messages used throughout the game.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--A 'Message' is used to relay information back to either all players or a single player. This module-defines suite of messages used throughout the werewolf game, including both game play messages and-binary errors.--@werewolf@ was designed to be ambivalent to the playing chat client. The response-message structure-reflects this by staying away from anything that could be construed as client-specific. This-includes features such as emoji support.--}--{-# LANGUAGE OverloadedStrings #-}--module Game.Werewolf.Messages (-    -- * Generic messages-    newGameMessages, stageMessages, gameOverMessages, playerQuitMessage, gameIsOverMessage,--    -- ** Error messages-    playerDoesNotExistMessage, playerCannotDoThatMessage, playerCannotDoThatRightNowMessage,-    playerIsDeadMessage, targetIsDeadMessage,--    -- * Boot messages-    playerVotedToBootMessage, playerBootedMessage,--    -- ** Error messages-    playerHasAlreadyVotedToBootMessage,--    -- * Circle messages-    circleMessage,--    -- * Ping messages-    pingPlayerMessage, pingRoleMessage,--    -- * Status messages-    currentStageMessages, rolesInGameMessage, playersInGameMessage, waitingOnMessage,--    -- * Druid's turn messages-    ferinaGruntsMessage,--    -- * Fallen Angel's turn messages-    fallenAngelJoinedVillagersMessage,--    -- * Hunter's turn messages-    playerShotMessage,--    -- * Orphan's turn messages-    orphanJoinedPackMessages,--    -- * Protector's turn messages--    -- ** Error messages-    playerCannotProtectSamePlayerTwiceInARowMessage,--    -- * Scapegoat's turn messages-    scapegoatChoseAllowedVotersMessage,--    -- ** Error messages-    playerMustChooseAtLeastOneTargetMessage, playerCannotChooseJesterMessage,--    -- * Seer's turn messages-    playerSeenMessage,--    -- * Village Drunk's turn messages-    villageDrunkJoinedVillageMessage, villageDrunkJoinedPackMessages,--    -- * Villages' turn messages-    playerMadeLynchVoteMessage, playerLynchedMessage, noPlayerLynchedMessage,-    jesterLynchedMessage, scapegoatLynchedMessage,--    -- ** Error messages-    playerHasAlreadyVotedMessage,--    -- * Werewolves' turn messages-    playerMadeDevourVoteMessage, playerDevouredMessage, noPlayerDevouredMessage,--    -- ** Error messages-    playerCannotDevourAnotherWerewolfMessage,--    -- ** Error messages-    playerCannotChooseSelfMessage,--    -- * Witch's turn messages-    playerPoisonedMessage,--    -- ** Error messages-    playerHasAlreadyHealedMessage, playerHasAlreadyPoisonedMessage,-) where--import Control.Arrow-import Control.Lens-import Control.Lens.Extra--import           Data.List.Extra-import           Data.String.Humanise-import           Data.Text            (Text)-import qualified Data.Text            as T--import           Game.Werewolf.Game-import           Game.Werewolf.Player-import           Game.Werewolf.Response-import           Game.Werewolf.Role     hiding (name)-import qualified Game.Werewolf.Role     as Role--newGameMessages :: Game -> [Message]-newGameMessages game = concat-    [ [newPlayersInGameMessage $ players' ^.. names]-    , [rolesInGameMessage Nothing $ players' ^.. roles]-    , map newPlayerMessage players'-    , beholderMessages-    , trueVillagerMessages-    , stageMessages game-    ]-    where-        players'                = game ^. players-        beholderMessages        = case (,) <$> players' ^? beholders <*> players' ^? seers of-            Just (beholder, seer)   -> [beholderMessage (beholder ^. name) (seer ^. name)]-            _                       -> []-        trueVillagerMessages    = case players' ^? trueVillagers of-            Just trueVillager   -> [trueVillagerMessage $ trueVillager ^. name]-            _                   -> []--newPlayersInGameMessage :: [Text] -> Message-newPlayersInGameMessage playerNames = publicMessage $ T.concat-    ["A new game of werewolf is starting with ", concatList playerNames, "!"]--newPlayerMessage :: Player -> Message-newPlayerMessage player = privateMessage (player ^. name) $ T.intercalate "\n"-    [ T.concat ["You're ", article playerRole, " ", playerRole ^. Role.name, "."]-    , playerRole ^. description-    , playerRole ^. rules-    ]-    where-        playerRole = player ^. role--beholderMessage :: Text -> Text -> Message-beholderMessage to seerName = privateMessage to $ T.concat-    [ "The Seer has always been held in high regard among the Villagers. Few are as lucky as you to"-    , " know the Seer, ", seerName, ", personally."-    ]--trueVillagerMessage :: Text -> Message-trueVillagerMessage name = publicMessage $ T.unwords-    [ "Unguarded advice is seldom given, for advice is a dangerous gift, even from the wise to the"-    , "wise, and all courses may run ill. Yet as you feel like you need help, I begrudgingly leave"-    , "you with this:", name, "is the True Villager."-    ]--stageMessages :: Game -> [Message]-stageMessages game = case game ^. stage of-    FerinasGrunt        -> []-    GameOver            -> []-    HuntersTurn1        -> huntersTurnMessages huntersName-    HuntersTurn2        -> huntersTurnMessages huntersName-    Lynching            -> []-    OrphansTurn         -> orphansTurnMessages orphansName-    ProtectorsTurn      -> protectorsTurnMessages protectorsName-    ScapegoatsTurn      -> scapegoatsTurnMessages scapegoatsName-    SeersTurn           -> seersTurnMessages seersName-    Sunrise             -> [sunriseMessage]-    Sunset              -> [nightFallsMessage]-    VillageDrunksTurn   -> [villageDrunksTurnMessage]-    VillagesTurn        -> if isFirstRound game-        then firstVillagesTurnMessages-        else villagesTurnMessages-    WerewolvesTurn      -> if isFirstRound game-        then firstWerewolvesTurnMessages aliveWerewolfNames-        else werewolvesTurnMessages aliveWerewolfNames-    WitchsTurn          -> witchsTurnMessages game-    where-        players'            = game ^. players-        huntersName         = players' ^?! hunters . name-        orphansName         = players' ^?! orphans . name-        protectorsName      = players' ^?! protectors . name-        scapegoatsName      = players' ^?! scapegoats . name-        seersName           = players' ^?! seers . name-        aliveWerewolfNames  = players' ^.. werewolves . alive . name--huntersTurnMessages :: Text -> [Message]-huntersTurnMessages huntersName =-    [ publicMessage $ T.unwords ["Just before", huntersName, "was murdered they let off a shot."]-    , privateMessage huntersName "Whom do you `choose` to kill with your last shot?"-    ]--orphansTurnMessages :: Text -> [Message]-orphansTurnMessages to =-    [ publicMessage "The Orphan wakes up."-    , privateMessage to "Whom do you `choose` to be your role model?"-    ]--protectorsTurnMessages :: Text -> [Message]-protectorsTurnMessages to =-    [ publicMessage "The Protector wakes up."-    , privateMessage to "Whom would you like to `protect`?"-    ]--scapegoatsTurnMessages :: Text -> [Message]-scapegoatsTurnMessages scapegoatsName =-    [ publicMessage "Just before the Scapegoat burns to a complete crisp, they cry out a dying wish."-    , publicMessage $ T.concat [scapegoatsName, ", whom do you `choose` to vote on the next day?"]-    ]--seersTurnMessages :: Text -> [Message]-seersTurnMessages to =-    [ publicMessage "The Seer wakes up."-    , privateMessage to "Whose allegiance would you like to `see`?"-    ]--villageDrunksTurnMessage :: Message-villageDrunksTurnMessage = publicMessage "The Village Drunk sobers up."--sunriseMessage :: Message-sunriseMessage = publicMessage "The sun rises. Everybody wakes up and opens their eyes..."--nightFallsMessage :: Message-nightFallsMessage = publicMessage "Night falls, the village is asleep."--firstVillagesTurnMessages :: [Message]-firstVillagesTurnMessages = fallenAngelInPlayMessage : villagesTurnMessages-    where-        fallenAngelInPlayMessage = publicMessage $ T.unwords-            [ "Alas, again I regrettably yield advice: an angelic menace walks among you. Do not"-            , "cast your votes lightly, for they will relish in this opportunity to be free from"-            , "their terrible nightmare."-            ]--villagesTurnMessages :: [Message]-villagesTurnMessages =-    [ publicMessage "As the village gathers in the square the Town Clerk calls for a vote."-    , publicMessage "Whom would you like to `vote` to lynch?"-    ]--firstWerewolvesTurnMessages :: [Text] -> [Message]-firstWerewolvesTurnMessages tos =-    [privateMessage to $ packMessage to | length tos > 1, to <- tos]-    ++ werewolvesTurnMessages tos-    where-        packMessage werewolfName    = T.unwords-            [ "You feel restless, like an old curse is keeping you from sleep. It seems you're not"-            , "the only one...", packNames werewolfName-            , conjugateToBe (length tos - 1), "also emerging from their"-            , tryPlural (length tos - 1) "home"-            ]-        packNames werewolfName      = concatList $ tos \\ [werewolfName]--werewolvesTurnMessages :: [Text] -> [Message]-werewolvesTurnMessages tos =-    publicMessage "The Werewolves wake up, transform and choose a new victim."-    : groupMessages tos "Whom would you like to `vote` to devour?"--witchsTurnMessages :: Game -> [Message]-witchsTurnMessages game = concat-    [ [wakeUpMessage]-    , devourMessages-    , healMessages-    , poisonMessages-    , [passMessage]-    ]-    where-        witchsName      = game ^?! players . witches . name-        wakeUpMessage   = publicMessage "The Witch wakes up."-        passMessage     = privateMessage witchsName "Type `pass` to end your turn."-        devourMessages  = case game ^? events . traverse . _DevourEvent of-            Just targetName ->-                [ privateMessage witchsName $-                    T.unwords ["You see", targetName, "sprawled outside bleeding uncontrollably."]-                ]-            _               -> []-        healMessages-            | game ^. healUsed                                  = []-            | hasn't (events . traverse . _DevourEvent) game    = []-            | otherwise                                         = [privateMessage witchsName "Would you like to `heal` them?"]-        poisonMessages-            | game ^. poisonUsed    = []-            | otherwise             = [privateMessage witchsName "Would you like to `poison` anyone?"]--gameOverMessages :: Game -> [Message]-gameOverMessages game-    | hasFallenAngelWon game    = concat-        [ [publicMessage "You should have heeded my warning, for now the Fallen Angel has been set free!"]-        , [publicMessage "The game is over! The Fallen Angel has won."]-        , [playerRolesMessage]-        , [playerWonMessage fallenAngelsName]-        , map playerLostMessage (game ^.. players . names \\ [fallenAngelsName])-        ]-    | hasVillagersWon game      = concat-        [ [publicMessage "The game is over! The Villagers have won."]-        , [playerRolesMessage]-        , playerWonMessages-        , playerContributedMessages-        , playerLostMessages-        ]-    | hasWerewolvesWon game     = concat-        [ [publicMessage "The game is over! The Werewolves have won."]-        , [playerRolesMessage]-        , playerWonMessages-        , playerContributedMessages-        , playerLostMessages-        ]-    | otherwise             = undefined-    where-        playerRolesMessage = publicMessage $ T.concat-            [ "As I know you're all wondering who lied to you, here's the role allocations: "-            , concatList $ map-                (\player -> T.concat [player ^. name, " (", player ^. role . Role.name, ")"])-                (game ^. players)-            , "."-            ]--        winningAllegiance-            | hasVillagersWon game      = Villagers-            | hasWerewolvesWon game     = Werewolves-            | otherwise                 = undefined--        winningPlayers  = game ^.. players . traverse . filteredBy (role . allegiance) winningAllegiance-        losingPlayers   = game ^. players \\ winningPlayers--        playerWonMessages           = map playerWonMessage (winningPlayers ^.. traverse . alive . name)-        playerContributedMessages   = map playerContributedMessage (winningPlayers ^.. traverse . dead . name)-        playerLostMessages          = map playerLostMessage (losingPlayers ^.. names)--        fallenAngelsName = game ^?! players . fallenAngels . name--playerWonMessage :: Text -> Message-playerWonMessage to = privateMessage to "Victory! You won!"--playerContributedMessage :: Text -> Message-playerContributedMessage to = privateMessage to "Your team won, but you died. Congratulations?"--playerLostMessage :: Text -> Message-playerLostMessage to = privateMessage to "Feck, you lost this time round."--playerQuitMessage :: Player -> Message-playerQuitMessage player = publicMessage $ T.unwords [playerName, "the", playerRole, "has quit!"]-    where-        playerName = 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."]--playerCannotDoThatMessage :: Text -> Message-playerCannotDoThatMessage to = privateMessage to "You cannot do that!"--playerCannotDoThatRightNowMessage :: Text -> Message-playerCannotDoThatRightNowMessage to = privateMessage to "You cannot do that right now!"--playerIsDeadMessage :: Text -> Message-playerIsDeadMessage to = privateMessage to "Sshh, you're meant to be dead!"--targetIsDeadMessage :: Text -> Text -> Message-targetIsDeadMessage to targetName = privateMessage to $ T.unwords [targetName, "is already dead!"]--playerVotedToBootMessage :: Text -> Text -> Message-playerVotedToBootMessage playerName targetName = publicMessage $ T.concat-    [playerName, " voted to boot ", targetName, "!"]--playerBootedMessage :: Player -> Message-playerBootedMessage player = publicMessage $ T.unwords-    [ playerName, "the", playerRole ^. Role.name-    , "has been booted from the game!"-    ]-    where-        playerName = player ^. name-        playerRole = player ^. role--playerHasAlreadyVotedToBootMessage :: Text -> Text -> Message-playerHasAlreadyVotedToBootMessage to targetName = privateMessage to $ T.concat-    ["You've already voted to boot ", targetName, "!"]--circleMessage :: Text -> [Player] -> Message-circleMessage to players = privateMessage to $ T.intercalate "\n"-    [ "The players are sitting in the following order:"-    , T.intercalate " <-> " (map playerName (players ++ [head players]))-    ]-    where-        playerName player = T.concat [player ^. name, if is dead player then " (dead)" else ""]--pingPlayerMessage :: Text -> Message-pingPlayerMessage to = privateMessage to "Waiting on you..."--pingRoleMessage :: Text -> Message-pingRoleMessage roleName = publicMessage $ T.concat ["Waiting on the ", roleName, "..."]--currentStageMessages :: Text -> Stage -> [Message]-currentStageMessages _ FerinasGrunt = []-currentStageMessages to GameOver    = [gameIsOverMessage to]-currentStageMessages _ Lynching     = []-currentStageMessages _ Sunrise      = []-currentStageMessages _ Sunset       = []-currentStageMessages to turn        = [privateMessage to $ T.concat-    [ "It's currently the ", humanise turn, "."-    ]]--rolesInGameMessage :: Maybe Text -> [Role] -> Message-rolesInGameMessage mTo roles = Message mTo $ T.concat-    [ "The roles in play are "-    , concatList $ map (\(role, count) ->-        T.concat [role ^. Role.name, " (", T.pack $ show count, ")"])-        roleCounts-    , " for a total balance of ", T.pack $ show totalBalance, "."-    ]-    where-        roleCounts      = map (head &&& length) (groupSortOn (view Role.name) roles)-        totalBalance    = sumOf (traverse . balance) roles--playersInGameMessage :: Text -> [Player] -> Message-playersInGameMessage to players = privateMessage to . T.intercalate "\n" $-    alivePlayersText : [deadPlayersText | any (is dead) players]-    where-        alivePlayers    = players ^.. traverse . alive-        deadPlayers     = players ^.. traverse . dead--        alivePlayersText            = T.concat-            [ "The following players are still alive: "-            , concatList $ map (\player -> if is trueVillager player then playerNameWithRole player else player ^. name) alivePlayers, "."-            ]-        deadPlayersText             = T.concat-            [ "The following players are dead: "-            , concatList $ map playerNameWithRole deadPlayers, "."-            ]-        playerNameWithRole player   = T.concat [player ^. name, " (", player ^. role . Role.name, ")"]--waitingOnMessage :: Maybe Text -> [Text] -> Message-waitingOnMessage mTo playerNames = Message mTo $ T.concat-    ["Waiting on ", concatList playerNames, "..."]--ferinaGruntsMessage :: Message-ferinaGruntsMessage = publicMessage-    "Ferina wakes from her slumber, disturbed and on edge. She loudly grunts as she smells danger."--fallenAngelJoinedVillagersMessage :: Message-fallenAngelJoinedVillagersMessage = publicMessage $ T.unwords-    [ "You hear the Fallen Angel wrought with anger off in the distance. They failed to attract the"-    , "prejudiced vote of the village to leave this world. Now they are stuck here, doomed forever"-    , "to live out a mortal life as a Villager."-    ]--playerShotMessage :: Player -> Message-playerShotMessage target = publicMessage $ T.unwords-    [ targetName, "the", targetRole, "slumps down to the ground, hands clutching at their chest"-    , "while blood slips between their fingers and pools around them."-    ]-    where-        targetName = target ^. name-        targetRole = target ^. role . Role.name--orphanJoinedPackMessages :: Text -> [Text] -> [Message]-orphanJoinedPackMessages orphansName werewolfNames =-    privateMessage orphansName (T.unwords-        [ "The death of your role model is distressing. Without second thought you abandon the"-        , "Villagers and run off into the woods, towards a new home. As you arrive you see the"-        , tryPlural (length werewolfNames) "face", "of"-        , concatList werewolfNames, "waiting for you."-        ])-    : groupMessages werewolfNames (T.unwords-        [ orphansName, "the Orphan scampers off into the woods. Without their role model they have"-        , "abandoned the village and are in search of a new home. You welcome them into your pack."-        ])--playerCannotProtectSamePlayerTwiceInARowMessage :: Text -> Message-playerCannotProtectSamePlayerTwiceInARowMessage to =-    privateMessage to "You cannot protect the same player twice in a row!"--scapegoatChoseAllowedVotersMessage :: [Text] -> Message-scapegoatChoseAllowedVotersMessage allowedVoters = publicMessage $ T.unwords-    [ "On the next day only", concatList allowedVoters, "shall be allowed to vote. The Town Crier,"-    , "realising how foolish it was to kill the Scapegoat, grants them this wish."-    ]--playerMustChooseAtLeastOneTargetMessage :: Text -> Message-playerMustChooseAtLeastOneTargetMessage to =-    privateMessage to "You must choose at least 1 target!"--playerCannotChooseJesterMessage :: Text -> Message-playerCannotChooseJesterMessage to =-    privateMessage to "You cannot choose the Jester!"--playerSeenMessage :: Text -> Player -> Message-playerSeenMessage to target = privateMessage to $ T.concat-    [targetName, " is aligned with ", article, humanise allegiance', "."]-    where-        targetName  = target ^. name-        allegiance'-            | is alphaWolf target   = Villagers-            | is lycan target       = Werewolves-            | otherwise             = target ^. role . allegiance-        article     = if allegiance' == NoOne then "" else "the "--villageDrunkJoinedVillageMessage :: Text -> Message-villageDrunkJoinedVillageMessage to = privateMessage to $ T.unwords-    [ "Somehow you managed to avoid getting killed while in your drunken stupor. Thank God for"-    , "that, maybe now you can actually help the village."-    ]--villageDrunkJoinedPackMessages :: Text -> [Text] -> [Message]-villageDrunkJoinedPackMessages villageDrunksName werewolfNames =-    privateMessage villageDrunksName (T.concat-        [ "As you start to feel sober for the first time in days a new thirst begins to take hold."-        , " The bloodthirst starts to bring back memories, memories of your true home with "-        , concatList werewolfNames, "."-        ])-    : groupMessages werewolfNames (T.unwords-        [ villageDrunksName-        , "the Village Drunk has finally sobered up and remembered their true home."-        ])--playerMadeLynchVoteMessage :: Maybe Text -> Text -> Text -> Message-playerMadeLynchVoteMessage mTo voterName targetName = Message mTo $ T.concat-    [ voterName, " voted to lynch ", targetName, "."-    ]--playerLynchedMessage :: Player -> Message-playerLynchedMessage player-    | is simpleWerewolf player-        || is alphaWolf player  = publicMessage $ T.concat-        [ playerName, " is tied up to a pyre and set alight. As they scream their body starts to "-        , "contort and writhe, transforming into ", article playerRole, " "-        , playerRole ^. Role.name, ".", " Thankfully they go limp before breaking free of their "-        , "restraints."-        ]-    | otherwise                 = publicMessage $ T.concat-        [ playerName, " is tied up to a pyre and set alight. Eventually the screams start to die "-        , "and with their last breath, they reveal themselves as ", article playerRole, " "-        , playerRole ^. Role.name, "."-        ]-    where-        playerName = player ^. name-        playerRole = player ^. role--noPlayerLynchedMessage :: Message-noPlayerLynchedMessage = publicMessage $ T.unwords-    [ "Daylight is wasted as the townsfolk squabble over whom to tie up. Looks like no-one is being"-    , "burned this day."-    ]--jesterLynchedMessage :: Text -> Message-jesterLynchedMessage name = publicMessage $ T.concat-    [ "Just as the townsfolk tie ", name, " up to the pyre, a voice in the crowd yells out."-    , " \"We can't burn ", name, "! He's the joke of the town!\" "-    , name, " the Jester is quickly untied and apologised to."-    ]--scapegoatLynchedMessage :: Text -> Message-scapegoatLynchedMessage name = publicMessage $ T.unwords-    [ "The townsfolk squabble over whom to tie up. Just as they are about to call it a day"-    , "they notice that", name, "has been acting awfully suspicious."-    , "Not wanting to take any chances,", name, "is promptly tied to a pyre and burned alive."-    ]--playerHasAlreadyVotedMessage :: Text -> Message-playerHasAlreadyVotedMessage to = privateMessage to "You've already voted!"--playerMadeDevourVoteMessage :: Text -> Text -> Text -> Message-playerMadeDevourVoteMessage to voterName targetName = privateMessage to $ T.concat-    [ voterName, " voted to devour ", targetName, "."-    ]--playerDevouredMessage :: Player -> Message-playerDevouredMessage player = publicMessage $ T.concat-    [ "As you open them you notice a door broken down and "-    , playerName, "'s guts half devoured and spilling out over the cobblestones."-    , " From the look of their personal effects, you deduce they were "-    , article playerRole, " ", playerRole ^. Role.name, "."-    ]-    where-        playerName = player ^. name-        playerRole = player ^. role--noPlayerDevouredMessage :: Message-noPlayerDevouredMessage = publicMessage $ T.unwords-    [ "Surprisingly you see everyone present at the town square."-    , "Perhaps the Werewolves have left Fougères?"-    ]--playerCannotDevourAnotherWerewolfMessage :: Text -> Message-playerCannotDevourAnotherWerewolfMessage to = privateMessage to "You cannot devour another Werewolf!"--playerCannotChooseSelfMessage :: Text -> Message-playerCannotChooseSelfMessage to = privateMessage to "You cannot choose yourself!"--playerPoisonedMessage :: Player -> Message-playerPoisonedMessage player = publicMessage $ T.unwords-    [ "Upon further discovery, it looks like the Witch struck in the night."-    , playerName, "the", playerRole, "is hanging over the side of their bed, poisoned."-    ]-    where-        playerName = player ^. name-        playerRole = player ^. role . Role.name--playerHasAlreadyHealedMessage :: Text -> Message-playerHasAlreadyHealedMessage to = privateMessage to "You've already healed someone!"--playerHasAlreadyPoisonedMessage :: Text -> Message-playerHasAlreadyPoisonedMessage to = privateMessage to "You've already poisoned someone!"--article :: Role -> Text-article role-    | role `elem` restrictedRoles   = "the"-    | otherwise                     = "a"--concatList :: [Text] -> Text-concatList []       = ""-concatList [word]   = word-concatList words    = T.unwords [T.intercalate ", " (init words), "and", last words]--conjugateToBe :: Int -> Text-conjugateToBe 1 = "is"-conjugateToBe _ = "are"--tryPlural :: Int -> Text -> Text-tryPlural 1 word = word-tryPlural _ word = T.snoc word 's'

@@ -1,13 +1,12 @@ {-| Module      : Game.Werewolf.Player-Description : Simplistic player data structure with functions for searching, filtering and querying+Description : Simplistic player data structure with lenses 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".+Players are quite simple in themselves. They have a 'name', 'role' and 'state'. -}  {-# LANGUAGE FlexibleContexts #-}@@ -25,17 +24,20 @@     newPlayer,      -- ** Traversals-    alphaWolf, beholder, crookedSenator, druid, fallenAngel, hunter, jester, lycan, orphan,-    protector, scapegoat, seer, simpleVillager, simpleWerewolf, trueVillager, villageDrunk, witch,+    alphaWolf, beholder, crookedSenator, druid, fallenAngel, hunter, jester, lycan, medusa, oracle,+    orphan, protector, scapegoat, seer, simpleVillager, simpleWerewolf, spitefulGhost, trueVillager,+    villageDrunk, witch,     villager, werewolf, -    -- | These are provided just as a bit of sugar to avoid continually writing @'traverse' .@.+    -- | The following traversals 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!+    -- | N.B., the following traversals are not legal for the same reason 'filtered' isn't!+    named,     alphaWolves, beholders, crookedSenators, druids, fallenAngels, hunters, jesters, lycans,-    orphans, protectors, scapegoats, seers, simpleVillagers, simpleWerewolves, trueVillagers,-    villageDrunks, witches,+    medusas, oracles, orphans, protectors, scapegoats, seers, simpleVillagers, simpleWerewolves,+    spitefulGhosts, trueVillagers, villageDrunks, witches,     villagers, werewolves,     alive, dead, ) where@@ -69,11 +71,13 @@  makePrisms ''State --- | Creates a new 'Alive' player.+-- | Creates a new 'Alive' player, with one exception: a 'spitefulGhost' always starts 'Dead'. newPlayer :: Text -> Role -> Player-newPlayer name role = Player name role Alive+newPlayer name role = Player name role state+    where+        state = if role == spitefulGhostRole then Dead else Alive --- | The traversal of 'Player's with a 'alphaWolfRole'.+-- | The traversal of 'Player's with an 'alphaWolfRole'. -- -- @ -- 'alphaWolf' = 'role' . 'only' 'alphaWolfRole'@@ -105,7 +109,7 @@ druid :: Traversal' Player () druid = role . only druidRole --- | The traversal of 'Player's with an 'fallenAngelRole'.+-- | The traversal of 'Player's with a 'fallenAngelRole'. -- -- @ -- 'fallenAngel' = 'role' . 'only' 'fallenAngelRole'@@ -137,9 +141,25 @@ lycan :: Traversal' Player () lycan = role . only lycanRole --- | The traversal of 'Player's with a 'orphanRole'.+-- | The traversal of 'Player's with a 'medusaRole'. -- -- @+-- 'medusa' = 'role' . 'only' 'medusaRole'+-- @+medusa :: Traversal' Player ()+medusa = role . only medusaRole++-- | The traversal of 'Player's with a 'oracleRole'.+--+-- @+-- 'oracle' = 'role' . 'only' 'oracleRole'+-- @+oracle :: Traversal' Player ()+oracle = role . only oracleRole++-- | The traversal of 'Player's with an 'orphanRole'.+--+-- @ -- 'orphan' = 'role' . 'only' 'orphanRole' -- @ orphan :: Traversal' Player ()@@ -185,6 +205,14 @@ simpleWerewolf :: Traversal' Player () simpleWerewolf = role . only simpleWerewolfRole +-- | The traversal of 'Player's with a 'spitefulGhostRole'.+--+-- @+-- 'spitefulGhost' = 'role' . 'only' 'spitefulGhostRole'+-- @+spitefulGhost :: Traversal' Player ()+spitefulGhost = role . only spitefulGhostRole+ -- | The traversal of 'Player's with a 'trueVillagerRole'. -- -- @@@ -249,6 +277,14 @@ states :: Traversable t => Traversal' (t Player) State states = traverse . state +-- | This 'Traversal' provides the traversal of 'Player's with the given name.+--+-- @+-- 'named' name' = filteredBy' . 'name' name'+-- @+named :: Text -> Traversal' Player Player+named name' = filteredBy name name'+ -- | This 'Traversal' provides the traversal of 'alphaWolf' 'Player's. -- -- @@@ -313,6 +349,22 @@ lycans :: Traversable t => Traversal' (t Player) Player lycans = traverse . filtered (is lycan) +-- | This 'Traversal' provides the traversal of 'medusa' 'Player's.+--+-- @+-- 'medusas' = 'traverse' . 'filtered' ('is' 'medusa')+-- @+medusas :: Traversable t => Traversal' (t Player) Player+medusas = traverse . filtered (is medusa)++-- | This 'Traversal' provides the traversal of 'oracle' 'Player's.+--+-- @+-- 'oracles' = 'traverse' . 'filtered' ('is' 'oracle')+-- @+oracles :: Traversable t => Traversal' (t Player) Player+oracles = traverse . filtered (is oracle)+ -- | This 'Traversal' provides the traversal of 'orphan' 'Player's. -- -- @@@ -360,6 +412,14 @@ -- @ simpleWerewolves :: Traversable t => Traversal' (t Player) Player simpleWerewolves = traverse . filtered (is simpleWerewolf)++-- | This 'Traversal' provides the traversal of 'spitefulGhost' 'Player's.+--+-- @+-- 'spitefulGhosts' = 'traverse' . 'filtered' ('is' 'spitefulGhost')+-- @+spitefulGhosts :: Traversable t => Traversal' (t Player) Player+spitefulGhosts = traverse . filtered (is spitefulGhost)  -- | This 'Traversal' provides the traversal of 'trueVillager' 'Player's. --

@@ -80,7 +80,7 @@ exitWith :: MonadIO m => Response -> m a exitWith response = liftIO $ T.putStrLn (T.decodeUtf8 $ encode response) >> Exit.exitSuccess --- | A message may be either public or private, indicated by it's @to@ field.+-- | A message may be either public or private, indicated by its @to@ field. -- --   Each message contains a single text field. This field is permitted to contain special --   characters such as new lines and tabs.

@@ -1,6 +1,6 @@ {-| Module      : Game.Werewolf.Role-Description : Simplistic role data structure and instances.+Description : Simplistic role data structure with lenses and instances.  Copyright   : (c) Henry J. Wylde, 2016 License     : BSD3@@ -39,7 +39,7 @@     -- | The Loners look out for themselves and themselves alone.      --   The Loners must complete their own objective.-    fallenAngelRole,+    fallenAngelRole, spitefulGhostRole,      -- *** The Villagers     -- | Fraught with fear of the unseen enemy, the Villagers must work together to determine the@@ -47,8 +47,9 @@     --   certain few have learnt some tricks over the years that may turn out rather useful.      --   The Villagers must lynch all of the Werewolves.-    beholderRole, crookedSenatorRole, druidRole, hunterRole, jesterRole, lycanRole, protectorRole,-    scapegoatRole, seerRole, simpleVillagerRole, trueVillagerRole, witchRole,+    beholderRole, crookedSenatorRole, druidRole, hunterRole, jesterRole, lycanRole, medusaRole,+    oracleRole, protectorRole, scapegoatRole, seerRole, simpleVillagerRole, trueVillagerRole,+    witchRole,      -- *** The Werewolves     -- | Hiding in plain sight, the Werewolves are not a small trifle.@@ -67,8 +68,6 @@ 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@@ -112,12 +111,15 @@     , hunterRole     , jesterRole     , lycanRole+    , medusaRole+    , oracleRole     , orphanRole     , protectorRole     , scapegoatRole     , seerRole     , simpleVillagerRole     , simpleWerewolfRole+    , spitefulGhostRole     , trueVillagerRole     , villageDrunkRole     , witchRole@@ -199,11 +201,8 @@ --   /angels left on Earth. Nothing is worse punishment for them, the Fallen Angel yearns for death/ --   /to once again be free!/ -----   When the Fallen Angel is in play, the game begins with the village's vote and then the first---   night.------   The Fallen Angel wins if they manage to get eliminated on the first round (day or night). If---   however they fail, they become a Villager for the rest of the game.+--   The Fallen Angel wins if they manage to get lynched by the Villagers before the end of the+--   game. fallenAngelRole :: Role fallenAngelRole = Role     { _name         = "Fallen Angel"@@ -216,18 +215,37 @@         , "now one of the few angels left on Earth. Nothing is worse punishment for them, the"         , "Fallen Angel yearns for death to once again be free!"         ]-    , _rules        = T.intercalate "\n"-        [ T.unwords-            [ "When the Fallen Angel is in play, the game begins with the village's vote and then"-            , "the first night."-            ]-        , T.unwords-            [ "The Fallen Angel wins if they manage to get eliminated on the first round (day or"-            , "night). If however they fail, they become a Villager for the rest of the game."-            ]+    , _rules        = T.unwords+        [ "The Fallen Angel wins if they manage to get lynched by the Villagers before the end of"+        , "the game."         ]     } +-- | /In this time of turmoil, it would seem unlikely for the Villagers of Fougères to unanimously/+--   /agree on anything. Yet this is not so, for they all agree the village is haunted by a ghost./+--   /The vindictive Spiteful Ghost never moved on, rather they remain with the sole purpose of/+--   /haunting the village and ensuring that the Villagers never forget what they have done./+--+--   The Spiteful ghost is dead and cannot win, however they know the game's role allocations and+--   may haunt the village as they wish.+spitefulGhostRole :: Role+spitefulGhostRole = Role+    { _name         = "Spiteful Ghost"+    , _allegiance   = NoOne+    , _balance      = 0+    , _description  = T.unwords+        [ "In this time of turmoil, it would seem unlikely for the Villagers of Fougères to"+        , "unanimously agree on anything. Yet this is not so, for they all agree the village is"+        , "haunted by a ghost. The vindictive Spiteful Ghost never moved on, rather they remain"+        , "with the sole purpose of haunting the village and ensuring that the Villagers never"+        , "forget what they have done."+        ]+    , _rules        = T.unwords+        [ "The Spiteful ghost is dead and cannot win, however they know the game's role allocations"+        , "and may haunt the village as they wish."+        ]+    }+ -- | /Awareness comes easy to the Beholder. They listen to their senses and trust their hunches./ --   /Over the years the Beholder has grown to know a certain few of the village just by paying/ --   /attention. Little cues here and there, the way someone talks, the way they move - it all/@@ -238,7 +256,7 @@ beholderRole = Role     { _name         = "Beholder"     , _allegiance   = Villagers-    , _balance      = 2+    , _balance      = 1     , _description  = T.unwords         [ "Awareness comes easy to the Beholder. They listen to their senses and trust their"         , "hunches. Over the years the Beholder has grown to know a certain few of the village just"@@ -275,7 +293,7 @@ --   /proximity! Listen for her grunt and heed her warning for she will not let you down./ -- --   Each morning when Ferina wakes from her slumber she will be alert and cautious. If the Druid is---   next to a Werewolf then Ferina will grunt in warning.+--   next to a Werewolf in the player `circle` then Ferina will grunt in warning. druidRole :: Role druidRole = Role     { _name         = "Druid"@@ -291,7 +309,7 @@         ]     , _rules        = T.unwords         [ "Each morning when Ferina wakes from her slumber she will be alert and cautious. If the"-        , "Druid is next to a Werewolf then Ferina will grunt in warning."+        , "Druid is next to a Werewolf in the player `circle` then Ferina will grunt in warning."         ]     } @@ -368,6 +386,58 @@         ]     } +-- | /A beautiful flirt, the Medusa is aligned with the Villagers but harbours a terrifying secret./+--   /During the day they are well known in the village of Fougères for their stunning appearance/+--   /which captures the eye and love of all the townsfolk. However when their secret takes ahold/+--   /at sundown, their true self is revealed. Any who gaze upon her true form would see live/+--   /snakes for hair and the few that further look into her eyes are turned to stone./+--+--   If Medusa attracts the attention of a Werewolf during the night and is devoured, the first+--   Werewolf to their left in the player `circle` will catch their gaze and turn to stone,+--   instantly killing the lupine predator.+medusaRole :: Role+medusaRole = Role+    { _name         = "Medusa"+    , _allegiance   = Villagers+    , _balance      = 4+    , _description  = T.unwords+        [ "A beautiful flirt, the Medusa is aligned with the Villagers but harbours a terrifying"+        , "secret. During the day they are well known in the village of Fougères for their stunning"+        , "appearance which captures the eye and love of all the townsfolk. However when their"+        , "secret takes ahold at sundown, their true self is revealed. Any who gaze upon her true"+        , "form would see live snakes for hair and the few that further look into her eyes are"+        , "turned to stone."+        ]+    , _rules        = T.unwords+        [ "If Medusa attracts the attention of a Werewolf during the night and is devoured, the"+        , "first Werewolf to their left in the player `circle` will catch their gaze and turn to"+        , "stone, instantly killing the lupine predator."+        ]+    }++-- | /Originally rejected by the townsfolk, the Oracle's prophetic divinations has earned trust/+--   /within the village. With constant precognition - and concern for the future - the Oracle/+--   /knows the village will only live if they work together./+--+--   Each night the Oracle chooses a player to divine. They are then informed of the player's role+--   the following morning. This wisdom is for the Oracle to use to ensure the future of Fougères.+oracleRole :: Role+oracleRole = Role+    { _name         = "Oracle"+    , _allegiance   = Villagers+    , _balance      = 2+    , _description  = T.unwords+        [ "Originally rejected by the townsfolk, the Oracle's prophetic divinations has earned"+        , "trust within the village. With constant precognition - and concern for the future - the"+        , "Oracle knows the village will only live if they work together."+        ]+    , _rules        = T.unwords+        [ "Each night the Oracle chooses a player to divine. They are then informed of the player's"+        , "role the following morning. This wisdom is for the Oracle to use to ensure the future of"+        , "Fougères."+        ]+    }+ -- | /The Protector is one of the few pure of heart and altruistic Villagers; they are forever/ --   /putting others needs above their own. Each night they fight against the Werewolves with/ --   /naught but a sword and shield, potentially saving an innocents life./@@ -442,7 +512,10 @@         , "always be true, but only for the present as not even the Seer knows what the future"         , "holds."         ]-    , _rules        = "Each night the Seer sees the allegiance of one player of their choice."+    , _rules        = T.unwords+        [ "Each night the Seer chooses a player to see. They are then informed of the player's"+        , "allegiance the following morning."+        ]     }  -- | /A simple, ordinary townsperson in every way. Some may be cobblers, others bakers or even/@@ -491,7 +564,7 @@ --   /one of which heals a victim of the Werewolves, the other poisons a player./ -- --   The Witch is called after the Werewolves. They are able to heal and poison one player per game.---   There is no restriction on using both potions in one night or to heal themself.+--   There is no restriction on using both potions in one night or on healing themself. witchRole :: Role witchRole = Role     { _name         = "Witch"@@ -506,7 +579,7 @@         ]     , _rules        = T.unwords         [ "The Witch is called after the Werewolves. They are able to heal and poison one player"-        , "per game. There is no restriction on using both potions in one night or to heal"+        , "per game. There is no restriction on using both potions in one night or on healing"         , "themself."         ]     }

@@ -1,194 +0,0 @@-{-|-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, removePlayer, setPlayerAllegiance, getRandomAllegiance,--    -- ** Searches-    findPlayerBy_, getAdjacentAlivePlayers, getPlayerVote, getAllowedVoters, getPendingVoters,-    getVoteResult,--    -- ** Queries-    isGameOver, isHuntersTurn, isOrphansTurn, isProtectorsTurn, isScapegoatsTurn, isSeersTurn,-    isSunrise, isVillagesTurn, isWerewolvesTurn, isWitchsTurn,-    hasAnyoneWon, hasFallenAngelWon, hasVillagersWon, hasWerewolvesWon,--    -- * Player--    -- ** Queries-    doesPlayerExist,-    isPlayerHunter, isPlayerJester, isPlayerOrphan, isPlayerProtector, isPlayerScapegoat,-    isPlayerSeer, isPlayerWitch,-    isPlayerWerewolf,-    isPlayerAlive, isPlayerDead,-) where--import Control.Lens-import Control.Lens.Extra-import Control.Monad.Extra-import Control.Monad.Random-import Control.Monad.State--import           Data.List-import qualified Data.Map   as Map-import           Data.Maybe-import           Data.Text  (Text)--import           Game.Werewolf.Game   hiding (doesPlayerExist, getAllowedVoters, getPendingVoters,-                                       getVoteResult, hasAnyoneWon, hasFallenAngelWon,-                                       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--removePlayer :: MonadState Game m => Text -> m ()-removePlayer name' = do-    killPlayer name'--    votes %= Map.delete name'--    player <- findPlayerBy_ name name'--    when (is fallenAngel player)    $ setPlayerAllegiance name' Villagers-    when (is orphan player)         $ roleModel .= Nothing-    when (is protector player)      $ do-        protect         .= Nothing-        priorProtect    .= Nothing-    when (is seer player)           $ see .= Nothing-    when (is witch player)          $ do-        heal        .= False-        healUsed    .= False-        poison      .= Nothing-        poisonUsed  .= False---- | Fudges the player's allegiance. This function is useful for roles such as the Orphan 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'---- | Get a random allegiance (either Villagers or Werewolves).-getRandomAllegiance :: MonadRandom m => m Allegiance-getRandomAllegiance = fromList [(Villagers, 0.5), (Werewolves, 0.5)]--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)--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--isGameOver :: MonadState Game m => m Bool-isGameOver = has (stage . _GameOver) <$> get--isHuntersTurn :: MonadState Game m => m Bool-isHuntersTurn = orM-    [ has (stage . _HuntersTurn1) <$> get-    , has (stage . _HuntersTurn2) <$> get-    ]--isOrphansTurn :: MonadState Game m => m Bool-isOrphansTurn = has (stage . _OrphansTurn) <$> get--isProtectorsTurn :: MonadState Game m => m Bool-isProtectorsTurn = has (stage . _ProtectorsTurn) <$> 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--isWitchsTurn :: MonadState Game m => m Bool-isWitchsTurn = has (stage . _WitchsTurn) <$> get--hasAnyoneWon :: MonadState Game m => m Bool-hasAnyoneWon = gets Game.hasAnyoneWon--hasFallenAngelWon :: MonadState Game m => m Bool-hasFallenAngelWon = gets Game.hasFallenAngelWon--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--isPlayerHunter :: MonadState Game m => Text -> m Bool-isPlayerHunter name' = is hunter <$> findPlayerBy_ name name'--isPlayerJester :: MonadState Game m => Text -> m Bool-isPlayerJester name' = is jester <$> findPlayerBy_ name name'--isPlayerOrphan :: MonadState Game m => Text -> m Bool-isPlayerOrphan name' = is orphan <$> findPlayerBy_ name name'--isPlayerProtector :: MonadState Game m => Text -> m Bool-isPlayerProtector name' = is protector <$> 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'--isPlayerWitch :: MonadState Game m => Text -> m Bool-isPlayerWitch name' = is witch <$> 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'

@@ -1,23 +0,0 @@-{-|-Module      : Main-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Main (-    -- * Main-    main-) where--import Game.Werewolf.Test.Command-import Game.Werewolf.Test.Engine--import Test.Tasty-import Test.Tasty.QuickCheck--main :: IO ()-main = defaultMain . localOption (QuickCheckTests 20) =<< tests--tests :: IO TestTree-tests = return . testGroup "Tests" $ allCommandTests ++ allEngineTests

@@ -1,429 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Arbitrary-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--{-# OPTIONS_GHC -fno-warn-orphans #-}--module Game.Werewolf.Test.Arbitrary (-    -- * Initial arbitraries--    -- ** Game-    GameAtGameOver(..), GameAtHuntersTurn(..), GameAtOrphansTurn(..), GameAtProtectorsTurn(..),-    GameAtScapegoatsTurn(..), GameAtSeersTurn(..), GameAtSunrise(..), GameAtVillagesTurn(..),-    GameAtWerewolvesTurn(..), GameAtWitchsTurn(..),--    GameWithAllowedVoters(..), GameWithDevourEvent(..), GameWithDevourVotes(..), GameWithHeal(..),-    GameWithJesterRevealedAtVillagesTurn(..), GameWithLynchVotes(..), GameWithMajorityVote(..),-    GameWithPoison(..), GameWithProtect(..),--    -- ** Player-    arbitraryPlayerSet,--    -- * Contextual arbitraries--    -- ** Command-    arbitraryCommand, arbitraryHunterChooseCommand, arbitraryOrphanChooseCommand,-    arbitraryScapegoatChooseCommand, arbitraryHealCommand, arbitraryPassCommand,-    arbitraryPoisonCommand, arbitraryProtectCommand, arbitraryQuitCommand, arbitrarySeeCommand,-    arbitraryWerewolfVoteCommand, arbitraryVillagerVoteCommand,--    runArbitraryCommands,--    -- ** Player-    arbitraryPlayer, arbitraryWerewolf,-) where--import Control.Lens       hiding (elements, isn't)-import Control.Lens.Extra--import           Data.List.Extra-import           Data.Maybe-import           Data.Text       (Text)-import qualified Data.Text       as T--import Game.Werewolf-import Game.Werewolf.Command.Global-import Game.Werewolf.Command.Hunter    as Hunter-import Game.Werewolf.Command.Orphan    as Orphan-import Game.Werewolf.Command.Protector-import Game.Werewolf.Command.Scapegoat as Scapegoat-import Game.Werewolf.Command.Seer-import Game.Werewolf.Command.Villager  as Villager-import Game.Werewolf.Command.Werewolf  as Werewolf-import Game.Werewolf.Command.Witch-import Game.Werewolf.Test.Util--import Prelude hiding (round)--import Test.QuickCheck--instance Arbitrary Game where-    arbitrary = do-        game    <- newGame <$> arbitraryPlayerSet-        stage'  <- arbitrary--        return $ game & stage .~ stage'--instance Arbitrary Stage where-    arbitrary = elements . nub $ allStages \\ [GameOver, Sunrise, Sunset]--instance Arbitrary Player where-    arbitrary = newPlayer <$> arbitrary <*> arbitrary--instance Arbitrary State where-    arbitrary = elements [Alive, Dead]--instance Arbitrary Role where-    arbitrary = elements allRoles--instance Arbitrary Allegiance where-    arbitrary = elements [Villagers, Werewolves]--instance Arbitrary Text where-    arbitrary = T.pack <$> vectorOf 6 (elements ['a'..'z'])--newtype GameAtGameOver = GameAtGameOver Game-    deriving (Eq, Show)--instance Arbitrary GameAtGameOver where-    arbitrary = do-        game <- arbitrary--        return $ GameAtGameOver (game & stage .~ GameOver)--newtype GameAtHuntersTurn = GameAtHuntersTurn Game-    deriving (Eq, Show)--instance Arbitrary GameAtHuntersTurn where-    arbitrary = do-        game <- arbitrary-        turn <- elements [HuntersTurn1, HuntersTurn2]--        return $ GameAtHuntersTurn (game & stage .~ turn)--newtype GameAtOrphansTurn = GameAtOrphansTurn Game-    deriving (Eq, Show)--instance Arbitrary GameAtOrphansTurn where-    arbitrary = do-        game <- arbitrary--        return $ GameAtOrphansTurn (game & stage .~ OrphansTurn)--newtype GameAtProtectorsTurn = GameAtProtectorsTurn Game-    deriving (Eq, Show)--instance Arbitrary GameAtProtectorsTurn where-    arbitrary = do-        game <- arbitrary--        return $ GameAtProtectorsTurn (game & stage .~ ProtectorsTurn)--newtype GameAtScapegoatsTurn = GameAtScapegoatsTurn Game-    deriving (Eq, Show)--instance Arbitrary GameAtScapegoatsTurn where-    arbitrary = do-        (GameWithConflictingVote game) <- arbitrary--        return $ GameAtScapegoatsTurn (run_ checkStage game)--newtype GameAtSeersTurn = GameAtSeersTurn Game-    deriving (Eq, Show)--instance Arbitrary GameAtSeersTurn where-    arbitrary = do-        game <- arbitrary--        return $ GameAtSeersTurn (game & stage .~ SeersTurn)--newtype GameAtSunrise = GameAtSunrise Game-    deriving (Eq, Show)--instance Arbitrary GameAtSunrise where-    arbitrary = do-        game <- arbitrary--        return $ GameAtSunrise (game & stage .~ Sunrise)--newtype GameAtVillagesTurn = GameAtVillagesTurn Game-    deriving (Eq, Show)--instance Arbitrary GameAtVillagesTurn where-    arbitrary = do-        game <- arbitrary--        return $ GameAtVillagesTurn (game & stage .~ VillagesTurn)--newtype GameAtWerewolvesTurn = GameAtWerewolvesTurn Game-    deriving (Eq, Show)--instance Arbitrary GameAtWerewolvesTurn where-    arbitrary = do-        game <- arbitrary--        return $ GameAtWerewolvesTurn (game & stage .~ WerewolvesTurn)--newtype GameAtWitchsTurn = GameAtWitchsTurn Game-    deriving (Eq, Show)--instance Arbitrary GameAtWitchsTurn where-    arbitrary = do-        game <- arbitrary--        return $ GameAtWitchsTurn (game & stage .~ WitchsTurn)--newtype GameWithAllowedVoters = GameWithAllowedVoters Game-    deriving (Eq, Show)--instance Arbitrary GameWithAllowedVoters where-    arbitrary = do-        (GameAtScapegoatsTurn game) <- arbitrary-        (Blind command)             <- arbitraryScapegoatChooseCommand game--        return $ GameWithAllowedVoters (run_ (apply command) game)--newtype GameWithConflictingVote = GameWithConflictingVote Game-    deriving (Eq, Show)--instance Arbitrary GameWithConflictingVote where-    arbitrary = do-        (GameWithLynchVotes game) <- suchThat arbitrary $ \(GameWithLynchVotes game) ->-            length (getVoteResult game) > 1--        return $ GameWithConflictingVote game--newtype GameWithDevourEvent = GameWithDevourEvent Game-    deriving (Eq, Show)--instance Arbitrary GameWithDevourEvent where-    arbitrary = do-        (GameWithDevourVotes game) <- suchThat arbitrary $ \(GameWithDevourVotes game) ->-            length (getVoteResult game) == 1--        return $ GameWithDevourEvent (run_ checkStage game)--newtype GameWithDevourVotes = GameWithDevourVotes Game-    deriving (Eq, Show)--instance Arbitrary GameWithDevourVotes where-    arbitrary = do-        game <- arbitrary--        GameWithDevourVotes <$> runArbitraryCommands (length $ game ^. players) (game & stage .~ WerewolvesTurn)--newtype GameWithHeal = GameWithHeal Game-    deriving (Eq, Show)--instance Arbitrary GameWithHeal where-    arbitrary = do-        (GameWithDevourEvent game)  <- arbitrary-        (Blind command)             <- arbitraryHealCommand game--        return $ GameWithHeal (run_ (apply command) game)--newtype GameWithJesterRevealed = GameWithJesterRevealed Game-    deriving (Eq, Show)--instance Arbitrary GameWithJesterRevealed where-    arbitrary = do-        game            <- arbitrary-        let jestersName = game ^?! players . jesters . name-        let game'       = game & jesterRevealed .~ True & allowedVoters %~ delete jestersName--        return $ GameWithJesterRevealed game'--newtype GameWithJesterRevealedAtVillagesTurn = GameWithJesterRevealedAtVillagesTurn Game-    deriving (Eq, Show)--instance Arbitrary GameWithJesterRevealedAtVillagesTurn where-    arbitrary = do-        (GameWithJesterRevealed game) <- arbitrary--        return $ GameWithJesterRevealedAtVillagesTurn (game & stage .~ VillagesTurn)--newtype GameWithLynchVotes = GameWithLynchVotes Game-    deriving (Eq, Show)--instance Arbitrary GameWithLynchVotes where-    arbitrary = do-        game <- arbitrary--        GameWithLynchVotes <$> runArbitraryCommands (length $ game ^. players) (game & stage .~ VillagesTurn)--newtype GameWithMajorityVote = GameWithMajorityVote Game-    deriving (Eq, Show)--instance Arbitrary GameWithMajorityVote where-    arbitrary = do-        (GameWithLynchVotes game) <- suchThat arbitrary $ \(GameWithLynchVotes game) ->-            length (getVoteResult game) == 1--        return $ GameWithMajorityVote game--newtype GameWithPoison = GameWithPoison Game-    deriving (Eq, Show)--instance Arbitrary GameWithPoison where-    arbitrary = do-        game            <- arbitrary-        let game'       = game & stage .~ WitchsTurn-        (Blind command) <- arbitraryPoisonCommand game'--        return $ GameWithPoison (run_ (apply command) game')--newtype GameWithProtect = GameWithProtect Game-    deriving (Eq, Show)--instance Arbitrary GameWithProtect where-    arbitrary = do-        game            <- arbitrary-        let game'       = game & stage .~ ProtectorsTurn-        (Blind command) <- arbitraryProtectCommand game'--        return $ GameWithProtect (run_ (apply command) game')--arbitraryPlayerSet :: Gen [Player]-arbitraryPlayerSet = do-    n       <- choose (14, 30)-    players <- nubOn (view name) <$> infiniteList--    let playersWithRestrictedRole = map (\role' -> players ^?! traverse . filteredBy role role') restrictedRoles--    let simpleWerewolves'   = players ^.. taking (n `quot` 5 + 1) simpleWerewolves-    let simpleVillagers'    = players ^.. taking (n - length restrictedRoles - length simpleWerewolves') simpleVillagers--    return $ playersWithRestrictedRole ++ simpleVillagers' ++ simpleWerewolves'--arbitraryCommand :: Game -> Gen (Blind Command)-arbitraryCommand game = case game ^. stage of-    FerinasGrunt        -> return $ Blind noopCommand-    GameOver            -> return $ Blind noopCommand-    HuntersTurn1        -> arbitraryHunterChooseCommand game-    HuntersTurn2        -> arbitraryHunterChooseCommand game-    Lynching            -> return $ Blind noopCommand-    OrphansTurn         -> arbitraryOrphanChooseCommand game-    ProtectorsTurn      -> arbitraryProtectCommand game-    ScapegoatsTurn      -> arbitraryScapegoatChooseCommand game-    SeersTurn           -> arbitrarySeeCommand game-    Sunrise             -> return $ Blind noopCommand-    Sunset              -> return $ Blind noopCommand-    VillageDrunksTurn   -> return $ Blind noopCommand-    VillagesTurn        -> arbitraryVillagerVoteCommand game-    WerewolvesTurn      -> arbitraryWerewolfVoteCommand game-    WitchsTurn          -> oneof-        [ arbitraryHealCommand game-        , arbitraryPassCommand game-        , arbitraryPoisonCommand game-        ]--arbitraryHunterChooseCommand :: Game -> Gen (Blind Command)-arbitraryHunterChooseCommand game = do-    let hunter  = game ^?! players . hunters-    target      <- arbitraryPlayer game--    return . Blind $ Hunter.chooseCommand (hunter ^. name) (target ^. name)--arbitraryOrphanChooseCommand :: Game -> Gen (Blind Command)-arbitraryOrphanChooseCommand game = do-    let orphan  = game ^?! players . orphans-    target      <- suchThat (arbitraryPlayer game) (orphan /=)--    return . Blind $ Orphan.chooseCommand (orphan ^. name) (target ^. name)--arbitraryScapegoatChooseCommand :: Game -> Gen (Blind Command)-arbitraryScapegoatChooseCommand game = do-    let scapegoatsName  = game ^?! players . scapegoats . name-    (NonEmpty players') <- NonEmpty <$> sublistOf (game ^.. players . traverse . alive)--    return . Blind $ Scapegoat.chooseCommand scapegoatsName (players' ^.. names)--arbitraryHealCommand :: Game -> Gen (Blind Command)-arbitraryHealCommand game = do-    let witchsName = game ^?! players . witches . name--    return . Blind $ if game ^. healUsed-        then noopCommand-        else healCommand witchsName--arbitraryPassCommand :: Game -> Gen (Blind Command)-arbitraryPassCommand game = do-    let witchsName = game ^?! players . witches . name--    return . Blind $ passCommand witchsName--arbitraryPoisonCommand :: Game -> Gen (Blind Command)-arbitraryPoisonCommand game = do-    let witchsName  = game ^?! players . witches . name-    target          <- arbitraryPlayer game--    return $ if isJust (game ^. poison)-        then Blind noopCommand-        else Blind $ poisonCommand witchsName (target ^. name)--arbitraryProtectCommand :: Game -> Gen (Blind Command)-arbitraryProtectCommand game = do-    let protector    = game ^?! players . protectors-    -- TODO (hjw): add suchThat (/= priorProtect)-    target          <- suchThat (arbitraryPlayer game) (protector /=)--    return $ if isJust (game ^. protect)-        then Blind noopCommand-        else Blind $ protectCommand (protector ^. name) (target ^. name)--arbitraryQuitCommand :: Game -> Gen (Blind Command)-arbitraryQuitCommand game = do-    let applicableCallerNames = game ^.. players . traverse . alive . name--    if null applicableCallerNames-        then return $ Blind noopCommand-        else elements applicableCallerNames >>= \callersName ->-            return . Blind $ quitCommand callersName--arbitrarySeeCommand :: Game -> Gen (Blind Command)-arbitrarySeeCommand game = do-    let seersName   = game ^?! players . seers . name-    target          <- arbitraryPlayer game--    return $ if isJust (game ^. see)-        then Blind noopCommand-        else Blind $ seeCommand seersName (target ^. name)--arbitraryWerewolfVoteCommand :: Game -> Gen (Blind Command)-arbitraryWerewolfVoteCommand game = do-    let applicableCallerNames   = getPendingVoters game ^.. werewolves . name-    target                      <- suchThat (arbitraryPlayer game) $ isn't werewolf--    if null applicableCallerNames-        then return $ Blind noopCommand-        else elements applicableCallerNames >>= \callerName ->-            return . Blind $ Werewolf.voteCommand callerName (target ^. name)--arbitraryVillagerVoteCommand :: Game -> Gen (Blind Command)-arbitraryVillagerVoteCommand game = do-    let applicableCallerNames   = (game ^. allowedVoters) `intersect` (getPendingVoters game ^.. names)-    target                      <- arbitraryPlayer game--    if null applicableCallerNames-        then return $ Blind noopCommand-        else elements applicableCallerNames >>= \callerName ->-            return . Blind $ Villager.voteCommand callerName (target ^. name)--runArbitraryCommands :: Int -> Game -> Gen Game-runArbitraryCommands n = iterateM n $ \game -> do-    (Blind command) <- arbitraryCommand game--    return $ run_ (apply command) game--iterateM :: Monad m => Int -> (a -> m a) -> a -> m a-iterateM 0 _ a = return a-iterateM n f a = f a >>= iterateM (n - 1) f--arbitraryPlayer :: Game -> Gen Player-arbitraryPlayer game = elements $ game ^.. players . traverse . alive--arbitraryWerewolf :: Game -> Gen Player-arbitraryWerewolf game = elements $ game ^.. players . werewolves . alive

@@ -1,34 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Command-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Game.Werewolf.Test.Command (-    -- * Tests-    allCommandTests,-) where--import Game.Werewolf.Test.Command.Choose-import Game.Werewolf.Test.Command.Heal-import Game.Werewolf.Test.Command.Pass-import Game.Werewolf.Test.Command.Poison-import Game.Werewolf.Test.Command.Protect-import Game.Werewolf.Test.Command.Quit-import Game.Werewolf.Test.Command.See-import Game.Werewolf.Test.Command.Vote--import Test.Tasty--allCommandTests :: [TestTree]-allCommandTests = concat-    [ allChooseCommandTests-    , allHealCommandTests-    , allPassCommandTests-    , allPoisonCommandTests-    , allProtectCommandTests-    , allQuitCommandTests-    , allSeeCommandTests-    , allVoteCommandTests-    ]

@@ -1,199 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Command.Choose-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--{-# LANGUAGE OverloadedStrings #-}--module Game.Werewolf.Test.Command.Choose (-    -- * Tests-    allChooseCommandTests,-) where--import Control.Lens       hiding (elements, isn't)-import Control.Lens.Extra--import Game.Werewolf-import Game.Werewolf.Command.Hunter    as Hunter-import Game.Werewolf.Command.Orphan    as Orphan-import Game.Werewolf.Command.Scapegoat as Scapegoat-import Game.Werewolf.Test.Arbitrary-import Game.Werewolf.Test.Util--import Test.Tasty-import Test.Tasty.QuickCheck--allChooseCommandTests :: [TestTree]-allChooseCommandTests =-    [ testProperty "hunter choose command errors when game is over"                 prop_hunterChooseCommandErrorsWhenGameIsOver-    , testProperty "hunter choose command errors when caller does not exist"        prop_hunterChooseCommandErrorsWhenCallerDoesNotExist-    , testProperty "hunter choose command errors when any target does not exist"    prop_hunterChooseCommandErrorsWhenTargetDoesNotExist-    , testProperty "hunter choose command errors when any target is dead"           prop_hunterChooseCommandErrorsWhenTargetIsDead-    , testProperty "hunter choose command errors when not hunter's turn"            prop_hunterChooseCommandErrorsWhenNotHuntersTurn-    , testProperty "hunter choose command errors when caller not hunter"            prop_hunterChooseCommandErrorsWhenCallerNotHunter--    , testProperty "orphan choose command errors when game is over"             prop_orphanChooseCommandErrorsWhenGameIsOver-    , testProperty "orphan choose command errors when caller does not exist"    prop_orphanChooseCommandErrorsWhenCallerDoesNotExist-    , testProperty "orphan choose command errors when target does not exist"    prop_orphanChooseCommandErrorsWhenTargetDoesNotExist-    , testProperty "orphan choose command errors when caller is dead"           prop_orphanChooseCommandErrorsWhenCallerIsDead-    , testProperty "orphan choose command errors when target is dead"           prop_orphanChooseCommandErrorsWhenTargetIsDead-    , testProperty "orphan choose command errors when target is caller"         prop_orphanChooseCommandErrorsWhenTargetIsCaller-    , testProperty "orphan choose command errors when not orphan's turn"        prop_orphanChooseCommandErrorsWhenNotOrphansTurn-    , testProperty "orphan choose command errors when caller not orphan"        prop_orphanChooseCommandErrorsWhenCallerNotOrphan--    , testProperty "scapegoat choose command errors when game is over"              prop_scapegoatChooseCommandErrorsWhenGameIsOver-    , testProperty "scapegoat choose command errors when caller does not exist"     prop_scapegoatChooseCommandErrorsWhenCallerDoesNotExist-    , testProperty "scapegoat choose command errors when any target does not exist" prop_scapegoatChooseCommandErrorsWhenAnyTargetDoesNotExist-    , testProperty "scapegoat choose command errors when any target is dead"        prop_scapegoatChooseCommandErrorsWhenAnyTargetIsDead-    , testProperty "scapegoat choose command errors when not scapegoat's turn"      prop_scapegoatChooseCommandErrorsWhenNotScapegoatsTurn-    , testProperty "scapegoat choose command errors when caller not scapegoat"      prop_scapegoatChooseCommandErrorsWhenCallerNotScapegoat-    ]--prop_hunterChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_hunterChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =-    forAll (arbitraryHunterChooseCommand game) $ verbose_runCommandErrors game . getBlind--prop_hunterChooseCommandErrorsWhenCallerDoesNotExist :: GameAtHuntersTurn -> Player -> Property-prop_hunterChooseCommandErrorsWhenCallerDoesNotExist (GameAtHuntersTurn game) caller =-    forAll (arbitraryPlayer game) $ \target -> do-        let command = Hunter.chooseCommand (caller ^. name) (target ^. name)--        not (doesPlayerExist (caller ^. name) game)-            ==> verbose_runCommandErrors game command--prop_hunterChooseCommandErrorsWhenTargetDoesNotExist :: GameAtHuntersTurn -> Player -> Property-prop_hunterChooseCommandErrorsWhenTargetDoesNotExist (GameAtHuntersTurn game) target = do-    let hunter  = game ^?! players . hunters-    let command = Hunter.chooseCommand (hunter ^. name) (target ^. name)--    not (doesPlayerExist (target ^. name) game)-        ==> verbose_runCommandErrors game command--prop_hunterChooseCommandErrorsWhenTargetIsDead :: GameAtHuntersTurn -> Property-prop_hunterChooseCommandErrorsWhenTargetIsDead (GameAtHuntersTurn game) = do-    let hunter = game ^?! players . hunters--    forAll (arbitraryPlayer game) $ \target -> do-        let game'   = killPlayer (target ^. name) game-        let command = Hunter.chooseCommand (hunter ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_hunterChooseCommandErrorsWhenNotHuntersTurn :: Game -> Property-prop_hunterChooseCommandErrorsWhenNotHuntersTurn game =-    hasn't (stage . _HuntersTurn1) game && hasn't (stage . _HuntersTurn2) game-    ==> forAll (arbitraryHunterChooseCommand game) $ verbose_runCommandErrors game . getBlind--prop_hunterChooseCommandErrorsWhenCallerNotHunter :: GameAtHuntersTurn -> Property-prop_hunterChooseCommandErrorsWhenCallerNotHunter (GameAtHuntersTurn game) =-    forAll (suchThat (arbitraryPlayer game) (isn't hunter)) $ \caller ->-    forAll (arbitraryPlayer game) $ \target -> do-        let command = Hunter.chooseCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_orphanChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_orphanChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =-    forAll (arbitraryOrphanChooseCommand game) $ verbose_runCommandErrors game . getBlind--prop_orphanChooseCommandErrorsWhenCallerDoesNotExist :: GameAtOrphansTurn -> Player -> Property-prop_orphanChooseCommandErrorsWhenCallerDoesNotExist (GameAtOrphansTurn game) caller =-    forAll (arbitraryPlayer game) $ \target -> do-        let command = Orphan.chooseCommand (caller ^. name) (target ^. name)--        not (doesPlayerExist (caller ^. name) game)-            ==> verbose_runCommandErrors game command--prop_orphanChooseCommandErrorsWhenTargetDoesNotExist :: GameAtOrphansTurn -> Player -> Property-prop_orphanChooseCommandErrorsWhenTargetDoesNotExist (GameAtOrphansTurn game) target = do-    let orphan  = game ^?! players . orphans-    let command = Orphan.chooseCommand (orphan ^. name) (target ^. name)--    not (doesPlayerExist (target ^. name) game)-        ==> verbose_runCommandErrors game command--prop_orphanChooseCommandErrorsWhenCallerIsDead :: GameAtOrphansTurn -> Property-prop_orphanChooseCommandErrorsWhenCallerIsDead (GameAtOrphansTurn game) = do-    let orphan  = game ^?! players . orphans-    let game'   = killPlayer (orphan ^. name) game--    forAll (arbitraryPlayer game') $ \target -> do-        let command = Orphan.chooseCommand (orphan ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_orphanChooseCommandErrorsWhenTargetIsDead :: GameAtOrphansTurn -> Property-prop_orphanChooseCommandErrorsWhenTargetIsDead (GameAtOrphansTurn game) = do-    let orphan = game ^?! players . orphans--    forAll (arbitraryPlayer game) $ \target -> do-        let game'   = killPlayer (target ^. name) game-        let command = Orphan.chooseCommand (orphan ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_orphanChooseCommandErrorsWhenTargetIsCaller :: GameAtOrphansTurn -> Property-prop_orphanChooseCommandErrorsWhenTargetIsCaller (GameAtOrphansTurn game) = do-    let orphan  = game ^?! players . orphans-    let command = Orphan.chooseCommand (orphan ^. name) (orphan ^. name)--    verbose_runCommandErrors game command--prop_orphanChooseCommandErrorsWhenNotOrphansTurn :: Game -> Property-prop_orphanChooseCommandErrorsWhenNotOrphansTurn game =-    hasn't (stage . _OrphansTurn) game-    ==> forAll (arbitraryOrphanChooseCommand game) $ verbose_runCommandErrors game . getBlind--prop_orphanChooseCommandErrorsWhenCallerNotOrphan :: GameAtOrphansTurn -> Property-prop_orphanChooseCommandErrorsWhenCallerNotOrphan (GameAtOrphansTurn game) =-    forAll (suchThat (arbitraryPlayer game) (isn't orphan)) $ \caller ->-    forAll (arbitraryPlayer game) $ \target -> do-        let command = Orphan.chooseCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_scapegoatChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_scapegoatChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =-    forAll (arbitraryScapegoatChooseCommand game) $ verbose_runCommandErrors game . getBlind--prop_scapegoatChooseCommandErrorsWhenCallerDoesNotExist :: GameAtScapegoatsTurn -> Player -> Property-prop_scapegoatChooseCommandErrorsWhenCallerDoesNotExist (GameAtScapegoatsTurn game) caller =-    forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> do-        let command = Scapegoat.chooseCommand (caller ^. name) (targets ^.. names)--        not (doesPlayerExist (caller ^. name) game)-            ==> verbose_runCommandErrors game command--prop_scapegoatChooseCommandErrorsWhenAnyTargetDoesNotExist :: GameAtScapegoatsTurn -> Player -> Property-prop_scapegoatChooseCommandErrorsWhenAnyTargetDoesNotExist (GameAtScapegoatsTurn game) target = do-    let scapegoat   = game ^?! players . scapegoats-    let command     = Scapegoat.chooseCommand (scapegoat ^. name) [target ^. name]--    not (doesPlayerExist (target ^. name) game)-        ==> verbose_runCommandErrors game command--prop_scapegoatChooseCommandErrorsWhenAnyTargetIsDead :: GameAtScapegoatsTurn -> Property-prop_scapegoatChooseCommandErrorsWhenAnyTargetIsDead (GameAtScapegoatsTurn game) = do-    let scapegoat = game ^?! players . scapegoats--    forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) ->-        forAll (elements targets) $ \target -> do-            let game'   = killPlayer (target ^. name) game-            let command = Scapegoat.chooseCommand (scapegoat ^. name) (targets ^.. names)--            verbose_runCommandErrors game' command--prop_scapegoatChooseCommandErrorsWhenNotScapegoatsTurn :: Game -> Property-prop_scapegoatChooseCommandErrorsWhenNotScapegoatsTurn game =-    hasn't (stage . _ScapegoatsTurn) game-    ==> forAll (arbitraryScapegoatChooseCommand game) $ verbose_runCommandErrors game . getBlind--prop_scapegoatChooseCommandErrorsWhenCallerNotScapegoat :: GameAtScapegoatsTurn -> Property-prop_scapegoatChooseCommandErrorsWhenCallerNotScapegoat (GameAtScapegoatsTurn game) =-    forAll (suchThat (arbitraryPlayer game) (isn't scapegoat)) $ \caller ->-    forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> do-        let command = Scapegoat.chooseCommand (caller ^. name) (targets ^.. names)--        verbose_runCommandErrors game command

@@ -1,74 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Command.Heal-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Game.Werewolf.Test.Command.Heal (-    -- * Tests-    allHealCommandTests,-) where--import Control.Lens       hiding (isn't)-import Control.Lens.Extra--import Game.Werewolf-import Game.Werewolf.Command.Witch-import Game.Werewolf.Test.Arbitrary-import Game.Werewolf.Test.Util--import Test.Tasty-import Test.Tasty.QuickCheck--allHealCommandTests :: [TestTree]-allHealCommandTests =-    [ testProperty "heal command errors when game is over"          prop_healCommandErrorsWhenGameIsOver-    , testProperty "heal command errors when caller does not exist" prop_healCommandErrorsWhenCallerDoesNotExist-    , testProperty "heal command errors when caller is dead"        prop_healCommandErrorsWhenCallerIsDead-    , testProperty "heal command errors when no target is devoured" prop_healCommandErrorsWhenNoTargetIsDevoured-    , testProperty "heal command errors when not witch's turn"      prop_healCommandErrorsWhenNotWitchsTurn-    , testProperty "heal command errors when caller has healed"     prop_healCommandErrorsWhenCallerHasHealed-    , testProperty "heal command errors when caller not witch"      prop_healCommandErrorsWhenCallerNotWitch-    ]--prop_healCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_healCommandErrorsWhenGameIsOver (GameAtGameOver game) = verbose_runHealCommandErrors game--prop_healCommandErrorsWhenCallerDoesNotExist :: GameWithDevourEvent -> Player -> Property-prop_healCommandErrorsWhenCallerDoesNotExist (GameWithDevourEvent game) caller =-    not (doesPlayerExist (caller ^. name) game)-    ==> verbose_runCommandErrors game (healCommand (caller ^. name))--prop_healCommandErrorsWhenCallerIsDead :: GameWithDevourEvent -> Property-prop_healCommandErrorsWhenCallerIsDead (GameWithDevourEvent game) =-    forAll (arbitraryPlayer game) $ \caller -> do-        let game'   = killPlayer (caller ^. name) game-        let command = healCommand (caller ^. name)--        verbose_runCommandErrors game' command--prop_healCommandErrorsWhenNoTargetIsDevoured :: GameAtWitchsTurn -> Property-prop_healCommandErrorsWhenNoTargetIsDevoured (GameAtWitchsTurn game) = verbose_runHealCommandErrors game--prop_healCommandErrorsWhenNotWitchsTurn :: Game -> Property-prop_healCommandErrorsWhenNotWitchsTurn game =-    hasn't (stage . _WitchsTurn) game-    ==> verbose_runHealCommandErrors game--prop_healCommandErrorsWhenCallerHasHealed :: GameWithHeal -> Property-prop_healCommandErrorsWhenCallerHasHealed (GameWithHeal game) = verbose_runHealCommandErrors game--prop_healCommandErrorsWhenCallerNotWitch :: GameWithDevourEvent -> Property-prop_healCommandErrorsWhenCallerNotWitch (GameWithDevourEvent game) =-    forAll (suchThat (arbitraryPlayer game) (isn't witch)) $ \caller -> do-        let command = healCommand (caller ^. name)--        verbose_runCommandErrors game command--verbose_runHealCommandErrors :: Game -> Property-verbose_runHealCommandErrors game = do-    let witch   = game ^?! players . witches-    let command = healCommand $ witch ^. name--    verbose_runCommandErrors game command

@@ -1,51 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Command.Pass-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Game.Werewolf.Test.Command.Pass (-    -- * Tests-    allPassCommandTests,-) where--import Control.Lens hiding (isn't)--import Game.Werewolf-import Game.Werewolf.Command.Witch-import Game.Werewolf.Test.Arbitrary-import Game.Werewolf.Test.Util--import Test.Tasty-import Test.Tasty.QuickCheck--allPassCommandTests :: [TestTree]-allPassCommandTests =-    [ testProperty "witch pass command errors when game is over"            prop_witchPassCommandErrorsWhenGameIsOver-    , testProperty "witch pass command errors when caller does not exist"   prop_witchPassCommandErrorsWhenCallerDoesNotExist-    , testProperty "witch pass command errors when caller is dead"          prop_witchPassCommandErrorsWhenCallerIsDead-    , testProperty "witch pass command errors when not witch's turn"        prop_witchPassCommandErrorsWhenNotWitchsTurn-    ]--prop_witchPassCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_witchPassCommandErrorsWhenGameIsOver (GameAtGameOver game) =-    forAll (arbitraryPassCommand game) $ verbose_runCommandErrors game . getBlind--prop_witchPassCommandErrorsWhenCallerDoesNotExist :: GameAtWitchsTurn -> Player -> Property-prop_witchPassCommandErrorsWhenCallerDoesNotExist (GameAtWitchsTurn game) caller =-    not (doesPlayerExist (caller ^. name) game)-    ==> verbose_runCommandErrors game (passCommand $ caller ^. name)--prop_witchPassCommandErrorsWhenCallerIsDead :: GameAtWitchsTurn -> Property-prop_witchPassCommandErrorsWhenCallerIsDead (GameAtWitchsTurn game) = do-    let witchsName  = game ^?! players . witches . name-    let game'       = killPlayer witchsName game-    let command     = passCommand witchsName--    verbose_runCommandErrors game' command--prop_witchPassCommandErrorsWhenNotWitchsTurn :: Game -> Property-prop_witchPassCommandErrorsWhenNotWitchsTurn game =-    hasn't (stage . _WitchsTurn) game-    ==> forAll (arbitraryPassCommand game) $ verbose_runCommandErrors game . getBlind

@@ -1,105 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Command.Poison-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Game.Werewolf.Test.Command.Poison (-    -- * Tests-    allPoisonCommandTests,-) where--import Control.Lens       hiding (isn't)-import Control.Lens.Extra--import Game.Werewolf-import Game.Werewolf.Command.Witch-import Game.Werewolf.Test.Arbitrary-import Game.Werewolf.Test.Util--import Test.Tasty-import Test.Tasty.QuickCheck--allPoisonCommandTests :: [TestTree]-allPoisonCommandTests =-    [ testProperty "poison command errors when game is over"            prop_poisonCommandErrorsWhenGameIsOver-    , testProperty "poison command errors when caller does not exist"   prop_poisonCommandErrorsWhenCallerDoesNotExist-    , testProperty "poison command errors when target does not exist"   prop_poisonCommandErrorsWhenTargetDoesNotExist-    , testProperty "poison command errors when caller is dead"          prop_poisonCommandErrorsWhenCallerIsDead-    , testProperty "poison command errors when target is dead"          prop_poisonCommandErrorsWhenTargetIsDead-    , testProperty "poison command errors when target is devoured"      prop_poisonCommandErrorsWhenTargetIsDevoured-    , testProperty "poison command errors when not witch's turn"        prop_poisonCommandErrorsWhenNotWitchsTurn-    , testProperty "poison command errors when caller has poisoned"     prop_poisonCommandErrorsWhenCallerHasPoisoned-    , testProperty "poison command errors when caller not witch"        prop_poisonCommandErrorsWhenCallerNotWitch-    ]--prop_poisonCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_poisonCommandErrorsWhenGameIsOver (GameAtGameOver game) =-    forAll (arbitraryPoisonCommand game) $ verbose_runCommandErrors game . getBlind--prop_poisonCommandErrorsWhenCallerDoesNotExist :: GameAtWitchsTurn -> Player -> Property-prop_poisonCommandErrorsWhenCallerDoesNotExist (GameAtWitchsTurn game) caller =-    not (doesPlayerExist (caller ^. name) game)-    ==> forAll (arbitraryPlayer game) $ \target -> do-        let command = poisonCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_poisonCommandErrorsWhenTargetDoesNotExist :: GameAtWitchsTurn -> Player -> Property-prop_poisonCommandErrorsWhenTargetDoesNotExist (GameAtWitchsTurn game) target = do-    let witch   = game ^?! players . witches-    let command = poisonCommand (witch ^. name) (target ^. name)--    not (doesPlayerExist (target ^. name) game)-        ==> verbose_runCommandErrors game command--prop_poisonCommandErrorsWhenCallerIsDead :: GameAtWitchsTurn -> Property-prop_poisonCommandErrorsWhenCallerIsDead (GameAtWitchsTurn game) = do-    let witch = game ^?! players . witches--    forAll (arbitraryPlayer game) $ \target -> do-        let game'   = killPlayer (witch ^. name) game-        let command = poisonCommand (witch ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_poisonCommandErrorsWhenTargetIsDead :: GameAtWitchsTurn -> Property-prop_poisonCommandErrorsWhenTargetIsDead (GameAtWitchsTurn game) = do-    let witch = game ^?! players . witches--    forAll (arbitraryPlayer game) $ \target -> do-        let game'   = killPlayer (target ^. name) game-        let command = poisonCommand (witch ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_poisonCommandErrorsWhenTargetIsDevoured :: GameWithDevourEvent -> Property-prop_poisonCommandErrorsWhenTargetIsDevoured (GameWithDevourEvent game) = do-    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 =-    hasn't (stage . _WitchsTurn) game-    ==> forAll (arbitraryPoisonCommand game) $ verbose_runCommandErrors game . getBlind--prop_poisonCommandErrorsWhenCallerHasPoisoned :: GameWithPoison -> Property-prop_poisonCommandErrorsWhenCallerHasPoisoned (GameWithPoison game) = do-    let witch = game ^?! players . witches--    forAll (arbitraryPlayer game) $ \target -> do-        let command = poisonCommand (witch ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_poisonCommandErrorsWhenCallerNotWitch :: GameAtWitchsTurn -> Property-prop_poisonCommandErrorsWhenCallerNotWitch (GameAtWitchsTurn game) =-    forAll (suchThat (arbitraryPlayer game) (isn't witch)) $ \caller ->-    forAll (arbitraryPlayer game) $ \target -> do-        let command = poisonCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command

@@ -1,98 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Command.Protect-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Game.Werewolf.Test.Command.Protect (-    -- * Tests-    allProtectCommandTests,-) where--import Control.Lens       hiding (isn't)-import Control.Lens.Extra--import Data.Maybe--import Game.Werewolf-import Game.Werewolf.Command.Protector-import Game.Werewolf.Test.Arbitrary-import Game.Werewolf.Test.Util--import Test.Tasty-import Test.Tasty.QuickCheck--allProtectCommandTests :: [TestTree]-allProtectCommandTests =-    [ testProperty "protect command errors when game is over"               prop_protectCommandErrorsWhenGameIsOver-    , testProperty "protect command errors when caller does not exist"      prop_protectCommandErrorsWhenCallerDoesNotExist-    , testProperty "protect command errors when target does not exist"      prop_protectCommandErrorsWhenTargetDoesNotExist-    , testProperty "protect command errors when caller is dead"             prop_protectCommandErrorsWhenCallerIsDead-    , testProperty "protect command errors when target is dead"             prop_protectCommandErrorsWhenTargetIsDead-    , testProperty "protect command errors when not protector's turn"       prop_protectCommandErrorsWhenNotProtectorsTurn-    , testProperty "protect command errors when caller not protector"       prop_protectCommandErrorsWhenCallerNotProtector-    , testProperty "protect command errors when target is prior protect"    prop_protectCommandErrorsWhenTargetIsPriorProtect-    ]--prop_protectCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_protectCommandErrorsWhenGameIsOver (GameAtGameOver game) =-    forAll (arbitraryProtectCommand game) $ verbose_runCommandErrors game . getBlind--prop_protectCommandErrorsWhenCallerDoesNotExist :: GameAtProtectorsTurn -> Player -> Property-prop_protectCommandErrorsWhenCallerDoesNotExist (GameAtProtectorsTurn game) caller =-    not (doesPlayerExist (caller ^. name) game)-    ==> forAll (arbitraryPlayer game) $ \target -> do-        let command = protectCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_protectCommandErrorsWhenTargetDoesNotExist :: GameAtProtectorsTurn -> Player -> Property-prop_protectCommandErrorsWhenTargetDoesNotExist (GameAtProtectorsTurn game) target = do-    let protector   = game ^?! players . protectors-    let command     = protectCommand (protector ^. name) (target ^. name)--    not (doesPlayerExist (target ^. name) game)-        ==> verbose_runCommandErrors game command--prop_protectCommandErrorsWhenCallerIsDead :: GameAtProtectorsTurn -> Property-prop_protectCommandErrorsWhenCallerIsDead (GameAtProtectorsTurn game) = do-    let protector   = game ^?! players . protectors-    let game'       = killPlayer (protector ^. name) game--    forAll (arbitraryPlayer game') $ \target -> do-        let command = protectCommand (protector ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_protectCommandErrorsWhenTargetIsDead :: GameAtProtectorsTurn -> Property-prop_protectCommandErrorsWhenTargetIsDead (GameAtProtectorsTurn game) = do-    let protector = game ^?! players . protectors--    forAll (arbitraryPlayer game) $ \target -> do-        let game'   = killPlayer (target ^. name) game-        let command = protectCommand (protector ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_protectCommandErrorsWhenNotProtectorsTurn :: Game -> Property-prop_protectCommandErrorsWhenNotProtectorsTurn game =-    hasn't (stage . _ProtectorsTurn) game-    ==> forAll (arbitraryProtectCommand game) $ verbose_runCommandErrors game . getBlind--prop_protectCommandErrorsWhenCallerNotProtector :: GameAtProtectorsTurn -> Property-prop_protectCommandErrorsWhenCallerNotProtector (GameAtProtectorsTurn game) =-    forAll (suchThat (arbitraryPlayer game) (isn't protector)) $ \caller ->-    forAll (arbitraryPlayer game) $ \target -> do-        let command = protectCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_protectCommandErrorsWhenTargetIsPriorProtect :: GameWithProtect -> Property-prop_protectCommandErrorsWhenTargetIsPriorProtect (GameWithProtect game) = do-    let game' = game & protect .~ Nothing--    let protector   = game ^?! players . protectors-    let command     = protectCommand (protector ^. name) (fromJust $ game' ^. priorProtect)--    verbose_runCommandErrors game' command

@@ -1,45 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Command.Quit-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Game.Werewolf.Test.Command.Quit (-    -- * Tests-    allQuitCommandTests,-) where--import Control.Lens--import Game.Werewolf-import Game.Werewolf.Command.Global-import Game.Werewolf.Test.Arbitrary-import Game.Werewolf.Test.Util--import Test.Tasty-import Test.Tasty.QuickCheck--allQuitCommandTests :: [TestTree]-allQuitCommandTests =-    [ 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-    ]--prop_quitCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_quitCommandErrorsWhenGameIsOver (GameAtGameOver game) =-    forAll (arbitraryQuitCommand game) $ verbose_runCommandErrors game . getBlind--prop_quitCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property-prop_quitCommandErrorsWhenCallerDoesNotExist game caller =-    not (doesPlayerExist (caller ^. name) game)-    ==> verbose_runCommandErrors game (quitCommand $ caller ^. name)--prop_quitCommandErrorsWhenCallerIsDead :: Game -> Property-prop_quitCommandErrorsWhenCallerIsDead game =-    forAll (arbitraryPlayer game) $ \caller -> do-        let game'   = killPlayer (caller ^. name) game-        let command = quitCommand $ caller ^. name--        verbose_runCommandErrors game' command

@@ -1,86 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Command.See-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Game.Werewolf.Test.Command.See (-    -- * Tests-    allSeeCommandTests,-) where--import Control.Lens       hiding (isn't)-import Control.Lens.Extra--import Game.Werewolf-import Game.Werewolf.Command.Seer-import Game.Werewolf.Test.Arbitrary-import Game.Werewolf.Test.Util--import Test.Tasty-import Test.Tasty.QuickCheck--allSeeCommandTests :: [TestTree]-allSeeCommandTests =-    [ testProperty "see command errors when game is over"           prop_seeCommandErrorsWhenGameIsOver-    , testProperty "see command errors when caller does not exist"  prop_seeCommandErrorsWhenCallerDoesNotExist-    , testProperty "see command errors when target does not exist"  prop_seeCommandErrorsWhenTargetDoesNotExist-    , testProperty "see command errors when caller is dead"         prop_seeCommandErrorsWhenCallerIsDead-    , testProperty "see command errors when target is dead"         prop_seeCommandErrorsWhenTargetIsDead-    , testProperty "see command errors when not seer's turn"        prop_seeCommandErrorsWhenNotSeersTurn-    , testProperty "see command errors when caller not seer"        prop_seeCommandErrorsWhenCallerNotSeer-    ]--prop_seeCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_seeCommandErrorsWhenGameIsOver (GameAtGameOver game) =-    forAll (arbitrarySeeCommand game) $ verbose_runCommandErrors game . getBlind--prop_seeCommandErrorsWhenCallerDoesNotExist :: GameAtSeersTurn -> Player -> Property-prop_seeCommandErrorsWhenCallerDoesNotExist (GameAtSeersTurn game) caller =-    not (doesPlayerExist (caller ^. name) game)-    ==> forAll (arbitraryPlayer game) $ \target -> do-        let command = seeCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_seeCommandErrorsWhenTargetDoesNotExist :: GameAtSeersTurn -> Player -> Property-prop_seeCommandErrorsWhenTargetDoesNotExist (GameAtSeersTurn game) target = do-    let seer    = game ^?! players . seers-    let command = seeCommand (seer ^. name) (target ^. name)--    not (doesPlayerExist (target ^. name) game)-        ==> verbose_runCommandErrors game command--prop_seeCommandErrorsWhenCallerIsDead :: GameAtSeersTurn -> Property-prop_seeCommandErrorsWhenCallerIsDead (GameAtSeersTurn game) = do-    let seer    = game ^?! players . seers-    let game'   = killPlayer (seer ^. name) game--    forAll (arbitraryPlayer game') $ \target -> do-        let command = seeCommand (seer ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_seeCommandErrorsWhenTargetIsDead :: GameAtSeersTurn -> Property-prop_seeCommandErrorsWhenTargetIsDead (GameAtSeersTurn game) = do-    let seer = game ^?! players . seers--    forAll (arbitraryPlayer game) $ \target -> do-        let game'   = killPlayer (target ^. name) game-        let command = seeCommand (seer ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_seeCommandErrorsWhenNotSeersTurn :: Game -> Property-prop_seeCommandErrorsWhenNotSeersTurn 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) (isn't seer)) $ \caller ->-    forAll (arbitraryPlayer game) $ \target -> do-        let command = seeCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command

@@ -1,181 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Command.Vote-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Game.Werewolf.Test.Command.Vote (-    -- * Tests-    allVoteCommandTests,-) where--import Control.Lens       hiding (isn't)-import Control.Lens.Extra--import Game.Werewolf-import Game.Werewolf.Command.Villager as Villager-import Game.Werewolf.Command.Werewolf as Werewolf-import Game.Werewolf.Test.Arbitrary-import Game.Werewolf.Test.Util--import Test.Tasty-import Test.Tasty.QuickCheck--allVoteCommandTests :: [TestTree]-allVoteCommandTests =-    [ testProperty "werewolf vote command errors when game is over"             prop_werewolfVoteCommandErrorsWhenGameIsOver-    , testProperty "werewolf vote command errors when caller does not exist"    prop_werewolfVoteCommandErrorsWhenCallerDoesNotExist-    , testProperty "werewolf vote command errors when target does not exist"    prop_werewolfVoteCommandErrorsWhenTargetDoesNotExist-    , testProperty "werewolf vote command errors when caller is dead"           prop_werewolfVoteCommandErrorsWhenCallerIsDead-    , testProperty "werewolf vote command errors when target is dead"           prop_werewolfVoteCommandErrorsWhenTargetIsDead-    , testProperty "werewolf vote command errors when not werewolves turn"      prop_werewolfVoteCommandErrorsWhenNotWerewolvesTurn-    , testProperty "werewolf vote command errors when caller not werewolf"      prop_werewolfVoteCommandErrorsWhenCallerNotWerewolf-    , testProperty "werewolf vote command errors when caller has voted"         prop_werewolfVoteCommandErrorsWhenCallerHasVoted-    , testProperty "werewolf vote command errors when target werewolf"          prop_werewolfVoteCommandErrorsWhenTargetWerewolf--    , testProperty "villager vote command errors when game is over"                     prop_villagerVoteCommandErrorsWhenGameIsOver-    , testProperty "villager vote command errors when caller does not exist"            prop_villagerVoteCommandErrorsWhenCallerDoesNotExist-    , testProperty "villager vote command errors when target does not exist"            prop_villagerVoteCommandErrorsWhenTargetDoesNotExist-    , testProperty "villager vote command errors when caller is dead"                   prop_villagerVoteCommandErrorsWhenCallerIsDead-    , testProperty "villager vote command errors when target is dead"                   prop_villagerVoteCommandErrorsWhenTargetIsDead-    , testProperty "villager vote command errors when not villages turn"                prop_villagerVoteCommandErrorsWhenNotVillagesTurn-    , testProperty "villager vote command errors when caller has voted"                 prop_villagerVoteCommandErrorsWhenCallerHasVoted-    , testProperty "villager vote command errors when caller is not in allowed voters"  prop_villagerVoteCommandErrorsWhenCallerIsNotInAllowedVoters-    , testProperty "villager vote command errors when caller is known jester"           prop_villagerVoteCommandErrorsWhenCallerIsKnownJester-    ]--prop_werewolfVoteCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_werewolfVoteCommandErrorsWhenGameIsOver (GameAtGameOver game) =-    forAll (arbitraryWerewolfVoteCommand game) $ verbose_runCommandErrors game . getBlind--prop_werewolfVoteCommandErrorsWhenCallerDoesNotExist :: GameAtWerewolvesTurn -> Player -> Property-prop_werewolfVoteCommandErrorsWhenCallerDoesNotExist (GameAtWerewolvesTurn game) caller =-    not (doesPlayerExist (caller ^. name) game)-    ==> forAll (arbitraryPlayer game) $ \target -> do-        let command = Werewolf.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_werewolfVoteCommandErrorsWhenTargetDoesNotExist :: GameAtWerewolvesTurn -> Player -> Property-prop_werewolfVoteCommandErrorsWhenTargetDoesNotExist (GameAtWerewolvesTurn game) target =-    not (doesPlayerExist (target ^. name) game)-    ==> forAll (arbitraryWerewolf game) $ \caller -> do-        let command = Werewolf.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_werewolfVoteCommandErrorsWhenCallerIsDead :: GameAtWerewolvesTurn -> Property-prop_werewolfVoteCommandErrorsWhenCallerIsDead (GameAtWerewolvesTurn game) =-    forAll (arbitraryWerewolf game) $ \caller ->-    forAll (arbitraryPlayer game) $ \target -> do-        let game'   = killPlayer (caller ^. name) game-        let command = Werewolf.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_werewolfVoteCommandErrorsWhenTargetIsDead :: GameAtWerewolvesTurn -> Property-prop_werewolfVoteCommandErrorsWhenTargetIsDead (GameAtWerewolvesTurn game) =-    forAll (arbitraryWerewolf game) $ \caller ->-    forAll (arbitraryPlayer game) $ \target -> do-        let game'   = killPlayer (target ^. name) game-        let command = Werewolf.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_werewolfVoteCommandErrorsWhenNotWerewolvesTurn :: Game -> Property-prop_werewolfVoteCommandErrorsWhenNotWerewolvesTurn game =-    hasn't (stage . _WerewolvesTurn) game-    ==> forAll (arbitraryWerewolfVoteCommand game) $ verbose_runCommandErrors game . getBlind--prop_werewolfVoteCommandErrorsWhenCallerNotWerewolf :: GameAtWerewolvesTurn -> Property-prop_werewolfVoteCommandErrorsWhenCallerNotWerewolf (GameAtWerewolvesTurn game) =-    forAll (suchThat (arbitraryPlayer game) (isn't werewolf)) $ \caller ->-    forAll (arbitraryPlayer game) $ \target -> do-        let command = Werewolf.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_werewolfVoteCommandErrorsWhenCallerHasVoted :: GameWithDevourVotes -> Property-prop_werewolfVoteCommandErrorsWhenCallerHasVoted (GameWithDevourVotes game) =-    forAll (arbitraryWerewolf game) $ \caller ->-    forAll (suchThat (arbitraryPlayer game) (isn't werewolf)) $ \target -> do-        let command = Werewolf.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_werewolfVoteCommandErrorsWhenTargetWerewolf :: GameAtWerewolvesTurn -> Property-prop_werewolfVoteCommandErrorsWhenTargetWerewolf (GameAtWerewolvesTurn game) =-    forAll (arbitraryPlayer game) $ \caller ->-    forAll (arbitraryWerewolf game) $ \target ->-    verbose_runCommandErrors game (Werewolf.voteCommand (caller ^. name) (target ^. name))--prop_villagerVoteCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_villagerVoteCommandErrorsWhenGameIsOver (GameAtGameOver game) =-    forAll (arbitraryVillagerVoteCommand game) $ verbose_runCommandErrors game . getBlind--prop_villagerVoteCommandErrorsWhenCallerDoesNotExist :: GameAtVillagesTurn -> Player -> Property-prop_villagerVoteCommandErrorsWhenCallerDoesNotExist (GameAtVillagesTurn game) caller =-    not (doesPlayerExist (caller ^. name) game)-    ==> forAll (arbitraryPlayer game) $ \target -> do-        let command = Villager.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_villagerVoteCommandErrorsWhenTargetDoesNotExist :: GameAtVillagesTurn -> Player -> Property-prop_villagerVoteCommandErrorsWhenTargetDoesNotExist (GameAtVillagesTurn game) target =-    not (doesPlayerExist (target ^. name) game)-    ==> forAll (arbitraryPlayer game) $ \caller -> do-        let command = Villager.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_villagerVoteCommandErrorsWhenCallerIsDead :: GameAtVillagesTurn -> Property-prop_villagerVoteCommandErrorsWhenCallerIsDead (GameAtVillagesTurn game) =-    forAll (arbitraryPlayer game) $ \caller ->-    forAll (arbitraryPlayer game) $ \target -> do-        let game'   = killPlayer (caller ^. name) game-        let command = Villager.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_villagerVoteCommandErrorsWhenTargetIsDead :: GameAtVillagesTurn -> Property-prop_villagerVoteCommandErrorsWhenTargetIsDead (GameAtVillagesTurn game) =-    forAll (arbitraryPlayer game) $ \caller ->-    forAll (arbitraryPlayer game) $ \target -> do-        let game'   = killPlayer (target ^. name) game-        let command = Villager.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game' command--prop_villagerVoteCommandErrorsWhenNotVillagesTurn :: Game -> Property-prop_villagerVoteCommandErrorsWhenNotVillagesTurn game =-    hasn't (stage . _VillagesTurn) game-    ==> forAll (arbitraryVillagerVoteCommand game) $ verbose_runCommandErrors game . getBlind--prop_villagerVoteCommandErrorsWhenCallerHasVoted :: GameWithLynchVotes -> Property-prop_villagerVoteCommandErrorsWhenCallerHasVoted (GameWithLynchVotes game) =-    forAll (arbitraryPlayer game) $ \caller ->-    forAll (arbitraryPlayer game) $ \target -> do-        let command = Villager.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command--prop_villagerVoteCommandErrorsWhenCallerIsNotInAllowedVoters :: GameWithAllowedVoters -> Property-prop_villagerVoteCommandErrorsWhenCallerIsNotInAllowedVoters (GameWithAllowedVoters game) =-    forAll (suchThat (arbitraryPlayer game') (`notElem` getAllowedVoters game')) $ \caller ->-    forAll (arbitraryPlayer game') $ \target -> do-        let command = Villager.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game' command-    where-        game' = run_ checkStage game--prop_villagerVoteCommandErrorsWhenCallerIsKnownJester :: GameWithJesterRevealedAtVillagesTurn -> Property-prop_villagerVoteCommandErrorsWhenCallerIsKnownJester (GameWithJesterRevealedAtVillagesTurn game) =-    forAll (arbitraryPlayer game) $ \target -> do-        let command = Villager.voteCommand (caller ^. name) (target ^. name)--        verbose_runCommandErrors game command-    where-        caller = game ^?! players . jesters

@@ -1,51 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Engine-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--{-# LANGUAGE OverloadedStrings #-}--module Game.Werewolf.Test.Engine (-    -- * Tests-    allEngineTests,-) where--import Control.Lens         hiding (elements)-import Control.Lens.Extra-import Control.Monad.Except-import Control.Monad.Writer--import Data.Either.Extra--import Game.Werewolf-import Game.Werewolf.Test.Arbitrary ()--import Test.QuickCheck-import Test.Tasty-import Test.Tasty.QuickCheck--allEngineTests :: [TestTree]-allEngineTests =-    [ 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 1 of a restricted role"    prop_startGameErrorsWhenMoreThan1OfARestrictedRole-    ]--prop_startGameErrorsUnlessUniquePlayerNames :: Game -> Property-prop_startGameErrorsUnlessUniquePlayerNames game =-    forAll (elements players') $ \player ->-    isLeft (runExcept . runWriterT $ startGame "" (player:players'))-    where-        players' = game ^. players--prop_startGameErrorsWhenLessThan7Players :: [Player] -> Property-prop_startGameErrorsWhenLessThan7Players players = once $-    length players < 7-    ==> isLeft . runExcept . runWriterT $ startGame "" players--prop_startGameErrorsWhenMoreThan1OfARestrictedRole :: [Player] -> Property-prop_startGameErrorsWhenMoreThan1OfARestrictedRole players =-    any (\role' -> length (players ^.. traverse . filteredBy role role') > 1) restrictedRoles-    ==> isLeft . runExcept . runWriterT $ startGame "" players

@@ -1,34 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Util-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Game.Werewolf.Test.Util (-    -- * Utility functions-    run, run_, verbose_runCommandErrors,-) where--import Control.Monad.Except-import Control.Monad.Random-import Control.Monad.State  hiding (State)-import Control.Monad.Writer--import Data.Either.Extra--import Game.Werewolf--import Test.QuickCheck--run :: StateT Game (WriterT [Message] (ExceptT [Message] (Rand StdGen))) a -> Game -> Either [Message] (Game, [Message])-run action game = evalRand (runExceptT . runWriterT $ execStateT action game) (mkStdGen 0)--run_ :: StateT Game (WriterT [Message] (ExceptT [Message] (Rand StdGen))) a -> Game -> Game-run_ action = fst . fromRight . run action--verbose_runCommandErrors :: Game -> Command -> Property-verbose_runCommandErrors game command = whenFail (mapM_ putStrLn data_) (isLeft result)-    where-        result  = run (apply command) game-        data_   = [show game, show $ fromRight result]

@@ -1,5 +1,5 @@ name:           werewolf-version:        1.0.2.2+version:        1.1.0.0  author:         Henry J. Wylde maintainer:     public@hjwylde.com@@ -9,7 +9,7 @@ description:    A game engine for playing werewolf within an arbitrary chat client.                 Werewolf is a well known social party game, commonly also called Mafia.                 See the <https://en.wikipedia.org/wiki/Mafia_(party_game) Wikipedia article> for a-                rundown on it's gameplay and history.+                rundown on its gameplay and history.  license:        BSD3 license-file:   LICENSE@@ -29,10 +29,26 @@     hs-source-dirs: app/     ghc-options:    -threaded -with-rtsopts=-N     other-modules:+        Game.Werewolf.Command+        Game.Werewolf.Command.Global+        Game.Werewolf.Command.Hunter+        Game.Werewolf.Command.Oracle+        Game.Werewolf.Command.Orphan+        Game.Werewolf.Command.Protector+        Game.Werewolf.Command.Scapegoat+        Game.Werewolf.Command.Seer+        Game.Werewolf.Command.Status+        Game.Werewolf.Command.Villager+        Game.Werewolf.Command.Werewolf+        Game.Werewolf.Command.Witch+        Game.Werewolf.Engine+        Game.Werewolf.Messages+        Game.Werewolf.Util         Paths_werewolf         Werewolf.Command.Boot         Werewolf.Command.Choose         Werewolf.Command.Circle+        Werewolf.Command.Divine         Werewolf.Command.End         Werewolf.Command.Heal         Werewolf.Command.Help@@ -45,21 +61,24 @@         Werewolf.Command.See         Werewolf.Command.Start         Werewolf.Command.Status+        Werewolf.Command.Unvote         Werewolf.Command.Version         Werewolf.Command.Vote-        Werewolf.Game         Werewolf.Messages         Werewolf.Options+        Werewolf.System         Werewolf.Version      default-language: Haskell2010     other-extensions:         FlexibleContexts,         MultiParamTypeClasses,-        OverloadedStrings+        OverloadedStrings,+        Rank2Types     build-depends:         aeson >= 0.8 && < 0.12,         base >= 4.8 && < 5,+        containers == 0.5.*,         directory == 1.2.*,         extra == 1.4.*,         filepath == 1.4.*,@@ -78,32 +97,16 @@         Control.Lens.Extra         Data.String.Humanise         Game.Werewolf-        Game.Werewolf.Command-        Game.Werewolf.Command.Global-        Game.Werewolf.Command.Hunter-        Game.Werewolf.Command.Orphan-        Game.Werewolf.Command.Protector-        Game.Werewolf.Command.Scapegoat-        Game.Werewolf.Command.Seer-        Game.Werewolf.Command.Status-        Game.Werewolf.Command.Villager-        Game.Werewolf.Command.Werewolf-        Game.Werewolf.Command.Witch-        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:         CPP,         DeriveGeneric,         FlexibleContexts,-        MultiParamTypeClasses,         OverloadedStrings,         Rank2Types,         TemplateHaskell@@ -111,46 +114,8 @@         aeson >= 0.8 && < 0.12,         base >= 4.8 && < 5,         containers == 0.5.*,-        directory == 1.2.*,         extra == 1.4.*,-        filepath == 1.4.*,         lens >= 4.12 && < 4.15,-        MonadRandom == 0.4.*,         mtl == 2.2.*,         text == 1.2.*,         transformers == 0.4.*--test-suite werewolf-test-    type:           exitcode-stdio-1.0-    main-is:        Main.hs-    hs-source-dirs: test/app/, test/src/-    ghc-options:    -threaded -with-rtsopts=-N-    other-modules:-        Game.Werewolf.Test.Arbitrary-        Game.Werewolf.Test.Command-        Game.Werewolf.Test.Command.Choose-        Game.Werewolf.Test.Command.Heal-        Game.Werewolf.Test.Command.Pass-        Game.Werewolf.Test.Command.Poison-        Game.Werewolf.Test.Command.Protect-        Game.Werewolf.Test.Command.Quit-        Game.Werewolf.Test.Command.See-        Game.Werewolf.Test.Command.Vote-        Game.Werewolf.Test.Engine-        Game.Werewolf.Test.Util--    default-language: Haskell2010-    other-extensions:-        OverloadedStrings-    build-depends:-        base >= 4.8 && < 5,-        containers == 0.5.*,-        extra == 1.4.*,-        lens >= 4.12 && < 4.15,-        MonadRandom == 0.4.*,-        mtl == 2.2.*,-        QuickCheck == 2.8.*,-        tasty >= 0.10 && < 0.12,-        tasty-quickcheck == 0.8.*,-        text == 1.2.*,-        werewolf