packages feed

werewolf 0.5.1.0 → 0.5.2.0

raw patch · 43 files changed

+1449/−835 lines, 43 files

Files

CHANGELOG.md view
@@ -2,6 +2,18 @@  ### Upcoming +### v0.5.2.0++*Minor*++* Renamed the Wild-child to Orphan. ([#128](https://github.com/hjwylde/werewolf/issues/128))+* Added the Hunter role. ([#3](https://github.com/hjwylde/werewolf/issues/3))++*Revisions*++* Updated the Orphan's description. ([#128](https://github.com/hjwylde/werewolf/issues/128))+* Added role taken message for the Devoted Servant. ([#157](https://github.com/hjwylde/werewolf/issues/157))+ ### v0.5.1.0  *Minor*
README.md view
@@ -45,7 +45,7 @@ The Ambiguous are able to change allegiance throughout the game.  * Devoted Servant-* Wild-child+* Orphan * Wolf-hound  **The Loners:**@@ -66,6 +66,7 @@ The Villagers must lynch all of the Werewolves.  * Druid+* Hunter * Jester * Protector * Scapegoat
app/Werewolf/Command/Choose.hs view
@@ -28,8 +28,9 @@ import Data.Text (Text)  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.Command.WildChild as WildChild import Game.Werewolf.Command.WolfHound as WolfHound  import Werewolf.Game@@ -48,8 +49,10 @@     game <- readGame tag      command <- case game ^. stage of+            HuntersTurn1    -> return $ Hunter.chooseCommand callerName (head args)+            HuntersTurn2    -> return $ Hunter.chooseCommand callerName (head args)+            OrphansTurn     -> return $ Orphan.chooseCommand callerName (head args)             ScapegoatsTurn  -> return $ Scapegoat.chooseCommand callerName args-            WildChildsTurn  -> return $ WildChild.chooseCommand callerName (head args)             WolfHoundsTurn  -> return $ WolfHound.chooseCommand callerName (head args)             _               -> exitWith failure                 { messages = [playerCannotDoThatRightNowMessage callerName]
app/Werewolf/Command/Help.hs view
@@ -92,6 +92,14 @@       , "- `reveal`"       , "- `pass`"       ]+    , whenPlayerHasRole callerName mGame hunterRole+      [ "Hunter commands:"+      , "- `choose PLAYER`"+      ]+    , whenPlayerHasRole callerName mGame orphanRole+      [ "Orphan commands:"+      , "- `choose PLAYER`"+      ]     , whenPlayerHasRole callerName mGame protectorRole       [ "Protector commands:"       , "- `protect PLAYER`"@@ -104,10 +112,6 @@       [ "Seer commands:"       , "- `see PLAYER`"       ]-    , whenPlayerHasRole callerName mGame wildChildRole-      [ "Wild-child commands:"-      , "- `choose PLAYER`"-      ]     , whenPlayerHasRole callerName mGame witchRole       [ "Witch commands:"       , "- `heal`"@@ -153,8 +157,8 @@       , whenRoleInPlay mGame angelRole         "- (When the Angel is in play) the village votes to lynch a suspect."       , "- The village falls asleep."-      , whenRoleInPlay mGame wildChildRole-        "- (First round only) the Wild-child wakes up and chooses a role model."+      , whenRoleInPlay mGame orphanRole+        "- (First round only) the Orphan wakes up and chooses a role model."       , whenRoleInPlay mGame protectorRole         "- The Protector wakes up and protects someone."       , whenRoleInPlay mGame seerRole@@ -165,11 +169,15 @@       , whenRoleInPlay mGame witchRole         "- The Witch wakes up and may heal the victim and/or poison someone."       , "- The village wakes up and find the victim."+      , whenRoleInPlay mGame hunterRole+        "- (When the Hunter is killed) the Hunter chooses someone to shoot."       , whenRoleInPlay mGame druidRole         "- Ferina grunts if the Druid is next to a Werewolf."       , "- The village votes to lynch a suspect."       , whenRoleInPlay mGame devotedServantRole         "- (When someone is lynched) the Devoted Servant may choose whether to reveal themselves and take on the role of their master."+      , whenRoleInPlay mGame hunterRole+        "- (When the Hunter is killed) the Hunter chooses someone to shoot."       , whenRoleInPlay mGame scapegoatRole         "- (When the Scapegoat is blamed) the Scapegoat chooses whom may vote on the next day."       , T.concat
src/Game/Werewolf/Command/DevotedServant.hs view
@@ -34,7 +34,7 @@ passCommand callerName = Command $ do     validateCommand callerName -    passes %= nub . cons callerName+    passed .= True  revealCommand :: Text -> Command revealCommand callerName = Command $ do@@ -49,6 +49,7 @@     setPlayerRole targetName devotedServantRole      tell [devotedServantRevealedMessage callerName]+    tell [roleTakenMessage callerName targetRole]      resetRole callerName targetRole @@ -61,11 +62,11 @@ resetRole :: (MonadState Game m, MonadWriter [Message] m) => Text -> Role -> m () resetRole callerName role     | role == jesterRole            = jesterRevealed .= False+    | role == orphanRole            = roleModel .= Nothing     | role == simpleWerewolfRole    = do         aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get          tell $ devotedServantJoinedPackMessages callerName (aliveWerewolfNames \\ [callerName])-    | role == wildChildRole         = roleModel .= Nothing     | role == witchRole             = healUsed .= False >> poisonUsed .= False-    | role == wolfHoundRole         = allegianceChosen .= Nothing+    | role == wolfHoundRole         = allegianceChosen .= False     | otherwise                     = return ()
+ src/Game/Werewolf/Command/Hunter.hs view
@@ -0,0 +1,41 @@+{-|+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
+ src/Game/Werewolf/Command/Orphan.hs view
@@ -0,0 +1,35 @@+{-|+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
src/Game/Werewolf/Command/Status.hs view
@@ -9,7 +9,9 @@ Status commands. -} -{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}  module Game.Werewolf.Command.Status (     -- * Commands@@ -37,70 +39,44 @@  pingCommand :: Text -> Command pingCommand callerName = Command $ use stage >>= \stage' -> case stage' of-    DevotedServantsTurn -> do-        devotedServant <- findPlayerBy_ role devotedServantRole--        tell [pingRoleMessage $ devotedServantRole ^. Role.name]-        tell [pingPlayerMessage $ devotedServant ^. name]-+    DevotedServantsTurn -> pingRole devotedServantRole     FerinasGrunt        -> return ()-     GameOver            -> tell [gameIsOverMessage callerName]-+    HuntersTurn1        -> pingRole hunterRole+    HuntersTurn2        -> pingRole hunterRole     Lynching            -> return ()--    ProtectorsTurn      -> do-        protector <- findPlayerBy_ role protectorRole--        tell [pingRoleMessage $ protectorRole ^. Role.name]-        tell [pingPlayerMessage $ protector ^. name]--    ScapegoatsTurn      -> do-        scapegoat <- findPlayerBy_ role scapegoatRole--        tell [pingRoleMessage $ scapegoatRole ^. Role.name]-        tell [pingPlayerMessage $ scapegoat ^. name]--    SeersTurn           -> do-        seer <- findPlayerBy_ role seerRole--        tell [pingRoleMessage $ seerRole ^. Role.name]-        tell [pingPlayerMessage $ seer ^. name]-+    OrphansTurn         -> pingRole orphanRole+    ProtectorsTurn      -> pingRole protectorRole+    ScapegoatsTurn      -> pingRole scapegoatRole+    SeersTurn           -> pingRole seerRole     Sunrise             -> return ()-     Sunset              -> return ()--    VillagesTurn        -> do-        allowedVoterNames <- use allowedVoters-        pendingVoterNames <- toListOf names <$> getPendingVoters--        tell [waitingOnMessage Nothing $ allowedVoterNames `intersect` pendingVoterNames]-        tell $ map pingPlayerMessage (allowedVoterNames `intersect` pendingVoterNames)--    WerewolvesTurn      -> do-        pendingVoters <- getPendingVoters--        tell [pingRoleMessage "Werewolves"]-        tell $ map pingPlayerMessage (pendingVoters ^.. werewolves . name)+    VillagesTurn        -> pingVillagers+    WerewolvesTurn      -> pingWerewolves+    WitchsTurn          -> pingRole witchRole+    WolfHoundsTurn      -> pingRole wolfHoundRole -    WildChildsTurn      -> do-        wildChild <- findPlayerBy_ role wildChildRole+pingRole :: (MonadState Game m, MonadWriter [Message] m) => Role -> m ()+pingRole role' = do+    player <- findPlayerBy_ role role' -        tell [pingRoleMessage $ wildChildRole ^. Role.name]-        tell [pingPlayerMessage $ wildChild ^. name]+    tell [pingRoleMessage $ role' ^. Role.name]+    tell [pingPlayerMessage $ player ^. name] -    WitchsTurn          -> do-        witch <- findPlayerBy_ role witchRole+pingVillagers :: (MonadState Game m, MonadWriter [Message] m) => m ()+pingVillagers = do+    allowedVoterNames <- use allowedVoters+    pendingVoterNames <- toListOf names <$> getPendingVoters -        tell [pingRoleMessage $ witchRole ^. Role.name]-        tell [pingPlayerMessage $ witch ^. name]+    tell [waitingOnMessage Nothing $ allowedVoterNames `intersect` pendingVoterNames]+    tell $ map pingPlayerMessage (allowedVoterNames `intersect` pendingVoterNames) -    WolfHoundsTurn      -> do-        wolfHound <- findPlayerBy_ role wolfHoundRole+pingWerewolves :: (MonadState Game m, MonadWriter [Message] m) => m ()+pingWerewolves = do+    pendingVoters <- getPendingVoters -        tell [pingRoleMessage $ wolfHoundRole ^. Role.name]-        tell [pingPlayerMessage $ wolfHound ^. name]+    tell [pingRoleMessage "Werewolves"]+    tell $ map pingPlayerMessage (pendingVoters ^.. werewolves . name)  statusCommand :: Text -> Command statusCommand callerName = Command $ use stage >>= \stage' -> case stage' of
− src/Game/Werewolf/Command/WildChild.hs 
@@ -1,35 +0,0 @@-{-|-Module      : Game.Werewolf.Command.WildChild-Description : Wild-child commands.--Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--Wild-child commands.--}--module Game.Werewolf.Command.WildChild (-    -- * 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 (isPlayerWildChild callerName)  $ throwError [playerCannotDoThatMessage callerName]-    unlessM isWildChildsTurn                $ throwError [playerCannotDoThatRightNowMessage callerName]-    when (callerName == targetName)         $ throwError [playerCannotChooseSelfMessage callerName]-    validatePlayer callerName targetName--    roleModel .= Just targetName
src/Game/Werewolf/Command/Witch.hs view
@@ -22,7 +22,6 @@ import Control.Monad.Extra import Control.Monad.State  hiding (state) -import Data.List import Data.Text (Text)  import Game.Werewolf@@ -42,7 +41,7 @@ passCommand callerName = Command $ do     validateCommand callerName -    passes %= nub . cons callerName+    passed .= True  poisonCommand :: Text -> Text -> Command poisonCommand callerName targetName = Command $ do
src/Game/Werewolf/Command/WolfHound.hs view
@@ -35,8 +35,11 @@     unlessM isWolfHoundsTurn                $ throwError [playerCannotDoThatRightNowMessage callerName]     when (isNothing mAllegiance)            $ throwError [allegianceDoesNotExistMessage callerName allegianceName] -    allegianceChosen .= mAllegiance+    setPlayerAllegiance callerName allegiance++    allegianceChosen .= True     where+        allegiance  = fromJust mAllegiance         mAllegiance = case T.toLower allegianceName of             "villagers"     -> Just Villagers             "werewolves"    -> Just Werewolves
src/Game/Werewolf/Engine.hs view
@@ -71,7 +71,7 @@         whenM (has (players . devotedServants . dead) <$> get) advanceStage          whenM (has devotedServants <$> getVoteResult)   advanceStage-        whenM (has devotedServants <$> getPassers)      advanceStage+        whenM (use passed)                              advanceStage      FerinasGrunt -> do         druid       <- findPlayerBy_ role druidRole@@ -83,6 +83,10 @@      GameOver -> return () +    HuntersTurn1 -> whenM (use hunterRetaliated) advanceStage++    HuntersTurn2 -> whenM (use hunterRetaliated) advanceStage+     Lynching -> do         getVoteResult >>= lynchVotees @@ -95,6 +99,11 @@          advanceStage +    OrphansTurn -> do+        whenM (has (players . orphans . dead) <$> get) advanceStage++        whenM (isJust <$> use roleModel) advanceStage+     ProtectorsTurn -> do         whenM (has (players . protectors . dead) <$> get) advanceStage @@ -130,14 +139,14 @@      Sunset -> do         whenJustM (use roleModel) $ \roleModelsName -> do-            wildChild <- findPlayerBy_ role wildChildRole+            orphan <- findPlayerBy_ role orphanRole -            whenM (isPlayerDead roleModelsName &&^ return (is alive wildChild) &&^ return (is villager wildChild)) $ do+            whenM (isPlayerDead roleModelsName &&^ return (is alive orphan) &&^ return (is villager orphan)) $ do                 aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get -                setPlayerAllegiance (wildChild ^. name) Werewolves+                setPlayerAllegiance (orphan ^. name) Werewolves -                tell $ wildChildJoinedPackMessages (wildChild ^. name) aliveWerewolfNames+                tell $ orphanJoinedPackMessages (orphan ^. name) aliveWerewolfNames          advanceStage @@ -154,11 +163,6 @@          advanceStage -    WildChildsTurn -> do-        whenM (has (players . wildChildren . dead) <$> get) advanceStage--        whenM (isJust <$> use roleModel) advanceStage-     WitchsTurn -> do         whenM (has (players . witches . dead) <$> get) advanceStage @@ -173,17 +177,12 @@             heal    .= False          whenM (use healUsed &&^ use poisonUsed) advanceStage-        whenM (has witches <$> getPassers)      advanceStage+        whenM (use passed)                      advanceStage      WolfHoundsTurn -> do         whenM (has (players . wolfHounds . dead) <$> get) advanceStage -        whenJustM (use allegianceChosen) $ \allegiance -> do-            wolfHound <- findPlayerBy_ role wolfHoundRole--            setPlayerAllegiance (wolfHound ^. name) allegiance--            advanceStage+        whenM (use allegianceChosen) advanceStage  lynchVotees :: (MonadState Game m, MonadWriter [Message] m) => [Player] -> m () lynchVotees [votee]@@ -217,7 +216,7 @@      stage   .= nextStage     boots   .= Map.empty-    passes  .= []+    passed  .= False     see     .= Nothing      tell . stageMessages =<< get
src/Game/Werewolf/Game.hs view
@@ -17,14 +17,14 @@ module Game.Werewolf.Game (     -- * Game     Game,-    stage, round, players, events, boots, passes, allegianceChosen, allowedVoters, heal, healUsed,-    jesterRevealed, poison, poisonUsed, priorProtect, protect, roleModel, scapegoatBlamed, see,-    votes,+    stage, round, players, events, boots, allegianceChosen, allowedVoters, heal, healUsed,+    hunterRetaliated, jesterRevealed, passed, poison, poisonUsed, priorProtect, protect, roleModel,+    scapegoatBlamed, see, votes,      Stage(..),-    _DevotedServantsTurn, _FerinasGrunt, _GameOver, _Lynching, _ProtectorsTurn, _ScapegoatsTurn,-    _SeersTurn, _Sunrise, _Sunset, _VillagesTurn, _WerewolvesTurn, _WildChildsTurn, _WitchsTurn,-    _WolfHoundsTurn,+    _DevotedServantsTurn, _FerinasGrunt, _GameOver, _HuntersTurn1, _HuntersTurn2, _Lynching,+    _OrphansTurn, _ProtectorsTurn, _ScapegoatsTurn, _SeersTurn, _Sunrise, _Sunset, _VillagesTurn,+    _WerewolvesTurn, _WitchsTurn, _WolfHoundsTurn,      allStages,     stageCycle, stageAvailable,@@ -55,7 +55,6 @@ import           Data.Text       (Text)  import Game.Werewolf.Player-import Game.Werewolf.Role   hiding (name)  import Prelude hiding (round) @@ -68,7 +67,7 @@ -- --   Any further fields on the game are specific to one or more roles (and their respective turns!). --   Some of the additional fields are reset each round (e.g., the Seer's 'see') while others are---   kept around for the whole game (e.g., the Wild-child's 'roleModel').+--   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:@@ -87,17 +86,18 @@     , _players          :: [Player]     , _events           :: [Event]     , _boots            :: Map Text [Text]-    , _allegianceChosen :: Maybe Allegiance -- ^ Wolf-hound+    , _allegianceChosen :: Bool             -- ^ Wolf-hound     , _allowedVoters    :: [Text]           -- ^ Scapegoat     , _heal             :: Bool             -- ^ Witch     , _healUsed         :: Bool             -- ^ Witch+    , _hunterRetaliated :: Bool             -- ^ Hunter     , _jesterRevealed   :: Bool             -- ^ Jester-    , _passes           :: [Text]           -- ^ Witch+    , _passed           :: Bool             -- ^ Devoted Servant, Witch     , _poison           :: Maybe Text       -- ^ Witch     , _poisonUsed       :: Bool             -- ^ Witch     , _priorProtect     :: Maybe Text       -- ^ Protector     , _protect          :: Maybe Text       -- ^ Protector-    , _roleModel        :: Maybe Text       -- ^ Wild-child+    , _roleModel        :: Maybe Text       -- ^ Orphan     , _scapegoatBlamed  :: Bool             -- ^ Scapegoat     , _see              :: Maybe Text       -- ^ Seer     , _votes            :: Map Text Text    -- ^ Villagers and Werewolves@@ -109,11 +109,12 @@ -- --   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  = DevotedServantsTurn | FerinasGrunt | GameOver | Lynching | ProtectorsTurn-            | ScapegoatsTurn | SeersTurn | Sunrise | Sunset | VillagesTurn | WerewolvesTurn-            | WildChildsTurn | WitchsTurn | WolfHoundsTurn+data Stage  = DevotedServantsTurn | FerinasGrunt | GameOver | HuntersTurn1 | HuntersTurn2 | Lynching+            | OrphansTurn | ProtectorsTurn | ScapegoatsTurn | SeersTurn | Sunrise | Sunset+            | VillagesTurn | WerewolvesTurn | WitchsTurn | WolfHoundsTurn     deriving (Eq, Read, Show) +-- 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'.@@ -138,15 +139,17 @@     [ VillagesTurn     , DevotedServantsTurn     , Lynching+    , HuntersTurn1     , ScapegoatsTurn     , Sunset     , WolfHoundsTurn     , SeersTurn-    , WildChildsTurn+    , OrphansTurn     , ProtectorsTurn     , WerewolvesTurn     , WitchsTurn     , Sunrise+    , HuntersTurn2     , FerinasGrunt     , GameOver     ]@@ -167,6 +170,12 @@     && isn't devotedServant (head $ getVoteResult game) stageAvailable game FerinasGrunt        = has (players . druids . alive) game stageAvailable _ GameOver               = False+stageAvailable game HuntersTurn1        =+    has (players . hunters . dead) game+    && not (game ^. hunterRetaliated)+stageAvailable game HuntersTurn2        =+    has (players . hunters . dead) game+    && not (game ^. hunterRetaliated) stageAvailable game Lynching            = Map.size (game ^. votes) > 0 stageAvailable game ProtectorsTurn      = has (players . protectors . alive) game stageAvailable game ScapegoatsTurn      = game ^. scapegoatBlamed@@ -177,15 +186,15 @@     (has (players . angels . alive) game || not (isFirstRound game))     && any (is alive) (getAllowedVoters game) stageAvailable game WerewolvesTurn      = has (players . werewolves . alive) game-stageAvailable game WildChildsTurn      =-    has (players . wildChildren . alive) game+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)) stageAvailable game WolfHoundsTurn      =     has (players . wolfHounds . alive) game-    && isNothing (game ^. allegianceChosen)+    && not (game ^. allegianceChosen)  -- | Creates a new 'Game' with the given players. No validations are performed here, those are left --   to 'Game.Werewolf.Engine.startGame'.@@ -198,11 +207,12 @@             , _players              = players             , _events               = []             , _boots                = Map.empty-            , _passes               = []-            , _allegianceChosen     = Nothing+            , _passed               = False+            , _allegianceChosen     = False             , _allowedVoters        = players ^.. names             , _heal                 = False             , _healUsed             = False+            , _hunterRetaliated     = False             , _jesterRevealed       = False             , _poison               = Nothing             , _poisonUsed           = False
src/Game/Werewolf/Messages.hs view
@@ -44,11 +44,17 @@     angelJoinedVillagersMessage,      -- * Devoted Servant's turn messages-    devotedServantRevealedMessage, devotedServantJoinedPackMessages,+    devotedServantRevealedMessage, roleTakenMessage, devotedServantJoinedPackMessages,      -- * Druid's turn messages     ferinaGruntsMessage, +    -- * Hunter's turn messages+    playerShotMessage,++    -- * Orphan's turn messages+    orphanJoinedPackMessages,+     -- * Protector's turn messages      -- ** Error messages@@ -76,9 +82,6 @@     -- ** Error messages     playerCannotDevourAnotherWerewolfMessage, -    -- * Wild-child's turn messages-    wildChildJoinedPackMessages,-     -- ** Error messages     playerCannotChooseSelfMessage, @@ -149,7 +152,10 @@     DevotedServantsTurn -> devotedServantsTurnMessages devotedServantsName victimsName     FerinasGrunt        -> []     GameOver            -> []+    HuntersTurn1        -> huntersTurnMessages huntersName+    HuntersTurn2        -> huntersTurnMessages huntersName     Lynching            -> []+    OrphansTurn         -> orphansTurnMessages orphansName     ProtectorsTurn      -> protectorsTurnMessages protectorsName     ScapegoatsTurn      -> scapegoatsTurnMessages scapegoatsName     SeersTurn           -> seersTurnMessages seersName@@ -161,18 +167,18 @@     WerewolvesTurn      -> if isFirstRound game         then firstWerewolvesTurnMessages aliveWerewolfNames         else werewolvesTurnMessages aliveWerewolfNames-    WildChildsTurn      -> wildChildsTurnMessages wildChildsName     WitchsTurn          -> witchsTurnMessages game     WolfHoundsTurn      -> wolfHoundsTurnMessages wolfHoundsName     where         players'            = game ^. players-        protectorsName      = players' ^?! protectors . name         devotedServantsName = players' ^?! devotedServants . name         victimsName         = head (getVoteResult game) ^. name+        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-        wildChildsName      = players' ^?! wildChildren . name         wolfHoundsName      = players' ^?! wolfHounds . name  devotedServantsTurnMessages :: Text -> Text -> [Message]@@ -184,6 +190,18 @@         ]     ] +huntersTurnMessages :: Text -> [Message]+huntersTurnMessages huntersName =+    [ publicMessage $ T.unwords ["Just before", huntersName, "was struck down he 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."@@ -242,12 +260,6 @@     publicMessage "The Werewolves wake up, transform and choose a new victim."     : groupMessages tos "Whom would you like to `vote` to devour?" -wildChildsTurnMessages :: Text -> [Message]-wildChildsTurnMessages to =-    [ publicMessage "The Wild-child wakes up."-    , privateMessage to "Whom do you `choose` to be your role model?"-    ]- witchsTurnMessages :: Game -> [Message] witchsTurnMessages game = concat     [ [wakeUpMessage]@@ -405,7 +417,10 @@         showTurn DevotedServantsTurn    = "Devoted Servant's"         showTurn FerinasGrunt           = undefined         showTurn GameOver               = undefined+        showTurn HuntersTurn1           = "Hunter's"+        showTurn HuntersTurn2           = "Hunter's"         showTurn Lynching               = undefined+        showTurn OrphansTurn            = "Orphan's"         showTurn ProtectorsTurn         = "Protector's"         showTurn ScapegoatsTurn         = "Scapegoat's"         showTurn SeersTurn              = "Seer's"@@ -413,7 +428,6 @@         showTurn Sunset                 = undefined         showTurn VillagesTurn           = "village's"         showTurn WerewolvesTurn         = "Werewolves'"-        showTurn WildChildsTurn         = "Wild-child's"         showTurn WitchsTurn             = "Witch's"         showTurn WolfHoundsTurn         = "Wolf-hound's" @@ -460,11 +474,17 @@  devotedServantRevealedMessage :: Text -> Message devotedServantRevealedMessage devotedServantsName = publicMessage $ T.unwords-    [ devotedServantsName, "stands up in horror."-    , "Determined to not let their master's abilities be lost forever,"-    , "she selflessly takes on their role."+    [ "Determined to not let their master's abilities be lost forever,"+    , devotedServantsName, "the Devoted Servant selflessly takes on their role."     ] +roleTakenMessage :: Text -> Role -> Message+roleTakenMessage to role = privateMessage to $ T.intercalate "\n"+    [ T.concat ["You've taken on the role of ", article role, " ", role ^. Role.name, "."]+    , role ^. description+    , role ^. rules+    ]+ devotedServantJoinedPackMessages :: Text -> [Text] -> [Message] devotedServantJoinedPackMessages devotedServantsName werewolfNames =     privateMessage devotedServantsName (T.unwords $ masterWasWerewolfMessage:packMessages)@@ -489,6 +509,29 @@     , "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++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 your old home."+        , "As you arrive you see the familiar", tryPlural (length werewolfNames) "face", "of"+        , concatList werewolfNames, "waiting and happy to have you back."+        ])+    : groupMessages werewolfNames (T.unwords+        [ orphansName, "the Orphan scampers off into the woods."+        , "Without their role model nothing is holding back their true, wolfish, nature."+        ])+ playerCannotProtectSamePlayerTwiceInARowMessage :: Text -> Message playerCannotProtectSamePlayerTwiceInARowMessage to =     privateMessage to "You cannot protect the same player twice in a row!"@@ -585,20 +628,6 @@  playerCannotDevourAnotherWerewolfMessage :: Text -> Message playerCannotDevourAnotherWerewolfMessage to = privateMessage to "You cannot devour another Werewolf!"--wildChildJoinedPackMessages :: Text -> [Text] -> [Message]-wildChildJoinedPackMessages wildChildsName werewolfNames =-    privateMessage wildChildsName (T.unwords-        [ "The death of your role model is distressing."-        , "Without second thought you abandon the Villagers and run off into the woods,"-        , "towards your old home."-        , "As you arrive you see the familiar", tryPlural (length werewolfNames) "face", "of"-        , concatList werewolfNames, "waiting and happy to have you back."-        ])-    : groupMessages werewolfNames (T.unwords-        [ wildChildsName, "the Wild-child scampers off into the woods."-        , "Without his role model nothing is holding back his true, wolfish, nature."-        ])  playerCannotChooseSelfMessage :: Text -> Message playerCannotChooseSelfMessage to = privateMessage to "You cannot choose yourself!"
src/Game/Werewolf/Player.hs view
@@ -26,16 +26,16 @@     newPlayer,      -- ** Traversals-    angel, devotedServant, druid, jester, protector, scapegoat, seer, simpleVillager,-    simpleWerewolf, villagerVillager, wildChild, witch, wolfHound,+    angel, devotedServant, druid, hunter, jester, orphan, protector, scapegoat, seer,+    simpleVillager, simpleWerewolf, villagerVillager, witch, wolfHound,     villager, werewolf,      -- | These are provided just as a bit of sugar to avoid continually writing @'traverse' .@.     names, roles, states,      -- | N.B., these are not legal traversals for the same reason 'filtered' isn't!-    angels, devotedServants, druids, jesters, protectors, scapegoats, seers, simpleVillagers,-    simpleWerewolves, villagerVillagers, wildChildren, witches, wolfHounds,+    angels, devotedServants, druids, hunters, jesters, orphans, protectors, scapegoats, seers,+    simpleVillagers, simpleWerewolves, villagerVillagers, witches, wolfHounds,     villagers, werewolves,     alive, dead, @@ -99,6 +99,14 @@ druid :: Traversal' Player () druid = role . only druidRole +-- | The traversal of 'Player's with a 'hunterRole'.+--+-- @+-- 'hunter' = 'role' . 'only' 'hunterRole'+-- @+hunter :: Traversal' Player ()+hunter = role . only hunterRole+ -- | The traversal of 'Player's with a 'jesterRole'. -- -- @@@ -107,6 +115,14 @@ jester :: Traversal' Player () jester = role . only jesterRole +-- | The traversal of 'Player's with a 'orphanRole'.+--+-- @+-- 'orphan' = 'role' . 'only' 'orphanRole'+-- @+orphan :: Traversal' Player ()+orphan = role . only orphanRole+ -- | The traversal of 'Player's with a 'protectorRole'. -- -- @@@ -155,14 +171,6 @@ villagerVillager :: Traversal' Player () villagerVillager = role . only villagerVillagerRole --- | The traversal of 'Player's with a 'wildChildRole'.------ @--- 'wildChild' = 'role' . 'only' 'wildChildRole'--- @-wildChild :: Traversal' Player ()-wildChild = role . only wildChildRole- -- | The traversal of 'Player's with a 'witchRole'. -- -- @@@ -243,6 +251,14 @@ druids :: Traversable t => Traversal' (t Player) Player druids = traverse . filtered (is druid) +-- | This 'Traversal' provides the traversal of 'hunter' 'Player's.+--+-- @+-- 'hunters' = 'traverse' . 'filtered' ('is' 'hunter')+-- @+hunters :: Traversable t => Traversal' (t Player) Player+hunters = traverse . filtered (is hunter)+ -- | This 'Traversal' provides the traversal of 'jester' 'Player's. -- -- @@@ -251,6 +267,14 @@ jesters :: Traversable t => Traversal' (t Player) Player jesters = traverse . filtered (is jester) +-- | This 'Traversal' provides the traversal of 'orphan' 'Player's.+--+-- @+-- 'orphans' = 'traverse' . 'filtered' ('is' 'orphan')+-- @+orphans :: Traversable t => Traversal' (t Player) Player+orphans = traverse . filtered (is orphan)+ -- | This 'Traversal' provides the traversal of 'protector' 'Player's. -- -- @@@ -298,14 +322,6 @@ -- @ villagerVillagers :: Traversable t => Traversal' (t Player) Player villagerVillagers = traverse . filtered (is villagerVillager)---- | This 'Traversal' provides the traversal of 'wildChild' 'Player's.------ @--- 'wildChildren' = 'traverse' . 'filtered' ('is' 'wildChild')--- @-wildChildren :: Traversable t => Traversal' (t Player) Player-wildChildren = traverse . filtered (is wildChild)  -- | This 'Traversal' provides the traversal of 'witch' 'Player's. --
src/Game/Werewolf/Role.hs view
@@ -33,7 +33,7 @@     -- | No-one knows the true nature of the Ambiguous, sometimes not even the Ambiguous themselves!     --     --   The Ambiguous are able to change allegiance throughout the game.-    devotedServantRole, wildChildRole, wolfHoundRole,+    devotedServantRole, orphanRole, wolfHoundRole,      -- *** The Loners     -- | The Loners look out for themselves and themselves alone.@@ -47,7 +47,7 @@     --   certain few have learnt some tricks over the years that may turn out rather useful.      --   The Villagers must lynch all of the Werewolves.-    druidRole, jesterRole, protectorRole, scapegoatRole, seerRole, simpleVillagerRole,+    druidRole, hunterRole, jesterRole, protectorRole, scapegoatRole, seerRole, simpleVillagerRole,     villagerVillagerRole, witchRole,      -- *** The Werewolves@@ -103,14 +103,15 @@     [ angelRole     , devotedServantRole     , druidRole+    , hunterRole     , jesterRole+    , orphanRole     , protectorRole     , scapegoatRole     , seerRole     , simpleVillagerRole     , simpleWerewolfRole     , villagerVillagerRole-    , wildChildRole     , witchRole     , wolfHoundRole     ]@@ -149,41 +150,37 @@         ]     } --- | /Abandoned in the woods by his parents at a young age, he was raised by wolves. As soon as he/---   /learned how to walk on all fours, the Wild-child began to wander around Miller's Hollow. One/---   /day, fascinated by an inhabitant of the village who was walking upright with grace and/---   /presence, he made them his secret role model. He then decided to integrate himself into the/---   /community of Miller's Hollow and entered, worried, in the village. The community was moved by/---   /his frailty, adopted him, and welcomed him in their fold. What will become of him: honest/---   /Villager or terrible Werewolf? For all of his life, the heart of the Wild-child will swing/---   /between these two alternatives. May his model confirm him in his newfound humanity./+-- | /Abandoned by their parents as a child, with no-one wanting to look after another mouth to/+--   /feed, the Orphan was left to fend for themself. No-one looks twice at the Orphan and even/+--   /fewer offer kindness towards the lonely child. One day however, one townsperson changes all/+--   /this. He offers the Orphan food, water and a roof over his head. Grateful for his chairty and/+--   /affection, the Orphan makes him their role model. Pray that no ill should befall their role/+--   /model, for who knows in such an event whom, or what, the Orphan may turn to.../ -----   On the first night, the Wild-child may choose a player to become his role model. If during the---   game the chosen player is eliminated, the Wild-child becomes a Werewolf. He will then wake up---   the next night with his peers and will devour with them each night until the end of the game.---   However for as long as the Wild-child's role model is alive, he remains a Villager.-wildChildRole :: Role-wildChildRole = Role-    { _name         = "Wild-child"+--   On the first night, the Orphan may choose a player to become his role model. If during the game+--   the role model is eliminated, the Orphan becomes a Werewolf. He will then wake up the next+--   night with his peers and will devour with them each night until the end of the game. However+--   for as long as the Orphan's role model is alive, he remains a Villager.+orphanRole :: Role+orphanRole = Role+    { _name         = "Orphan"     , _allegiance   = Villagers     , _balance      = -1     , _description  = T.unwords-        [ "Abandoned in the woods by his parents at a young age, he was raised by wolves. As soon"-        , "as he learned how to walk on all fours, the Wild-child began to wander around Miller's"-        , "Hollow. One day, fascinated by an inhabitant of the village who was walking upright"-        , "with grace and presence, he made them his secret role model. He then decided to"-        , "integrate himself into the community of Miller's Hollow and entered, worried, in the"-        , "village. The community was moved by his frailty, adopted him, and welcomed him in their"-        , "fold. What will become of him: honest Villager or terrible Werewolf? For all of his"-        , "life, the heart of the Wild-child will swing between these two alternatives. May his"-        , "model confirm him in his newfound humanity."+        [ "Abandoned by their parents as a child, with no-one wanting to look after another mouth"+        , "to feed, the Orphan was left to fend for themself. No-one looks twice at the Orphan and"+        , "even fewer offer kindness towards the lonely child. One day however, one townsperson"+        , "changes all this. He offers the Orphan food, water and a roof over his head. Grateful"+        , "for his chairty and affection, the Orphan makes him their role model. Pray that no ill"+        , "should befall their role model, for who knows in such an event whom, or what, the Orphan"+        , "may turn to..."         ]     , _rules        = T.unwords-        [ "On the first night, the Wild-child may choose a player to become his role model. If"-        , "during the game the chosen player is eliminated, the Wild-child becomes a Werewolf. He"-        , "will then wake up the next night with his peers and will devour with them each night"-        , "until the end of the game.  However for as long as the Wild-child's role model is alive,"-        , "he remains a Villager."+        [ "On the first night, the Orphan may choose a player to become his role model. If during"+        , "the game the role model is eliminated, the Orphan becomes a Werewolf. He will then wake"+        , "up the next night with his peers and will devour with them each night until the end of"+        , "the game. However for as long as the Orphan's role model is alive, he remains a"+        , "Villager."         ]     } @@ -268,6 +265,28 @@         ]     } +-- | /A skilled marksman with quick reflexes. In the unfortunate situation that they are jumped and/+--   /killed unjustly, they are able to let off a shot at their attacker, killing them instantly./+--   /The Hunter never misses./+--+--   If the Hunter gets killed they get to choose one player, believed to be an attacker, to kill+--   immediately.+hunterRole :: Role+hunterRole = Role+    { _name         = "Hunter"+    , _allegiance   = Villagers+    , _balance      = 2+    , _description  = T.unwords+        [ "A skilled marksman with quick reflexes. In the unfortunate situation that they are"+        , "jumped and killed unjustly, they are able to let off a shot at their attacker, killing"+        , "them instantly. The Hunter never misses."+        ]+    , _rules        = T.unwords+        [ "If the Hunter gets killed they get to choose one player, believed to be an attacker, to"+        , "kill immediately."+        ]+    }+ -- | /The Protector is one of the few pure of heart and altruistic Villagers. They are forever/ --   /putting others needs above their own, standing guard at night against this terrifying foe./ --   /Each night they fight against the Werewolves with naught but a sword and shield, potentially/@@ -298,8 +317,8 @@     }  -- | /Werewolves don't just spring up out of the ground! That's where dwarves come from. Clearly/---   /someone is to blame for this affliction to Fougères. Ah! Unluckily, since no-one actually/---   /knows who brought them here, the blame is always laid upon the Scapegoat./+--   /someone is to blame for this affliction to Fougères. Unluckily for the Scapegoat, since/+--   /no-one actually knows who brought them here, the blame is always laid upon them!/ -- --   If the village's vote ends in a tie, it's the Scapegoat who is eliminated instead of no-one. --@@ -312,8 +331,9 @@     , _balance      = 0     , _description  = T.unwords         [ "Werewolves don't just spring up out of the ground! That's where dwarves come from."-        , "Clearly someone is to blame for this affliction to Fougères. Ah! Unluckily, since no-one"-        , "actually knows who brought them here, the blame is always laid upon the Scapegoat."+        , "Clearly someone is to blame for this affliction to Fougères. Unluckily for the"+        , "Scapegoat, since no-one actually knows who brought them here, the blame is always laid"+        , "upon them!"         ]     , _rules        = T.intercalate "\n"         [ T.unwords
src/Game/Werewolf/Util.hs view
@@ -20,20 +20,21 @@     killPlayer, removePlayer, setPlayerAllegiance, setPlayerRole,      -- ** Searches-    findPlayerBy_, getAdjacentAlivePlayers, getPassers, getPlayerVote,-    getAllowedVoters, getPendingVoters, getVoteResult,+    findPlayerBy_, getAdjacentAlivePlayers, getPlayerVote, getAllowedVoters, getPendingVoters,+    getVoteResult,      -- ** Queries-    isDevotedServantsTurn, isGameOver, isProtectorsTurn, isScapegoatsTurn, isSeersTurn, isSunrise,-    isVillagesTurn, isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn,+    isDevotedServantsTurn, isGameOver, isHuntersTurn, isOrphansTurn, isProtectorsTurn,+    isScapegoatsTurn, isSeersTurn, isSunrise, isVillagesTurn, isWerewolvesTurn, isWitchsTurn,+    isWolfHoundsTurn,     hasAnyoneWon, hasAngelWon, hasVillagersWon, hasWerewolvesWon,      -- * Player      -- ** Queries     doesPlayerExist,-    isPlayerDevotedServant, isPlayerJester, isPlayerProtector, isPlayerScapegoat, isPlayerSeer,-    isPlayerWildChild, isPlayerWitch, isPlayerWolfHound,+    isPlayerDevotedServant, isPlayerHunter, isPlayerJester, isPlayerOrphan, isPlayerProtector,+    isPlayerScapegoat, isPlayerSeer, isPlayerWitch, isPlayerWolfHound,     isPlayerWerewolf,     isPlayerAlive, isPlayerDead, ) where@@ -63,25 +64,24 @@ removePlayer name' = do     killPlayer name' -    passes  %= delete name'-    votes   %= Map.delete name'+    votes %= Map.delete name'      player <- findPlayerBy_ name name'      when (is angel 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 wildChild player)  $ roleModel .= Nothing     when (is witch player)      $ do         heal        .= False         healUsed    .= False         poison      .= Nothing         poisonUsed  .= False-    when (is wolfHound player)  $ allegianceChosen .= Nothing+    when (is wolfHound player)  $ allegianceChosen .= True --- | Fudges the player's allegiance. This function is useful for roles such as the Wild-child where+-- | 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'@@ -104,9 +104,6 @@         adjacentElements 0 list     = last list : take 2 list         adjacentElements index list = take 3 $ drop (index - 1) (cycle list) -getPassers :: MonadState Game m => m [Player]-getPassers = mapM (findPlayerBy_ name) =<< use passes- getPlayerVote :: MonadState Game m => Text -> m (Maybe Text) getPlayerVote playerName = use $ votes . at playerName @@ -125,6 +122,15 @@ 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 @@ -143,9 +149,6 @@ isWerewolvesTurn :: MonadState Game m => m Bool isWerewolvesTurn = has (stage . _WerewolvesTurn) <$> get -isWildChildsTurn :: MonadState Game m => m Bool-isWildChildsTurn = has (stage . _WildChildsTurn) <$> get- isWitchsTurn :: MonadState Game m => m Bool isWitchsTurn = has (stage . _WitchsTurn) <$> get @@ -170,9 +173,15 @@ isPlayerDevotedServant :: MonadState Game m => Text -> m Bool isPlayerDevotedServant name' = is devotedServant <$> findPlayerBy_ name 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' @@ -181,9 +190,6 @@  isPlayerSeer :: MonadState Game m => Text -> m Bool isPlayerSeer name' = is seer <$> findPlayerBy_ name name'--isPlayerWildChild :: MonadState Game m => Text -> m Bool-isPlayerWildChild name' = is wildChild <$> findPlayerBy_ name name'  isPlayerWitch :: MonadState Game m => Text -> m Bool isPlayerWitch name' = is witch <$> findPlayerBy_ name name'
test/src/Game/Werewolf/Test/Arbitrary.hs view
@@ -12,14 +12,15 @@      -- ** Game     NewGame(..),-    GameAtDevotedServantsTurn(..), GameAtGameOver(..), GameAtProtectorsTurn(..),-    GameAtScapegoatsTurn(..), GameAtSeersTurn(..), GameAtSunrise(..), GameAtVillagesTurn(..),-    GameAtWerewolvesTurn(..), GameAtWildChildsTurn(..), GameAtWitchsTurn(..),+    GameAtDevotedServantsTurn(..), GameAtGameOver(..), GameAtHuntersTurn(..), GameAtOrphansTurn(..),+    GameAtProtectorsTurn(..), GameAtScapegoatsTurn(..), GameAtSeersTurn(..), GameAtSunrise(..),+    GameAtVillagesTurn(..), GameAtWerewolvesTurn(..), GameAtWitchsTurn(..),     GameAtWolfHoundsTurn(..),     GameOnSecondRound(..),     GameWithAllegianceChosen(..), GameWithAllowedVoters(..), GameWithConflictingVote(..),     GameWithDeadPlayers(..), GameWithDevourEvent(..), GameWithDevourVotes(..), GameWithHeal(..),     GameWithJesterRevealedAtVillagesTurn(..), GameWithLynchVotes(..), GameWithMajorityVote(..),+    GameWithNoAllowedVotersAtVillagesTurn(..), GameWithNoWerewolvesAtProtectorsTurn(..),     GameWithOneAllegianceAlive(..), GameWithPassAtDevotedServantsTurn(..), GameWithPoison(..),     GameWithProtect(..), GameWithProtectAndDevourVotes(..), GameWithRoleModel(..),     GameWithRoleModelAtVillagesTurn(..), GameWithSee(..),@@ -30,11 +31,11 @@     -- * Contextual arbitraries      -- ** Command-    arbitraryCommand, arbitraryWolfHoundChooseCommand, arbitraryWildChildChooseCommand,-    arbitraryScapegoatChooseCommand, arbitraryHealCommand, arbitraryDevotedServantPassCommand,-    arbitraryWitchPassCommand, arbitraryPoisonCommand, arbitraryProtectCommand,-    arbitraryQuitCommand, arbitraryRevealCommand, arbitrarySeeCommand, arbitraryWerewolfVoteCommand,-    arbitraryVillagerVoteCommand,+    arbitraryCommand, arbitraryHunterChooseCommand, arbitraryOrphanChooseCommand,+    arbitraryWolfHoundChooseCommand, arbitraryScapegoatChooseCommand, arbitraryHealCommand,+    arbitraryDevotedServantPassCommand, arbitraryWitchPassCommand, arbitraryPoisonCommand,+    arbitraryProtectCommand, arbitraryQuitCommand, arbitraryRevealCommand, arbitrarySeeCommand,+    arbitraryWerewolfVoteCommand, arbitraryVillagerVoteCommand,     runArbitraryCommands,      -- ** Player@@ -51,12 +52,13 @@ import Game.Werewolf import Game.Werewolf.Command.DevotedServant as DevotedServant 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.WildChild      as WildChild import Game.Werewolf.Command.Witch          as Witch import Game.Werewolf.Command.WolfHound      as WolfHound import Game.Werewolf.Test.Util@@ -115,6 +117,25 @@          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) @@ -169,15 +190,6 @@          return $ GameAtWerewolvesTurn (game & stage .~ WerewolvesTurn) -newtype GameAtWildChildsTurn = GameAtWildChildsTurn Game-    deriving (Eq, Show)--instance Arbitrary GameAtWildChildsTurn where-    arbitrary = do-        game <- arbitrary--        return $ GameAtWildChildsTurn (game & stage .~ WildChildsTurn)- newtype GameAtWitchsTurn = GameAtWitchsTurn Game     deriving (Eq, Show) @@ -323,6 +335,26 @@          return . GameWithMajorityVoteAtDevotedServantsTurn $ run_ checkStage game +newtype GameWithNoAllowedVotersAtVillagesTurn = GameWithNoAllowedVotersAtVillagesTurn Game+    deriving (Eq, Show)++instance Arbitrary GameWithNoAllowedVotersAtVillagesTurn where+    arbitrary = do+        (GameAtVillagesTurn game) <- arbitrary++        return $ GameWithNoAllowedVotersAtVillagesTurn (game & allowedVoters .~ [])++newtype GameWithNoWerewolvesAtProtectorsTurn = GameWithNoWerewolvesAtProtectorsTurn Game+    deriving (Eq, Show)++instance Arbitrary GameWithNoWerewolvesAtProtectorsTurn where+    arbitrary = do+        (GameAtProtectorsTurn game) <- arbitrary+        let werewolfNames           = game ^.. players . werewolves . name+        let game'                   = foldr killPlayer game werewolfNames++        return $ GameWithNoWerewolvesAtProtectorsTurn game'+ newtype GameWithOneAllegianceAlive = GameWithOneAllegianceAlive Game     deriving (Eq, Show) @@ -393,8 +425,8 @@  instance Arbitrary GameWithRoleModel where     arbitrary = do-        (GameAtWildChildsTurn game) <- arbitrary-        (Blind command)             <- arbitraryWildChildChooseCommand game+        (GameAtOrphansTurn game) <- arbitrary+        (Blind command)             <- arbitraryOrphanChooseCommand game         let game'                   = run_ (apply command) game          return $ GameWithRoleModel game'@@ -439,7 +471,10 @@         ]     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@@ -447,7 +482,6 @@     Sunset              -> return $ Blind noopCommand     VillagesTurn        -> arbitraryVillagerVoteCommand game     WerewolvesTurn      -> arbitraryWerewolfVoteCommand game-    WildChildsTurn      -> arbitraryWildChildChooseCommand game     WitchsTurn          -> oneof         [ arbitraryHealCommand game         , arbitraryWitchPassCommand game@@ -455,19 +489,26 @@         ]     WolfHoundsTurn      -> arbitraryWolfHoundChooseCommand 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)+ arbitraryWolfHoundChooseCommand :: Game -> Gen (Blind Command) arbitraryWolfHoundChooseCommand game = do     let wolfHoundsName  = game ^?! players . wolfHounds . name     allegianceName      <- elements $ map (T.pack . show) [Villagers, Werewolves]      return . Blind $ WolfHound.chooseCommand wolfHoundsName allegianceName--arbitraryWildChildChooseCommand :: Game -> Gen (Blind Command)-arbitraryWildChildChooseCommand game = do-    let wildChild   = game ^?! players . wildChildren-    target          <- suchThat (arbitraryPlayer game) (wildChild /=)--    return . Blind $ WildChild.chooseCommand (wildChild ^. name) (target ^. name)  arbitraryScapegoatChooseCommand :: Game -> Gen (Blind Command) arbitraryScapegoatChooseCommand game = do
test/src/Game/Werewolf/Test/Command.hs view
@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# LANGUAGE OverloadedStrings #-}- module Game.Werewolf.Test.Command (     -- * Tests     allCommandTests,
test/src/Game/Werewolf/Test/Command/Choose.hs view
@@ -19,8 +19,9 @@ import qualified Data.Text  as T  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.Command.WildChild as WildChild import Game.Werewolf.Command.WolfHound as WolfHound import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util@@ -30,23 +31,33 @@  allChooseCommandTests :: [TestTree] allChooseCommandTests =-    [ testProperty "wolf-hound choose command errors when game is over"                 prop_wolfHoundChooseCommandErrorsWhenGameIsOver+    [ 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 "hunter choose command kills target"                             prop_hunterChooseCommandKillsTarget+    , testProperty "hunter choose command sets hunter retaliated"                   prop_hunterChooseCommandSetsHunterRetaliated++    , 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 "orphan choose command sets role model"                      prop_orphanChooseCommandSetsRoleModel++    , testProperty "wolf-hound choose command errors when game is over"                 prop_wolfHoundChooseCommandErrorsWhenGameIsOver     , testProperty "wolf-hound choose command errors when caller does not exist"        prop_wolfHoundChooseCommandErrorsWhenCallerDoesNotExist     , testProperty "wolf-hound choose command errors when caller is dead"               prop_wolfHoundChooseCommandErrorsWhenCallerIsDead     , testProperty "wolf-hound choose command errors when not wolf-hound's turn"        prop_wolfHoundChooseCommandErrorsWhenNotWolfHoundsTurn     , testProperty "wolf-hound choose command errors when caller not wolf-hound"        prop_wolfHoundChooseCommandErrorsWhenCallerNotWolfHound     , testProperty "wolf-hound choose command errors when allegiance does not exist"    prop_wolfHoundChooseCommandErrorsWhenAllegianceDoesNotExist     , testProperty "wolf-hound choose command sets allegiance chosen"                   prop_wolfHoundChooseCommandSetsAllegianceChosen--    , testProperty "wild-child choose command errors when game is over"             prop_wildChildChooseCommandErrorsWhenGameIsOver-    , testProperty "wild-child choose command errors when caller does not exist"    prop_wildChildChooseCommandErrorsWhenCallerDoesNotExist-    , testProperty "wild-child choose command errors when target does not exist"    prop_wildChildChooseCommandErrorsWhenTargetDoesNotExist-    , testProperty "wild-child choose command errors when caller is dead"           prop_wildChildChooseCommandErrorsWhenCallerIsDead-    , testProperty "wild-child choose command errors when target is dead"           prop_wildChildChooseCommandErrorsWhenTargetIsDead-    , testProperty "wild-child choose command errors when target is caller"         prop_wildChildChooseCommandErrorsWhenTargetIsCaller-    , testProperty "wild-child choose command errors when not wild-child's turn"    prop_wildChildChooseCommandErrorsWhenNotWildChildsTurn-    , testProperty "wild-child choose command errors when caller not wild-child"    prop_wildChildChooseCommandErrorsWhenCallerNotWildChild-    , testProperty "wild-child choose command sets role model"                      prop_wildChildChooseCommandSetsRoleModel+    , testProperty "wolf-hound choose command sets allegiance"                          prop_wolfHoundChooseCommandSetsAllegiance      , testProperty "scapegoat choose command errors when game is over"              prop_scapegoatChooseCommandErrorsWhenGameIsOver     , testProperty "scapegoat choose command errors when caller does not exist"     prop_scapegoatChooseCommandErrorsWhenCallerDoesNotExist@@ -58,124 +69,194 @@     , testProperty "scapegoat choose command resets scapegoat blamed"               prop_scapegoatChooseCommandResetsScapegoatBlamed     ] -prop_wolfHoundChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_wolfHoundChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =-    forAll (arbitraryWolfHoundChooseCommand game) $ verbose_runCommandErrors game . getBlind+prop_hunterChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property+prop_hunterChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =+    forAll (arbitraryHunterChooseCommand game) $ verbose_runCommandErrors game . getBlind -prop_wolfHoundChooseCommandErrorsWhenCallerDoesNotExist :: GameAtWolfHoundsTurn -> Player -> Allegiance -> Property-prop_wolfHoundChooseCommandErrorsWhenCallerDoesNotExist (GameAtWolfHoundsTurn game) caller allegiance = do-    let command = WolfHound.chooseCommand (caller ^. name) (T.pack $ show allegiance)+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)+        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_wolfHoundChooseCommandErrorsWhenCallerIsDead :: GameAtWolfHoundsTurn -> Allegiance -> Property-prop_wolfHoundChooseCommandErrorsWhenCallerIsDead (GameAtWolfHoundsTurn game) allegiance = do-    let wolfHound   = game ^?! players . wolfHounds-    let game'       = killPlayer (wolfHound ^. name) game-    let command     = WolfHound.chooseCommand (wolfHound ^. name) (T.pack $ show allegiance)+prop_hunterChooseCommandErrorsWhenTargetIsDead :: GameAtHuntersTurn -> Property+prop_hunterChooseCommandErrorsWhenTargetIsDead (GameAtHuntersTurn game) = do+    let hunter = game ^?! players . hunters -    verbose_runCommandErrors game' command+    forAll (arbitraryPlayer game) $ \target -> do+        let game'   = killPlayer (target ^. name) game+        let command = Hunter.chooseCommand (hunter ^. name) (target ^. name) -prop_wolfHoundChooseCommandErrorsWhenNotWolfHoundsTurn :: Game -> Property-prop_wolfHoundChooseCommandErrorsWhenNotWolfHoundsTurn game =-    hasn't (stage . _WolfHoundsTurn) game-    ==> forAll (arbitraryWolfHoundChooseCommand game) $ verbose_runCommandErrors game . getBlind+        verbose_runCommandErrors game' command -prop_wolfHoundChooseCommandErrorsWhenCallerNotWolfHound :: GameAtWolfHoundsTurn -> Allegiance -> Property-prop_wolfHoundChooseCommandErrorsWhenCallerNotWolfHound (GameAtWolfHoundsTurn game) allegiance =-    forAll (suchThat (arbitraryPlayer game) (isn't wolfHound)) $ \caller -> do-        let command = WolfHound.chooseCommand (caller ^. name) (T.pack $ show allegiance)+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_wolfHoundChooseCommandErrorsWhenAllegianceDoesNotExist :: GameAtWolfHoundsTurn -> Text -> Property-prop_wolfHoundChooseCommandErrorsWhenAllegianceDoesNotExist (GameAtWolfHoundsTurn game) allegiance = do-    let wolfHound   = game ^?! players . wolfHounds-    let command     = WolfHound.chooseCommand (wolfHound ^. name) allegiance+prop_hunterChooseCommandKillsTarget :: GameAtHuntersTurn -> Property+prop_hunterChooseCommandKillsTarget (GameAtHuntersTurn game) = do+    let hunter = game ^?! players . hunters -    allegiance `notElem` ["Villagers", "Werewolves"]-        ==> verbose_runCommandErrors game command+    forAll (arbitraryPlayer game) $ \target -> do+        let command = Hunter.chooseCommand (hunter ^. name) (target ^. name)+        let game'   = run_ (apply command) game -prop_wolfHoundChooseCommandSetsAllegianceChosen :: GameAtWolfHoundsTurn -> Property-prop_wolfHoundChooseCommandSetsAllegianceChosen (GameAtWolfHoundsTurn game) = do-    let wolfHoundsName = game ^?! players . wolfHounds . name+        is dead $ game' ^?! players . traverse . filteredBy name (target ^. name) -    forAll (elements [Villagers, Werewolves]) $ \allegiance' -> do-        let command = WolfHound.chooseCommand wolfHoundsName (T.pack $ show allegiance')+prop_hunterChooseCommandSetsHunterRetaliated :: GameAtHuntersTurn -> Property+prop_hunterChooseCommandSetsHunterRetaliated (GameAtHuntersTurn game) = do+    let hunter = game ^?! players . hunters++    forAll (arbitraryPlayer game) $ \target -> do+        let command = Hunter.chooseCommand (hunter ^. name) (target ^. name)         let game'   = run_ (apply command) game -        fromJust (game' ^. allegianceChosen) === allegiance'+        game' ^. hunterRetaliated -prop_wildChildChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_wildChildChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =-    forAll (arbitraryWildChildChooseCommand game) $ verbose_runCommandErrors game . getBlind+prop_orphanChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property+prop_orphanChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =+    forAll (arbitraryOrphanChooseCommand game) $ verbose_runCommandErrors game . getBlind -prop_wildChildChooseCommandErrorsWhenCallerDoesNotExist :: GameAtWildChildsTurn -> Player -> Property-prop_wildChildChooseCommandErrorsWhenCallerDoesNotExist (GameAtWildChildsTurn game) caller =+prop_orphanChooseCommandErrorsWhenCallerDoesNotExist :: GameAtOrphansTurn -> Player -> Property+prop_orphanChooseCommandErrorsWhenCallerDoesNotExist (GameAtOrphansTurn game) caller =     forAll (arbitraryPlayer game) $ \target -> do-        let command = WildChild.chooseCommand (caller ^. name) (target ^. name)+        let command = Orphan.chooseCommand (caller ^. name) (target ^. name)          not (doesPlayerExist (caller ^. name) game)             ==> verbose_runCommandErrors game command -prop_wildChildChooseCommandErrorsWhenTargetDoesNotExist :: GameAtWildChildsTurn -> Player -> Property-prop_wildChildChooseCommandErrorsWhenTargetDoesNotExist (GameAtWildChildsTurn game) target = do-    let wildChild   = game ^?! players . wildChildren-    let command     = WildChild.chooseCommand (wildChild ^. name) (target ^. name)+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_wildChildChooseCommandErrorsWhenCallerIsDead :: GameAtWildChildsTurn -> Property-prop_wildChildChooseCommandErrorsWhenCallerIsDead (GameAtWildChildsTurn game) = do-    let wildChild   = game ^?! players . wildChildren-    let game'       = killPlayer (wildChild ^. name) game+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 = WildChild.chooseCommand (wildChild ^. name) (target ^. name)+        let command = Orphan.chooseCommand (orphan ^. name) (target ^. name)          verbose_runCommandErrors game' command -prop_wildChildChooseCommandErrorsWhenTargetIsDead :: GameAtWildChildsTurn -> Property-prop_wildChildChooseCommandErrorsWhenTargetIsDead (GameAtWildChildsTurn game) = do-    let wildChild = game ^?! players . wildChildren+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 = WildChild.chooseCommand (wildChild ^. name) (target ^. name)+        let command = Orphan.chooseCommand (orphan ^. name) (target ^. name)          verbose_runCommandErrors game' command -prop_wildChildChooseCommandErrorsWhenTargetIsCaller :: GameAtWildChildsTurn -> Property-prop_wildChildChooseCommandErrorsWhenTargetIsCaller (GameAtWildChildsTurn game) = do-    let wildChild   = game ^?! players . wildChildren-    let command     = WildChild.chooseCommand (wildChild ^. name) (wildChild ^. name)+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_wildChildChooseCommandErrorsWhenNotWildChildsTurn :: Game -> Property-prop_wildChildChooseCommandErrorsWhenNotWildChildsTurn game =-    hasn't (stage . _WildChildsTurn) game-    ==> forAll (arbitraryWildChildChooseCommand game) $ verbose_runCommandErrors game . getBlind+prop_orphanChooseCommandErrorsWhenNotOrphansTurn :: Game -> Property+prop_orphanChooseCommandErrorsWhenNotOrphansTurn game =+    hasn't (stage . _OrphansTurn) game+    ==> forAll (arbitraryOrphanChooseCommand game) $ verbose_runCommandErrors game . getBlind -prop_wildChildChooseCommandErrorsWhenCallerNotWildChild :: GameAtWildChildsTurn -> Property-prop_wildChildChooseCommandErrorsWhenCallerNotWildChild (GameAtWildChildsTurn game) =-    forAll (suchThat (arbitraryPlayer game) (isn't wildChild)) $ \caller ->+prop_orphanChooseCommandErrorsWhenCallerNotOrphan :: GameAtOrphansTurn -> Property+prop_orphanChooseCommandErrorsWhenCallerNotOrphan (GameAtOrphansTurn game) =+    forAll (suchThat (arbitraryPlayer game) (isn't orphan)) $ \caller ->     forAll (arbitraryPlayer game) $ \target -> do-        let command = WildChild.chooseCommand (caller ^. name) (target ^. name)+        let command = Orphan.chooseCommand (caller ^. name) (target ^. name)          verbose_runCommandErrors game command -prop_wildChildChooseCommandSetsRoleModel :: GameAtWildChildsTurn -> Property-prop_wildChildChooseCommandSetsRoleModel (GameAtWildChildsTurn game) = do-    let wildChild = game ^?! players . wildChildren+prop_orphanChooseCommandSetsRoleModel :: GameAtOrphansTurn -> Property+prop_orphanChooseCommandSetsRoleModel (GameAtOrphansTurn game) = do+    let orphan = game ^?! players . orphans -    forAll (suchThat (arbitraryPlayer game) (wildChild /=)) $ \target -> do-        let command = WildChild.chooseCommand (wildChild ^. name) (target ^. name)+    forAll (suchThat (arbitraryPlayer game) (orphan /=)) $ \target -> do+        let command = Orphan.chooseCommand (orphan ^. name) (target ^. name)         let game'   = run_ (apply command) game          fromJust (game' ^. roleModel) === target ^. name++prop_wolfHoundChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property+prop_wolfHoundChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =+    forAll (arbitraryWolfHoundChooseCommand game) $ verbose_runCommandErrors game . getBlind++prop_wolfHoundChooseCommandErrorsWhenCallerDoesNotExist :: GameAtWolfHoundsTurn -> Player -> Allegiance -> Property+prop_wolfHoundChooseCommandErrorsWhenCallerDoesNotExist (GameAtWolfHoundsTurn game) caller allegiance = do+    let command = WolfHound.chooseCommand (caller ^. name) (T.pack $ show allegiance)++    not (doesPlayerExist (caller ^. name) game)+        ==> verbose_runCommandErrors game command++prop_wolfHoundChooseCommandErrorsWhenCallerIsDead :: GameAtWolfHoundsTurn -> Allegiance -> Property+prop_wolfHoundChooseCommandErrorsWhenCallerIsDead (GameAtWolfHoundsTurn game) allegiance = do+    let wolfHound   = game ^?! players . wolfHounds+    let game'       = killPlayer (wolfHound ^. name) game+    let command     = WolfHound.chooseCommand (wolfHound ^. name) (T.pack $ show allegiance)++    verbose_runCommandErrors game' command++prop_wolfHoundChooseCommandErrorsWhenNotWolfHoundsTurn :: Game -> Property+prop_wolfHoundChooseCommandErrorsWhenNotWolfHoundsTurn game =+    hasn't (stage . _WolfHoundsTurn) game+    ==> forAll (arbitraryWolfHoundChooseCommand game) $ verbose_runCommandErrors game . getBlind++prop_wolfHoundChooseCommandErrorsWhenCallerNotWolfHound :: GameAtWolfHoundsTurn -> Allegiance -> Property+prop_wolfHoundChooseCommandErrorsWhenCallerNotWolfHound (GameAtWolfHoundsTurn game) allegiance =+    forAll (suchThat (arbitraryPlayer game) (isn't wolfHound)) $ \caller -> do+        let command = WolfHound.chooseCommand (caller ^. name) (T.pack $ show allegiance)++        verbose_runCommandErrors game command++prop_wolfHoundChooseCommandErrorsWhenAllegianceDoesNotExist :: GameAtWolfHoundsTurn -> Text -> Property+prop_wolfHoundChooseCommandErrorsWhenAllegianceDoesNotExist (GameAtWolfHoundsTurn game) allegiance = do+    let wolfHound   = game ^?! players . wolfHounds+    let command     = WolfHound.chooseCommand (wolfHound ^. name) allegiance++    allegiance `notElem` ["Villagers", "Werewolves"]+        ==> verbose_runCommandErrors game command++prop_wolfHoundChooseCommandSetsAllegianceChosen :: GameAtWolfHoundsTurn -> Property+prop_wolfHoundChooseCommandSetsAllegianceChosen (GameAtWolfHoundsTurn game) =+    forAll (arbitraryWolfHoundChooseCommand game) $ \(Blind command) -> do+        let game' = run_ (apply command) game++        game' ^. allegianceChosen++prop_wolfHoundChooseCommandSetsAllegiance :: GameAtWolfHoundsTurn -> Property+prop_wolfHoundChooseCommandSetsAllegiance (GameAtWolfHoundsTurn game) = do+    let wolfHoundsName = game ^?! players . wolfHounds . name++    forAll (elements [Villagers, Werewolves]) $ \allegiance' -> do+        let command = WolfHound.chooseCommand wolfHoundsName (T.pack $ show allegiance')+        let game'   = run_ (apply command) game++        game' ^?! players . wolfHounds . role . allegiance === allegiance'  prop_scapegoatChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property prop_scapegoatChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =
test/src/Game/Werewolf/Test/Command/Heal.hs view
@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# LANGUAGE OverloadedStrings #-}- module Game.Werewolf.Test.Command.Heal (     -- * Tests     allHealCommandTests,
test/src/Game/Werewolf/Test/Command/Pass.hs view
@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# LANGUAGE OverloadedStrings #-}- module Game.Werewolf.Test.Command.Pass (     -- * Tests     allPassCommandTests,@@ -29,13 +27,13 @@     , testProperty "devoted servant pass command errors when caller does not exist"         prop_devotedServantPassCommandErrorsWhenCallerDoesNotExist     , testProperty "devoted servant pass command errors when caller is dead"                prop_devotedServantPassCommandErrorsWhenCallerIsDead     , testProperty "devoted servant pass command errors when not devoted servant's turn"    prop_devotedServantPassCommandErrorsWhenNotDevotedServantsTurn-    , testProperty "devoted servant pass command updates passes"                            prop_devotedServantPassCommandUpdatesPasses+    , testProperty "devoted servant pass command sets passed"                               prop_devotedServantPassCommandSetsPassed      , 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-    , testProperty "witch pass command updates passes"                      prop_witchPassCommandUpdatesPasses+    , testProperty "witch pass command sets passed"                         prop_witchPassCommandSetsPassed     ]  prop_devotedServantPassCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property@@ -60,12 +58,12 @@     hasn't (stage . _DevotedServantsTurn) game     ==> forAll (arbitraryDevotedServantPassCommand game) $ verbose_runCommandErrors game . getBlind -prop_devotedServantPassCommandUpdatesPasses :: GameAtDevotedServantsTurn -> Property-prop_devotedServantPassCommandUpdatesPasses (GameAtDevotedServantsTurn game) =+prop_devotedServantPassCommandSetsPassed :: GameAtDevotedServantsTurn -> Property+prop_devotedServantPassCommandSetsPassed (GameAtDevotedServantsTurn game) =     forAll (arbitraryDevotedServantPassCommand game) $ \(Blind command) -> do         let game' = run_ (apply command) game -        length (game' ^. passes) == 1+        game' ^. passed  prop_witchPassCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property prop_witchPassCommandErrorsWhenGameIsOver (GameAtGameOver game) =@@ -89,9 +87,9 @@     hasn't (stage . _WitchsTurn) game     ==> forAll (arbitraryWitchPassCommand game) $ verbose_runCommandErrors game . getBlind -prop_witchPassCommandUpdatesPasses :: GameAtWitchsTurn -> Property-prop_witchPassCommandUpdatesPasses (GameAtWitchsTurn game) =+prop_witchPassCommandSetsPassed :: GameAtWitchsTurn -> Property+prop_witchPassCommandSetsPassed (GameAtWitchsTurn game) =     forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> do         let game' = run_ (apply command) game -        length (game' ^. passes) == 1+        game' ^. passed
test/src/Game/Werewolf/Test/Command/Poison.hs view
@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# LANGUAGE OverloadedStrings #-}- module Game.Werewolf.Test.Command.Poison (     -- * Tests     allPoisonCommandTests,
test/src/Game/Werewolf/Test/Command/Protect.hs view
@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# LANGUAGE OverloadedStrings #-}- module Game.Werewolf.Test.Command.Protect (     -- * Tests     allProtectCommandTests,
test/src/Game/Werewolf/Test/Command/Quit.hs view
@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# LANGUAGE OverloadedStrings #-}- module Game.Werewolf.Test.Command.Quit (     -- * Tests     allQuitCommandTests,@@ -39,7 +37,7 @@     , testProperty "quit command clears protect when caller is protector"               prop_quitCommandClearsProtectWhenCallerIsProtector     , testProperty "quit command clears player's devour vote"                           prop_quitCommandClearsPlayersDevourVote     , testProperty "quit command clears player's lynch vote"                            prop_quitCommandClearsPlayersLynchVote-    , testProperty "quit command clears role model when caller is wild-child"           prop_quitCommandClearsRoleModelWhenCallerIsWildChild+    , testProperty "quit command clears role model when caller is orphan"               prop_quitCommandClearsRoleModelWhenCallerIsOrphan     , testProperty "quit command sets angel's allegiance when caller is angel"          prop_quitCommandSetsAngelsAllegianceWhenCallerIsAngel     ] @@ -73,7 +71,7 @@     let wolfHoundsName  = game ^?! players . wolfHounds . name     let command         = quitCommand wolfHoundsName -    isNothing $ run_ (apply command) game ^. allegianceChosen+    run_ (apply command) game ^. allegianceChosen  prop_quitCommandClearsHealWhenCallerIsWitch :: GameWithHeal -> Bool prop_quitCommandClearsHealWhenCallerIsWitch (GameWithHeal game) = do@@ -131,10 +129,10 @@          isNothing $ run_ (apply command) game ^. votes . at (caller ^. name) -prop_quitCommandClearsRoleModelWhenCallerIsWildChild :: GameWithRoleModel -> Bool-prop_quitCommandClearsRoleModelWhenCallerIsWildChild (GameWithRoleModel game) = do-    let wildChild   = game ^?! players . wildChildren-    let command     = quitCommand (wildChild ^. name)+prop_quitCommandClearsRoleModelWhenCallerIsOrphan :: GameWithRoleModel -> Bool+prop_quitCommandClearsRoleModelWhenCallerIsOrphan (GameWithRoleModel game) = do+    let orphan  = game ^?! players . orphans+    let command = quitCommand (orphan ^. name)      isNothing $ run_ (apply command) game ^. roleModel
test/src/Game/Werewolf/Test/Command/Reveal.hs view
@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# LANGUAGE OverloadedStrings #-}- module Game.Werewolf.Test.Command.Reveal (     -- * Tests     allRevealCommandTests,@@ -34,7 +32,7 @@     , testProperty "reveal command sets caller's role"                      prop_revealCommandSetsCallersRole     , testProperty "reveal command sets target's role"                      prop_revealCommandSetsTargetsRole     , testProperty "reveal command resets role when jester"                 prop_revealCommandResetsRoleWhenJester-    , testProperty "reveal command resets role when wild-child"             prop_revealCommandResetsRoleWhenWildChild+    , testProperty "reveal command resets role when orphan"                 prop_revealCommandResetsRoleWhenOrphan     , testProperty "reveal command resets role when witch"                  prop_revealCommandResetsRoleWhenWitch     , testProperty "reveal command resets role when wolf-hound"             prop_revealCommandResetsRoleWhenWolfHound     ]@@ -101,8 +99,8 @@         targetsName = head (getVoteResult game) ^. name         game'       = game & players . traverse . filteredBy name targetsName . role .~ jesterRole & jesterRevealed .~ True -prop_revealCommandResetsRoleWhenWildChild :: GameAtDevotedServantsTurn -> Bool-prop_revealCommandResetsRoleWhenWildChild (GameAtDevotedServantsTurn game) = do+prop_revealCommandResetsRoleWhenOrphan :: GameAtDevotedServantsTurn -> Bool+prop_revealCommandResetsRoleWhenOrphan (GameAtDevotedServantsTurn game) = do     let devotedServantsName = game ^?! players . devotedServants . name     let command             = revealCommand devotedServantsName     let game''              = run_ (apply command) game'@@ -110,7 +108,7 @@     isNothing $ game'' ^. roleModel     where         targetsName = head (getVoteResult game) ^. name-        game'       = game & players . traverse . filteredBy name targetsName . role .~ wildChildRole & roleModel .~ Just targetsName+        game'       = game & players . traverse . filteredBy name targetsName . role .~ orphanRole & roleModel .~ Just targetsName  prop_revealCommandResetsRoleWhenWitch :: GameAtDevotedServantsTurn -> Bool prop_revealCommandResetsRoleWhenWitch (GameAtDevotedServantsTurn game) = do@@ -129,7 +127,7 @@     let command             = revealCommand devotedServantsName     let game''              = run_ (apply command) game' -    isNothing $ game'' ^. allegianceChosen+    not $ game'' ^. allegianceChosen     where         targetsName = head (getVoteResult game) ^. name-        game'       = game & players . traverse . filteredBy name targetsName . role .~ wolfHoundRole & allegianceChosen .~ Just Villagers+        game'       = game & players . traverse . filteredBy name targetsName . role .~ wolfHoundRole & allegianceChosen .~ True
test/src/Game/Werewolf/Test/Command/See.hs view
@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# LANGUAGE OverloadedStrings #-}- module Game.Werewolf.Test.Command.See (     -- * Tests     allSeeCommandTests,
test/src/Game/Werewolf/Test/Command/Vote.hs view
@@ -5,8 +5,6 @@ Maintainer  : public@hjwylde.com -} -{-# LANGUAGE OverloadedStrings #-}- module Game.Werewolf.Test.Command.Vote (     -- * Tests     allVoteCommandTests,
test/src/Game/Werewolf/Test/Engine.hs view
@@ -16,16 +16,23 @@ import Control.Monad.Except import Control.Monad.Writer -import           Data.Either.Extra-import           Data.List.Extra-import qualified Data.Map          as Map-import           Data.Maybe+import Data.Either.Extra+import Data.List.Extra  import Game.Werewolf-import Game.Werewolf.Command.DevotedServant-import Game.Werewolf.Command.Global-import Game.Werewolf.Command.Villager import Game.Werewolf.Test.Arbitrary+import Game.Werewolf.Test.Engine.Angel+import Game.Werewolf.Test.Engine.DevotedServant+import Game.Werewolf.Test.Engine.Hunter+import Game.Werewolf.Test.Engine.Lynching+import Game.Werewolf.Test.Engine.Orphan+import Game.Werewolf.Test.Engine.Protector+import Game.Werewolf.Test.Engine.Scapegoat+import Game.Werewolf.Test.Engine.Seer+import Game.Werewolf.Test.Engine.Village+import Game.Werewolf.Test.Engine.Werewolf+import Game.Werewolf.Test.Engine.Witch+import Game.Werewolf.Test.Engine.WolfHound import Game.Werewolf.Test.Util  import Prelude hiding (round)@@ -35,428 +42,39 @@ import Test.Tasty.QuickCheck  allEngineTests :: [TestTree]-allEngineTests =-    [ testProperty "check stage skips devoted servant's turn when no devoted servant"   prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant-    , testProperty "check stage skips protector's turn when no protector"               prop_checkStageSkipsProtectorsTurnWhenNoProtector-    , testProperty "check stage skips scapegoat's turn when no scapegoat"               prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat-    , testProperty "check stage skips seer's turn when no seer"                         prop_checkStageSkipsSeersTurnWhenNoSeer-    , testProperty "check stage skips village's turn when allowed voters empty"         prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty-    , testProperty "check stage skips wild-child's turn when no wild-child"             prop_checkStageSkipsWildChildsTurnWhenNoWildChild-    , testProperty "check stage skips witch's turn when no witch"                       prop_checkStageSkipsWitchsTurnWhenNoWitch-    , testProperty "check stage skips wolf-hound's turn when no wolf-hound"             prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound--    , testProperty "check devoted servant's turn advances to wolf-hound's turn"             prop_checkDevotedServantsTurnAdvancesToWolfHoundsTurn-    , testProperty "check devoted servant's turn advances when no devoted servant"          prop_checkDevotedServantsTurnAdvancesWhenNoDevotedServant-    , testProperty "check devoted servant's turn does nothing unless revealed or passed"    prop_checkDevotedServantsTurnDoesNothingUnlessRevealedOrPassed+allEngineTests = concat+    [ allAngelEngineTests+    , allDevotedServantEngineTests+    , allHunterEngineTests+    , allLynchingEngineTests+    , allOrphanEngineTests+    , allProtectorEngineTests+    , allScapegoatEngineTests+    , allSeerEngineTests+    , allVillageEngineTests+    , allWerewolfEngineTests+    , allWitchEngineTests+    , allWolfHoundEngineTests -    , testProperty "check lynching lynches one player when consensus"                   prop_checkLynchingLynchesOnePlayerWhenConsensus-    , testProperty "check lynching lynches no one when target is jester"                prop_checkLynchingLynchesNoOneWhenTargetIsJester-    , testProperty "check lynching lynches scapegoat when conflicted"                   prop_checkLynchingLynchesScapegoatWhenConflicted-    , testProperty "check lynching lynches no one when conflicted and no scapegoats"    prop_checkLynchingLynchesNoOneWhenConflictedAndNoScapegoats-    , testProperty "check lynching resets votes"                                        prop_checkLynchingResetsVotes-    , testProperty "check lynching sets allowed voters"                                 prop_checkLynchingSetsAllowedVoters+    , allGameOverTests+    , allStartGameTests+    ] -    , testProperty "check game over advances stage when one allegiance alive"                   prop_checkGameOverAdvancesStageWhenOneAllegianceAlive-    -- TODO (hjw): pending-    --, testProperty "check game over does nothing when at least two allegiances alive"   prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive+allGameOverTests :: [TestTree]+allGameOverTests =+    [ testProperty "check game over advances stage when one allegiance alive"                   prop_checkGameOverAdvancesStageWhenOneAllegianceAlive     , testProperty "check game over advances stage when after first round and angel dead"       prop_checkGameOverAdvancesStageWhenAfterFirstRoundAndAngelDead     , testProperty "check game over does nothing when angel dead but aligned with villagers"    prop_checkGameOverDoesNothingWhenAngelDeadButAlignedWithVillagers     , testProperty "check game over does nothing when game over"                                prop_checkGameOverDoesNothingWhenGameOver--    , testProperty "check protector's turn advances to werewolves' turn"    prop_checkProtectorsTurnAdvancesToWerewolvesTurn-    , testProperty "check protector's turn advances when no protector"      prop_checkProtectorsTurnAdvancesWhenNoProtector-    , testProperty "check protector's turn does nothing unless protected"   prop_checkProtectorsTurnDoesNothingUnlessProtected--    , testProperty "check scapegoat's turn advances to wolf-hound's turn"                   prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn-    , testProperty "check scapegoat's turn skips wolf-hound's turn when allegiance chosen"  prop_checkScapegoatsTurnSkipsWolfHoundsTurnWhenAllegianceChosen-    , testProperty "check scapegoat's turn does nothing while scapegoat blamed"             prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed--    , testProperty "check seer's turn advances to wild-child's turn"    prop_checkSeersTurnAdvancesToWildChildsTurn-    , testProperty "check seer's turn advances when no seer"            prop_checkSeersTurnAdvancesWhenNoSeer-    , testProperty "check seer's turn resets sees"                      prop_checkSeersTurnResetsSee-    , testProperty "check seer's turn does nothing unless seen"         prop_checkSeersTurnDoesNothingUnlessSeen--    , testProperty "check sunrise increments round"         prop_checkSunriseIncrementsRound-    , testProperty "check sunrise sets angel's allegiance"  prop_checkSunriseSetsAngelsAllegiance--    , testProperty "check sunset sets wild-child's allegiance when role model dead" prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead--    , testProperty "check villages' turn advances to devoted servant's turn"            prop_checkVillagesTurnAdvancesToDevotedServantsTurn-    , testProperty "check villages' turn skips devoted servant's turn when conflicted"  prop_checkVillagesTurnSkipsDevotedServantsTurnWhenConflicted-    , testProperty "check villages' turn does nothing unless all voted"                 prop_checkVillagesTurnDoesNothingUnlessAllVoted--    , testProperty "check werewolves' turn advances to witch's turn"                    prop_checkWerewolvesTurnAdvancesToWitchsTurn-    , testProperty "check werewolves' turn skips witch's turn when healed and poisoned" prop_checkWerewolvesTurnSkipsWitchsTurnWhenHealedAndPoisoned-    , testProperty "check werewolves' turn kills one player when consensus"             prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus-    , testProperty "check werewolves' turn kills no one when conflicted"                prop_checkWerewolvesTurnKillsNoOneWhenConflicted-    , testProperty "check werewolves' turn kills no one when target defended"           prop_checkWerewolvesTurnKillsNoOneWhenTargetDefended-    , testProperty "check werewolves' turn resets protect"                              prop_checkWerewolvesTurnResetsProtect-    , testProperty "check werewolves' turn resets votes"                                prop_checkWerewolvesTurnResetsVotes-    , testProperty "check werewolves' turn does nothing unless all voted"               prop_checkWerewolvesTurnDoesNothingUnlessAllVoted--    , testProperty "check wild-child's turn advances to protector's turn"   prop_checkWildChildsTurnAdvancesToProtectorsTurn-    , testProperty "check wild-child's turn advances when no wild-child"    prop_checkWildChildsTurnAdvancesWhenNoWildChild-    , testProperty "check wild-child's turn does nothing unless chosen"     prop_checkWildChildsTurnDoesNothingUnlessRoleModelChosen--    , testProperty "check witch's turn advances to villages' turn"              prop_checkWitchsTurnAdvancesToVillagesTurn-    , testProperty "check witch's turn advances when no witch"                  prop_checkWitchsTurnAdvancesWhenNoWitch-    , testProperty "check witch's turn heals devouree when healed"              prop_checkWitchsTurnHealsDevoureeWhenHealed-    , testProperty "check witch's turn kills one player when poisoned"          prop_checkWitchsTurnKillsOnePlayerWhenPoisoned-    , testProperty "check witch's turn does nothing when passed"                prop_checkWitchsTurnDoesNothingWhenPassed-    , testProperty "check witch's turn does nothing unless actioned or passed"  prop_checkWitchsTurnDoesNothingUnlessActionedOrPassed-    , testProperty "check witch's turn resets heal"                             prop_checkWitchsTurnResetsHeal-    , testProperty "check witch's turn resets poison"                           prop_checkWitchsTurnResetsPoison-    , testProperty "check witch's turn clears passes"                           prop_checkWitchsTurnClearsPasses--    , testProperty "check wolf-hound's turn advances to seer's turn"                prop_checkWolfHoundsTurnAdvancesToSeersTurn-    , testProperty "check wolf-hound's turn advances when no wolf-hound"            prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound-    , testProperty "check wolf-hound's turn sets wolf-hound's allegiance"           prop_checkWolfHoundsTurnSetsWolfHoundsAllegiance-    , testProperty "check wolf-hound's turn does nothing unless allegiance chosen"  prop_checkWolfHoundsTurnDoesNothingUnlessAllegianceChosen+    ] -    , testProperty "start game uses given players"                              prop_startGameUsesGivenPlayers+allStartGameTests :: [TestTree]+allStartGameTests =+    [ testProperty "start game uses given players"                              prop_startGameUsesGivenPlayers     , testProperty "start game errors unless unique player names"               prop_startGameErrorsUnlessUniquePlayerNames     , testProperty "start game errors when less than 7 players"                 prop_startGameErrorsWhenLessThan7Players     , testProperty "start game errors when more than 1 of a restricted role"    prop_startGameErrorsWhenMoreThan1OfARestrictedRole     ]--prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant :: GameWithMajorityVote -> Bool-prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant (GameWithMajorityVote game) =-    hasn't (stage . _DevotedServantsTurn) game'-    where-        devotedServantsName = game ^?! players . devotedServants . name-        game'               = run_ (apply (quitCommand devotedServantsName) >> checkStage) game--prop_checkStageSkipsProtectorsTurnWhenNoProtector :: GameWithRoleModel -> Bool-prop_checkStageSkipsProtectorsTurnWhenNoProtector (GameWithRoleModel game) =-    hasn't (stage . _ProtectorsTurn) game'-    where-        protectorsName  = game ^?! players . protectors . name-        game'           = run_ (apply (quitCommand protectorsName) >> checkStage) game--prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat :: GameWithConflictingVote -> Bool-prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat (GameWithConflictingVote game) =-    hasn't (stage . _ScapegoatsTurn) game'-    where-        scapegoatsName  = game ^?! players . scapegoats . name-        game'           = run_ (apply (quitCommand scapegoatsName) >> checkStage) game--prop_checkStageSkipsSeersTurnWhenNoSeer :: GameWithPassAtDevotedServantsTurn -> Bool-prop_checkStageSkipsSeersTurnWhenNoSeer (GameWithPassAtDevotedServantsTurn game) =-    hasn't (stage . _SeersTurn) game'-    where-        seersName   = game ^?! players . seers . name-        game'       = run_ (apply (quitCommand seersName) >> checkStage) game--prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty :: GameAtWitchsTurn -> Property-prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty (GameAtWitchsTurn game) =-    forAll (arbitraryWitchPassCommand game') $ \(Blind passWitchsTurnCommand) -> do-        hasn't (stage . _VillagesTurn) (run_ (apply passWitchsTurnCommand >> checkStage) game')-    where-        game' = game & allowedVoters .~ []--prop_checkStageSkipsWildChildsTurnWhenNoWildChild :: GameWithSee -> Bool-prop_checkStageSkipsWildChildsTurnWhenNoWildChild (GameWithSee game) =-    hasn't (stage . _WildChildsTurn) game'-    where-        wildChildsName  = game ^?! players . wildChildren . name-        game'           = run_ (apply (quitCommand wildChildsName) >> checkStage) game--prop_checkStageSkipsWitchsTurnWhenNoWitch :: GameWithDevourVotes -> Property-prop_checkStageSkipsWitchsTurnWhenNoWitch (GameWithDevourVotes game) =-    null (run_ checkStage game' ^.. players . angels . dead)-    ==> hasn't (stage . _WitchsTurn) game'-    where-        witchsName  = game ^?! players . witches . name-        game'       = run_ (apply (quitCommand witchsName) >> checkStage) game--prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound :: GameWithProtect -> Bool-prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound (GameWithProtect game) =-    hasn't (stage . _WolfHoundsTurn) game'-    where-        wolfHoundsName  = game ^?! players . wolfHounds . name-        game'           = run_ (apply (quitCommand wolfHoundsName) >> checkStage) game--prop_checkDevotedServantsTurnAdvancesToWolfHoundsTurn :: GameAtDevotedServantsTurn -> Property-prop_checkDevotedServantsTurnAdvancesToWolfHoundsTurn (GameAtDevotedServantsTurn game) = do-    forAll (arbitraryCommand game) $ \(Blind command) ->-        isn't angel target && isn't wolfHound target-        ==> has (stage . _WolfHoundsTurn) (run_ (apply command >> checkStage) game)-    where-        target = head $ getVoteResult game--prop_checkDevotedServantsTurnAdvancesWhenNoDevotedServant :: GameAtDevotedServantsTurn -> Bool-prop_checkDevotedServantsTurnAdvancesWhenNoDevotedServant (GameAtDevotedServantsTurn game) = do-    let devotedServantsName = game ^?! players . devotedServants . name-    let command             = quitCommand devotedServantsName--    hasn't (stage . _DevotedServantsTurn) (run_ (apply command >> checkStage) game)--prop_checkDevotedServantsTurnDoesNothingUnlessRevealedOrPassed :: GameAtDevotedServantsTurn -> Bool-prop_checkDevotedServantsTurnDoesNothingUnlessRevealedOrPassed (GameAtDevotedServantsTurn game) =-    has (stage . _DevotedServantsTurn) (run_ checkStage game)--prop_checkLynchingLynchesOnePlayerWhenConsensus :: GameWithPassAtDevotedServantsTurn -> Property-prop_checkLynchingLynchesOnePlayerWhenConsensus (GameWithPassAtDevotedServantsTurn game) =-    isn't jester target-    ==> length (run_ checkStage game ^.. players . traverse . dead) == 1-    where-        target = head $ getVoteResult game--prop_checkLynchingLynchesNoOneWhenTargetIsJester :: GameAtVillagesTurn -> Bool-prop_checkLynchingLynchesNoOneWhenTargetIsJester (GameAtVillagesTurn game) = do-    let game' = foldr (\player -> run_ (apply $ voteCommand (player ^. name) (jester ^. name))) game (game ^. players)--    none (is dead) (run_ checkStage game' ^. players)-    where-        jester = game ^?! players . jesters--prop_checkLynchingLynchesScapegoatWhenConflicted :: GameAtScapegoatsTurn -> Bool-prop_checkLynchingLynchesScapegoatWhenConflicted (GameAtScapegoatsTurn game) =-    is dead $ run_ checkStage game ^?! players . scapegoats--prop_checkLynchingResetsVotes :: GameWithPassAtDevotedServantsTurn -> Property-prop_checkLynchingResetsVotes (GameWithPassAtDevotedServantsTurn game) =-    isn't devotedServant target-    ==> Map.null $ run_ checkStage game ^. votes-    where-        target = head $ getVoteResult game--prop_checkLynchingSetsAllowedVoters :: GameWithLynchVotes -> Property-prop_checkLynchingSetsAllowedVoters (GameWithLynchVotes game) =-    game' ^. allowedVoters === expectedAllowedVoters ^.. names-    where-        game' = run_ checkStage game-        expectedAllowedVoters-            | game' ^. jesterRevealed   = filter (isn't jester) $ game' ^. players-            | otherwise                 = game' ^.. players . traverse . alive--prop_checkProtectorsTurnAdvancesToWerewolvesTurn :: GameWithProtect -> Bool-prop_checkProtectorsTurnAdvancesToWerewolvesTurn (GameWithProtect game) =-    has (stage . _WerewolvesTurn) (run_ checkStage game)--prop_checkProtectorsTurnAdvancesWhenNoProtector :: GameAtProtectorsTurn -> Bool-prop_checkProtectorsTurnAdvancesWhenNoProtector (GameAtProtectorsTurn game) = do-    let protector   = game ^?! players . protectors-    let command     = quitCommand $ protector ^. name--    hasn't (stage . _ProtectorsTurn) (run_ (apply command >> checkStage) game)--prop_checkProtectorsTurnDoesNothingUnlessProtected :: GameAtProtectorsTurn -> Bool-prop_checkProtectorsTurnDoesNothingUnlessProtected (GameAtProtectorsTurn game) =-    has (stage . _ProtectorsTurn) (run_ checkStage game)--prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn :: GameWithAllowedVoters -> Bool-prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn (GameWithAllowedVoters game) =-    has (stage . _WolfHoundsTurn) (run_ checkStage game)--prop_checkScapegoatsTurnSkipsWolfHoundsTurnWhenAllegianceChosen :: GameWithAllowedVoters -> Property-prop_checkScapegoatsTurnSkipsWolfHoundsTurnWhenAllegianceChosen (GameWithAllowedVoters game) =-    forAll (elements [Villagers, Werewolves]) $ \allegiance -> do-        let game' = game & allegianceChosen .~ Just allegiance--        hasn't (stage . _WolfHoundsTurn) (run_ checkStage game')--prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed :: GameAtScapegoatsTurn -> Bool-prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed (GameAtScapegoatsTurn game) =-    has (stage . _ScapegoatsTurn) (run_ checkStage game)--prop_checkSeersTurnAdvancesToWildChildsTurn :: GameWithSee -> Bool-prop_checkSeersTurnAdvancesToWildChildsTurn (GameWithSee game) =-    has (stage . _WildChildsTurn) (run_ checkStage game)--prop_checkSeersTurnAdvancesWhenNoSeer :: GameAtSeersTurn -> Bool-prop_checkSeersTurnAdvancesWhenNoSeer (GameAtSeersTurn game) = do-    let seer    = game ^?! players . seers-    let command = quitCommand $ seer ^. name--    hasn't (stage . _SeersTurn) (run_ (apply command >> checkStage) game)--prop_checkSeersTurnResetsSee :: GameWithSee -> Bool-prop_checkSeersTurnResetsSee (GameWithSee game) =-    isNothing $ run_ checkStage game ^. see--prop_checkSeersTurnDoesNothingUnlessSeen :: GameAtSeersTurn -> Bool-prop_checkSeersTurnDoesNothingUnlessSeen (GameAtSeersTurn game) =-    has (stage . _SeersTurn) (run_ checkStage game)--prop_checkSunriseIncrementsRound :: GameAtSunrise -> Property-prop_checkSunriseIncrementsRound (GameAtSunrise game) =-    run_ checkStage game ^. round === game ^. round + 1--prop_checkSunriseSetsAngelsAllegiance :: GameAtSunrise -> Bool-prop_checkSunriseSetsAngelsAllegiance (GameAtSunrise game) = do-    let game' = run_ checkStage game--    is villager $ game' ^?! players . angels--prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead :: GameWithRoleModelAtVillagesTurn -> Property-prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead (GameWithRoleModelAtVillagesTurn game) = do-    let game' = foldr (\player -> run_ (apply $ voteCommand (player ^. name) (roleModel' ^. name))) game (game ^. players)--    let devotedServantsName = game ^?! players . devotedServants . name-    let command             = passCommand devotedServantsName--    isn't angel roleModel' && isn't devotedServant roleModel' && isn't jester roleModel'-        ==> is werewolf $ run_ (checkStage >> apply command >> checkStage) game' ^?! players . wildChildren-    where-        roleModel' = game ^?! players . traverse . filteredBy name (fromJust $ game ^. roleModel)--prop_checkVillagesTurnAdvancesToDevotedServantsTurn :: GameWithMajorityVote -> Property-prop_checkVillagesTurnAdvancesToDevotedServantsTurn (GameWithMajorityVote game) =-    isn't angel target && isn't devotedServant target-    ==> has (stage . _DevotedServantsTurn) (run_ checkStage game)-    where-        target = head $ getVoteResult game--prop_checkVillagesTurnSkipsDevotedServantsTurnWhenConflicted :: GameWithConflictingVote -> Bool-prop_checkVillagesTurnSkipsDevotedServantsTurnWhenConflicted (GameWithConflictingVote game) =-    hasn't (stage . _DevotedServantsTurn) (run_ checkStage game)---- TODO (hjw): tidy this test-prop_checkLynchingLynchesNoOneWhenConflictedAndNoScapegoats :: Game -> Property-prop_checkLynchingLynchesNoOneWhenConflictedAndNoScapegoats game =-    forAll (runArbitraryCommands n game') $ \game'' ->-    length (getVoteResult game'') > 1-    ==> run_ checkStage game'' ^. players == game' ^. players-    where-        scapegoatsName  = game ^?! players . scapegoats . name-        game'           = killPlayer scapegoatsName game & stage .~ VillagesTurn-        n               = length $ game' ^. players--prop_checkVillagesTurnDoesNothingUnlessAllVoted :: GameAtVillagesTurn -> Property-prop_checkVillagesTurnDoesNothingUnlessAllVoted (GameAtVillagesTurn game) =-    forAll (runArbitraryCommands n game) $ \game' ->-    has (stage . _VillagesTurn) (run_ checkStage game')-    where-        n = length (game ^. players) - 1--prop_checkWerewolvesTurnAdvancesToWitchsTurn :: GameWithDevourVotes -> Property-prop_checkWerewolvesTurnAdvancesToWitchsTurn (GameWithDevourVotes game) =-    length (getVoteResult game) == 1-    ==> has (stage . _WitchsTurn) (run_ checkStage game)--prop_checkWerewolvesTurnSkipsWitchsTurnWhenHealedAndPoisoned :: GameWithDevourVotes -> Bool-prop_checkWerewolvesTurnSkipsWitchsTurnWhenHealedAndPoisoned (GameWithDevourVotes game) =-    hasn't (stage . _WitchsTurn) (run_ checkStage game')-    where-        game' = game & healUsed .~ True & poisonUsed .~ True--prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus :: GameWithDevourVotes -> Property-prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus (GameWithDevourVotes game) =-    length (getVoteResult game) == 1-    ==> has (events . traverse . _DevourEvent) (run_ checkStage game)--prop_checkWerewolvesTurnKillsNoOneWhenConflicted :: GameWithDevourVotes -> Property-prop_checkWerewolvesTurnKillsNoOneWhenConflicted (GameWithDevourVotes game) =-    length (getVoteResult game) > 1-    ==> hasn't (events . traverse . _DevourEvent) (run_ checkStage game)--prop_checkWerewolvesTurnKillsNoOneWhenTargetDefended :: GameWithProtectAndDevourVotes -> Property-prop_checkWerewolvesTurnKillsNoOneWhenTargetDefended (GameWithProtectAndDevourVotes game) =-    length (getVoteResult game) == 1-    ==> hasn't (events . traverse . _DevourEvent) (run_ checkStage game')-    where-        target  = head $ getVoteResult game-        game'   = game & protect .~ Just (target ^. name)--prop_checkWerewolvesTurnResetsProtect :: GameWithProtectAndDevourVotes -> Bool-prop_checkWerewolvesTurnResetsProtect (GameWithProtectAndDevourVotes game) =-    isNothing $ run_ checkStage game ^. protect--prop_checkWerewolvesTurnResetsVotes :: GameWithDevourVotes -> Bool-prop_checkWerewolvesTurnResetsVotes (GameWithDevourVotes game) =-    Map.null $ run_ checkStage game ^. votes--prop_checkWerewolvesTurnDoesNothingUnlessAllVoted :: GameAtWerewolvesTurn -> Property-prop_checkWerewolvesTurnDoesNothingUnlessAllVoted (GameAtWerewolvesTurn game) =-    forAll (runArbitraryCommands n game) $ \game' ->-    has (stage . _WerewolvesTurn) (run_ checkStage game')-    where-        n = length (game ^.. players . werewolves) - 1--prop_checkWildChildsTurnAdvancesToProtectorsTurn :: GameAtWildChildsTurn -> Property-prop_checkWildChildsTurnAdvancesToProtectorsTurn (GameAtWildChildsTurn game) =-    forAll (arbitraryWildChildChooseCommand game) $ \(Blind command) ->-    has (stage . _ProtectorsTurn) (run_ (apply command >> checkStage) game)--prop_checkWildChildsTurnAdvancesWhenNoWildChild :: GameAtWildChildsTurn -> Bool-prop_checkWildChildsTurnAdvancesWhenNoWildChild (GameAtWildChildsTurn game) = do-    let wildChild   = game ^?! players . wildChildren-    let command     = quitCommand $ wildChild ^. name--    hasn't (stage . _WildChildsTurn) (run_ (apply command >> checkStage) game)--prop_checkWildChildsTurnDoesNothingUnlessRoleModelChosen :: GameAtWildChildsTurn -> Bool-prop_checkWildChildsTurnDoesNothingUnlessRoleModelChosen (GameAtWildChildsTurn game) =-    has (stage . _WildChildsTurn) (run_ checkStage game)--prop_checkWitchsTurnAdvancesToVillagesTurn :: GameAtWitchsTurn -> Property-prop_checkWitchsTurnAdvancesToVillagesTurn (GameAtWitchsTurn game) =-    forAll (arbitraryWitchPassCommand game) $ \(Blind command) ->-    has (stage . _VillagesTurn) (run_ (apply command >> checkStage) game)--prop_checkWitchsTurnAdvancesWhenNoWitch :: GameAtWitchsTurn -> Bool-prop_checkWitchsTurnAdvancesWhenNoWitch (GameAtWitchsTurn game) = do-    let witch   = game ^?! players . witches-    let command = quitCommand $ witch ^. name--    hasn't (stage . _WitchsTurn) (run_ (apply command >> checkStage) game)--prop_checkWitchsTurnHealsDevoureeWhenHealed :: GameWithHeal -> Property-prop_checkWitchsTurnHealsDevoureeWhenHealed (GameWithHeal game) =-    forAll (arbitraryWitchPassCommand game) $ \(Blind command) ->-    none (is dead) (run_ (apply command >> checkStage) game ^. players)--prop_checkWitchsTurnKillsOnePlayerWhenPoisoned :: GameWithPoison -> Property-prop_checkWitchsTurnKillsOnePlayerWhenPoisoned (GameWithPoison game) =-    forAll (arbitraryWitchPassCommand game) $ \(Blind command) ->-    length (run_ (apply command >> checkStage) game ^.. players . traverse . dead) == 1--prop_checkWitchsTurnDoesNothingWhenPassed :: GameAtWitchsTurn -> Property-prop_checkWitchsTurnDoesNothingWhenPassed (GameAtWitchsTurn game) =-    forAll (arbitraryWitchPassCommand game) $ \(Blind command) ->-    none (is dead) $ run_ (apply command >> checkStage) game ^. players--prop_checkWitchsTurnDoesNothingUnlessActionedOrPassed :: GameAtWitchsTurn -> Bool-prop_checkWitchsTurnDoesNothingUnlessActionedOrPassed (GameAtWitchsTurn game) =-    has (stage . _WitchsTurn) (run_ checkStage game)--prop_checkWitchsTurnResetsHeal :: GameWithHeal -> Property-prop_checkWitchsTurnResetsHeal (GameWithHeal game) =-    forAll (arbitraryWitchPassCommand game) $ \(Blind command) ->-    not $ run_ (apply command >> checkStage) game ^. heal--prop_checkWitchsTurnResetsPoison :: GameWithPoison -> Property-prop_checkWitchsTurnResetsPoison (GameWithPoison game) =-    forAll (arbitraryWitchPassCommand game) $ \(Blind command) ->-    isNothing $ run_ (apply command >> checkStage) game ^. poison--prop_checkWitchsTurnClearsPasses :: GameAtWitchsTurn -> Property-prop_checkWitchsTurnClearsPasses (GameAtWitchsTurn game) =-    forAll (arbitraryWitchPassCommand game) $ \(Blind command) ->-    null $ run_ (apply command >> checkStage) game ^. passes--prop_checkWolfHoundsTurnAdvancesToSeersTurn :: GameAtWolfHoundsTurn -> Property-prop_checkWolfHoundsTurnAdvancesToSeersTurn (GameAtWolfHoundsTurn game) =-    forAll (arbitraryWolfHoundChooseCommand game) $ \(Blind command) ->-    has (stage . _SeersTurn) (run_ (apply command >> checkStage) game)--prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound :: GameAtWolfHoundsTurn -> Bool-prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound (GameAtWolfHoundsTurn game) = do-    let wolfHound   = game ^?! players . wolfHounds-    let command     = quitCommand $ wolfHound ^. name--    hasn't (stage . _WolfHoundsTurn) (run_ (apply command >> checkStage) game)--prop_checkWolfHoundsTurnSetsWolfHoundsAllegiance :: GameWithAllegianceChosen -> Property-prop_checkWolfHoundsTurnSetsWolfHoundsAllegiance (GameWithAllegianceChosen game) =-    game' ^?! players . wolfHounds . role . allegiance === fromJust (game' ^. allegianceChosen)-    where-        game' = run_ checkStage game--prop_checkWolfHoundsTurnDoesNothingUnlessAllegianceChosen :: GameAtWolfHoundsTurn -> Bool-prop_checkWolfHoundsTurnDoesNothingUnlessAllegianceChosen (GameAtWolfHoundsTurn game) =-    has (stage . _WolfHoundsTurn) (run_ checkStage game)  prop_checkGameOverAdvancesStageWhenOneAllegianceAlive :: GameWithOneAllegianceAlive -> Property prop_checkGameOverAdvancesStageWhenOneAllegianceAlive (GameWithOneAllegianceAlive game) =
+ test/src/Game/Werewolf/Test/Engine/Angel.hs view
@@ -0,0 +1,39 @@+{-|+Module      : Game.Werewolf.Test.Engine.Angel+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com+-}++module Game.Werewolf.Test.Engine.Angel (+    -- * Tests+    allAngelEngineTests,+) where++import Control.Lens++import Game.Werewolf+import Game.Werewolf.Test.Arbitrary+import Game.Werewolf.Test.Util++import Prelude hiding (round)++import Test.QuickCheck+import Test.Tasty+import Test.Tasty.QuickCheck++allAngelEngineTests :: [TestTree]+allAngelEngineTests =+    [ testProperty "check sunrise increments round"         prop_checkSunriseIncrementsRound+    , testProperty "check sunrise sets angel's allegiance"  prop_checkSunriseSetsAngelsAllegiance+    ]++prop_checkSunriseIncrementsRound :: GameAtSunrise -> Property+prop_checkSunriseIncrementsRound (GameAtSunrise game) =+    run_ checkStage game ^. round === game ^. round + 1++prop_checkSunriseSetsAngelsAllegiance :: GameAtSunrise -> Bool+prop_checkSunriseSetsAngelsAllegiance (GameAtSunrise game) = do+    let game' = run_ checkStage game++    is villager $ game' ^?! players . angels
+ test/src/Game/Werewolf/Test/Engine/DevotedServant.hs view
@@ -0,0 +1,57 @@+{-|+Module      : Game.Werewolf.Test.Engine.DevotedServant+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com+-}++module Game.Werewolf.Test.Engine.DevotedServant (+    -- * Tests+    allDevotedServantEngineTests,+) where++import Control.Lens hiding (isn't)++import Game.Werewolf+import Game.Werewolf.Command.Global+import Game.Werewolf.Test.Arbitrary+import Game.Werewolf.Test.Util++import Test.QuickCheck+import Test.Tasty+import Test.Tasty.QuickCheck++allDevotedServantEngineTests :: [TestTree]+allDevotedServantEngineTests =+    [ testProperty "check stage skips devoted servant's turn when no devoted servant" prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant++    , testProperty "check devoted servant's turn advances to wolf-hound's turn"             prop_checkDevotedServantsTurnAdvancesToWolfHoundsTurn+    , testProperty "check devoted servant's turn advances when no devoted servant"          prop_checkDevotedServantsTurnAdvancesWhenNoDevotedServant+    , testProperty "check devoted servant's turn does nothing unless revealed or passed"    prop_checkDevotedServantsTurnDoesNothingUnlessRevealedOrPassed+    ]++prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant :: GameWithMajorityVote -> Bool+prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant (GameWithMajorityVote game) =+    hasn't (stage . _DevotedServantsTurn) game'+    where+        devotedServantsName = game ^?! players . devotedServants . name+        game'               = run_ (apply (quitCommand devotedServantsName) >> checkStage) game++prop_checkDevotedServantsTurnAdvancesToWolfHoundsTurn :: GameAtDevotedServantsTurn -> Property+prop_checkDevotedServantsTurnAdvancesToWolfHoundsTurn (GameAtDevotedServantsTurn game) = do+    forAll (arbitraryCommand game) $ \(Blind command) ->+        isn't angel target && isn't hunter target && isn't wolfHound target+        ==> has (stage . _WolfHoundsTurn) (run_ (apply command >> checkStage) game)+    where+        target = head $ getVoteResult game++prop_checkDevotedServantsTurnAdvancesWhenNoDevotedServant :: GameAtDevotedServantsTurn -> Bool+prop_checkDevotedServantsTurnAdvancesWhenNoDevotedServant (GameAtDevotedServantsTurn game) = do+    let devotedServantsName = game ^?! players . devotedServants . name+    let command             = quitCommand devotedServantsName++    hasn't (stage . _DevotedServantsTurn) (run_ (apply command >> checkStage) game)++prop_checkDevotedServantsTurnDoesNothingUnlessRevealedOrPassed :: GameAtDevotedServantsTurn -> Bool+prop_checkDevotedServantsTurnDoesNothingUnlessRevealedOrPassed (GameAtDevotedServantsTurn game) =+    has (stage . _DevotedServantsTurn) (run_ checkStage game)
+ test/src/Game/Werewolf/Test/Engine/Hunter.hs view
@@ -0,0 +1,21 @@+{-|+Module      : Game.Werewolf.Test.Engine.Hunter+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com+-}++module Game.Werewolf.Test.Engine.Hunter (+    -- * Tests+    allHunterEngineTests,+) where++import Test.Tasty++allHunterEngineTests :: [TestTree]+allHunterEngineTests =+    -- TODO (hjw): pending+    [ --testProperty "check hunter's turn advances to wolf-hound's turn when hunter lynched"+    --, testProperty "check hunter's turn advances to village's turn when hunter devoured"+    --, testProperty "check hunter's turn does nothing until hunter retaliated"+    ]
+ test/src/Game/Werewolf/Test/Engine/Lynching.hs view
@@ -0,0 +1,88 @@+{-|+Module      : Game.Werewolf.Test.Engine.Lynching+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com+-}++module Game.Werewolf.Test.Engine.Lynching (+    -- * Tests+    allLynchingEngineTests,+) where++import Control.Lens hiding (isn't)++import qualified Data.Map as Map++import Game.Werewolf+import Game.Werewolf.Command.Villager+import Game.Werewolf.Test.Arbitrary+import Game.Werewolf.Test.Util++import Test.QuickCheck+import Test.Tasty+import Test.Tasty.QuickCheck++allLynchingEngineTests :: [TestTree]+allLynchingEngineTests =+    [ testProperty "check stage skips lynching when no votes" prop_checkStageSkipsLynchingWhenNoVotes++    , testProperty "check lynching lynches one player when consensus"                   prop_checkLynchingLynchesOnePlayerWhenConsensus+    , testProperty "check lynching lynches no one when target is jester"                prop_checkLynchingLynchesNoOneWhenTargetIsJester+    , testProperty "check lynching lynches scapegoat when conflicted"                   prop_checkLynchingLynchesScapegoatWhenConflicted+    , testProperty "check lynching lynches no one when conflicted and no scapegoats"    prop_checkLynchingLynchesNoOneWhenConflictedAndNoScapegoats+    , testProperty "check lynching resets votes"                                        prop_checkLynchingResetsVotes+    , testProperty "check lynching sets allowed voters"                                 prop_checkLynchingSetsAllowedVoters+    ]++prop_checkStageSkipsLynchingWhenNoVotes :: GameWithNoAllowedVotersAtVillagesTurn -> Bool+prop_checkStageSkipsLynchingWhenNoVotes (GameWithNoAllowedVotersAtVillagesTurn game) = do+    let game' = run_ checkStage game++    hasn't (stage . _Lynching) game'++prop_checkLynchingLynchesOnePlayerWhenConsensus :: GameWithPassAtDevotedServantsTurn -> Property+prop_checkLynchingLynchesOnePlayerWhenConsensus (GameWithPassAtDevotedServantsTurn game) =+    isn't jester target+    ==> length (run_ checkStage game ^.. players . traverse . dead) == 1+    where+        target = head $ getVoteResult game++prop_checkLynchingLynchesNoOneWhenTargetIsJester :: GameAtVillagesTurn -> Bool+prop_checkLynchingLynchesNoOneWhenTargetIsJester (GameAtVillagesTurn game) = do+    let game' = foldr (\player -> run_ (apply $ voteCommand (player ^. name) (jester ^. name))) game (game ^. players)++    none (is dead) (run_ checkStage game' ^. players)+    where+        jester = game ^?! players . jesters++prop_checkLynchingLynchesScapegoatWhenConflicted :: GameAtScapegoatsTurn -> Bool+prop_checkLynchingLynchesScapegoatWhenConflicted (GameAtScapegoatsTurn game) =+    is dead $ run_ checkStage game ^?! players . scapegoats++-- TODO (hjw): tidy this test+prop_checkLynchingLynchesNoOneWhenConflictedAndNoScapegoats :: Game -> Property+prop_checkLynchingLynchesNoOneWhenConflictedAndNoScapegoats game =+    forAll (runArbitraryCommands n game') $ \game'' ->+    length (getVoteResult game'') > 1+    ==> run_ checkStage game'' ^. players == game' ^. players+    where+        scapegoatsName  = game ^?! players . scapegoats . name+        game'           = killPlayer scapegoatsName game & stage .~ VillagesTurn+        n               = length $ game' ^. players++prop_checkLynchingResetsVotes :: GameWithPassAtDevotedServantsTurn -> Property+prop_checkLynchingResetsVotes (GameWithPassAtDevotedServantsTurn game) =+    isn't devotedServant target+    ==> Map.null $ run_ checkStage game ^. votes+    where+        target = head $ getVoteResult game++prop_checkLynchingSetsAllowedVoters :: GameWithLynchVotes -> Property+prop_checkLynchingSetsAllowedVoters (GameWithLynchVotes game) =+    game' ^. allowedVoters === expectedAllowedVoters ^.. names+    where+        game' = run_ checkStage game+        expectedAllowedVoters+            | game' ^. jesterRevealed   = filter (isn't jester) $ game' ^. players+            | otherwise                 = game' ^.. players . traverse . alive
+ test/src/Game/Werewolf/Test/Engine/Orphan.hs view
@@ -0,0 +1,72 @@+{-|+Module      : Game.Werewolf.Test.Engine.Orphan+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com+-}++module Game.Werewolf.Test.Engine.Orphan (+    -- * Tests+    allOrphanEngineTests,+) where++import Control.Lens hiding (isn't)++import Data.Maybe++import Game.Werewolf+import Game.Werewolf.Command.DevotedServant+import Game.Werewolf.Command.Global+import Game.Werewolf.Command.Villager+import Game.Werewolf.Test.Arbitrary+import Game.Werewolf.Test.Util++import Test.QuickCheck+import Test.Tasty+import Test.Tasty.QuickCheck++allOrphanEngineTests :: [TestTree]+allOrphanEngineTests =+    [ testProperty "check stage skips orphan's turn when no orphan" prop_checkStageSkipsOrphansTurnWhenNoOrphan++    , testProperty "check orphan's turn advances to protector's turn"   prop_checkOrphansTurnAdvancesToProtectorsTurn+    , testProperty "check orphan's turn advances when no orphan"        prop_checkOrphansTurnAdvancesWhenNoOrphan+    , testProperty "check orphan's turn does nothing unless chosen"     prop_checkOrphansTurnDoesNothingUnlessRoleModelChosen++    , testProperty "check sunset sets orphan's allegiance when role model dead" prop_checkSunsetSetsOrphansAllegianceWhenRoleModelDead+    ]++prop_checkStageSkipsOrphansTurnWhenNoOrphan :: GameWithSee -> Bool+prop_checkStageSkipsOrphansTurnWhenNoOrphan (GameWithSee game) =+    hasn't (stage . _OrphansTurn) game'+    where+        orphansName = game ^?! players . orphans . name+        game'       = run_ (apply (quitCommand orphansName) >> checkStage) game++prop_checkOrphansTurnAdvancesToProtectorsTurn :: GameAtOrphansTurn -> Property+prop_checkOrphansTurnAdvancesToProtectorsTurn (GameAtOrphansTurn game) =+    forAll (arbitraryOrphanChooseCommand game) $ \(Blind command) ->+    has (stage . _ProtectorsTurn) (run_ (apply command >> checkStage) game)++prop_checkOrphansTurnAdvancesWhenNoOrphan :: GameAtOrphansTurn -> Bool+prop_checkOrphansTurnAdvancesWhenNoOrphan (GameAtOrphansTurn game) = do+    let orphan  = game ^?! players . orphans+    let command = quitCommand $ orphan ^. name++    hasn't (stage . _OrphansTurn) (run_ (apply command >> checkStage) game)++prop_checkOrphansTurnDoesNothingUnlessRoleModelChosen :: GameAtOrphansTurn -> Bool+prop_checkOrphansTurnDoesNothingUnlessRoleModelChosen (GameAtOrphansTurn game) =+    has (stage . _OrphansTurn) (run_ checkStage game)++prop_checkSunsetSetsOrphansAllegianceWhenRoleModelDead :: GameWithRoleModelAtVillagesTurn -> Property+prop_checkSunsetSetsOrphansAllegianceWhenRoleModelDead (GameWithRoleModelAtVillagesTurn game) = do+    let game' = foldr (\player -> run_ (apply $ voteCommand (player ^. name) (roleModel' ^. name))) game (game ^. players)++    let devotedServantsName = game ^?! players . devotedServants . name+    let command             = passCommand devotedServantsName++    isn't angel roleModel' && isn't devotedServant roleModel' && isn't hunter roleModel' && isn't jester roleModel'+        ==> is werewolf $ run_ (checkStage >> apply command >> checkStage) game' ^?! players . orphans+    where+        roleModel' = game ^?! players . traverse . filteredBy name (fromJust $ game ^. roleModel)
+ test/src/Game/Werewolf/Test/Engine/Protector.hs view
@@ -0,0 +1,52 @@+{-|+Module      : Game.Werewolf.Test.Engine.Protector+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com+-}++module Game.Werewolf.Test.Engine.Protector (+    -- * Tests+    allProtectorEngineTests,+) 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++allProtectorEngineTests :: [TestTree]+allProtectorEngineTests =+    [ testProperty "check stage skips protector's turn when no protector" prop_checkStageSkipsProtectorsTurnWhenNoProtector++    , testProperty "check protector's turn advances to werewolves' turn"    prop_checkProtectorsTurnAdvancesToWerewolvesTurn+    , testProperty "check protector's turn advances when no protector"      prop_checkProtectorsTurnAdvancesWhenNoProtector+    , testProperty "check protector's turn does nothing unless protected"   prop_checkProtectorsTurnDoesNothingUnlessProtected+    ]++prop_checkStageSkipsProtectorsTurnWhenNoProtector :: GameWithRoleModel -> Bool+prop_checkStageSkipsProtectorsTurnWhenNoProtector (GameWithRoleModel game) =+    hasn't (stage . _ProtectorsTurn) game'+    where+        protectorsName  = game ^?! players . protectors . name+        game'           = run_ (apply (quitCommand protectorsName) >> checkStage) game++prop_checkProtectorsTurnAdvancesToWerewolvesTurn :: GameWithProtect -> Bool+prop_checkProtectorsTurnAdvancesToWerewolvesTurn (GameWithProtect game) =+    has (stage . _WerewolvesTurn) (run_ checkStage game)++prop_checkProtectorsTurnAdvancesWhenNoProtector :: GameAtProtectorsTurn -> Bool+prop_checkProtectorsTurnAdvancesWhenNoProtector (GameAtProtectorsTurn game) = do+    let protector   = game ^?! players . protectors+    let command     = quitCommand $ protector ^. name++    hasn't (stage . _ProtectorsTurn) (run_ (apply command >> checkStage) game)++prop_checkProtectorsTurnDoesNothingUnlessProtected :: GameAtProtectorsTurn -> Bool+prop_checkProtectorsTurnDoesNothingUnlessProtected (GameAtProtectorsTurn game) =+    has (stage . _ProtectorsTurn) (run_ checkStage game)
+ test/src/Game/Werewolf/Test/Engine/Scapegoat.hs view
@@ -0,0 +1,51 @@+{-|+Module      : Game.Werewolf.Test.Engine.Scapegoat+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com+-}++module Game.Werewolf.Test.Engine.Scapegoat (+    -- * Tests+    allScapegoatEngineTests,+) 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++allScapegoatEngineTests :: [TestTree]+allScapegoatEngineTests =+    [ testProperty "check stage skips scapegoat's turn when no scapegoat" prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat++    , testProperty "check scapegoat's turn advances to wolf-hound's turn"                   prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn+    , testProperty "check scapegoat's turn skips wolf-hound's turn when allegiance chosen"  prop_checkScapegoatsTurnSkipsWolfHoundsTurnWhenAllegianceChosen+    , testProperty "check scapegoat's turn does nothing while scapegoat blamed"             prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed+    ]++prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat :: GameWithConflictingVote -> Bool+prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat (GameWithConflictingVote game) =+    hasn't (stage . _ScapegoatsTurn) game'+    where+        scapegoatsName  = game ^?! players . scapegoats . name+        game'           = run_ (apply (quitCommand scapegoatsName) >> checkStage) game++prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn :: GameWithAllowedVoters -> Bool+prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn (GameWithAllowedVoters game) =+    has (stage . _WolfHoundsTurn) (run_ checkStage game)++prop_checkScapegoatsTurnSkipsWolfHoundsTurnWhenAllegianceChosen :: GameWithAllowedVoters -> Bool+prop_checkScapegoatsTurnSkipsWolfHoundsTurnWhenAllegianceChosen (GameWithAllowedVoters game) = do+    let game' = game & allegianceChosen .~ True++    hasn't (stage . _WolfHoundsTurn) (run_ checkStage game')++prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed :: GameAtScapegoatsTurn -> Bool+prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed (GameAtScapegoatsTurn game) =+    has (stage . _ScapegoatsTurn) (run_ checkStage game)
+ test/src/Game/Werewolf/Test/Engine/Seer.hs view
@@ -0,0 +1,59 @@+{-|+Module      : Game.Werewolf.Test.Engine.Seer+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com+-}++module Game.Werewolf.Test.Engine.Seer (+    -- * Tests+    allSeerEngineTests,+) where++import Control.Lens++import Data.Maybe++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++allSeerEngineTests :: [TestTree]+allSeerEngineTests =+    [ testProperty "check stage skips seer's turn when no seer" prop_checkStageSkipsSeersTurnWhenNoSeer++    , testProperty "check seer's turn advances to orphan's turn"        prop_checkSeersTurnAdvancesToOrphansTurn+    , testProperty "check seer's turn advances when no seer"            prop_checkSeersTurnAdvancesWhenNoSeer+    , testProperty "check seer's turn resets sees"                      prop_checkSeersTurnResetsSee+    , testProperty "check seer's turn does nothing unless seen"         prop_checkSeersTurnDoesNothingUnlessSeen+    ]++prop_checkStageSkipsSeersTurnWhenNoSeer :: GameWithPassAtDevotedServantsTurn -> Bool+prop_checkStageSkipsSeersTurnWhenNoSeer (GameWithPassAtDevotedServantsTurn game) =+    hasn't (stage . _SeersTurn) game'+    where+        seersName   = game ^?! players . seers . name+        game'       = run_ (apply (quitCommand seersName) >> checkStage) game++prop_checkSeersTurnAdvancesToOrphansTurn :: GameWithSee -> Bool+prop_checkSeersTurnAdvancesToOrphansTurn (GameWithSee game) =+    has (stage . _OrphansTurn) (run_ checkStage game)++prop_checkSeersTurnAdvancesWhenNoSeer :: GameAtSeersTurn -> Bool+prop_checkSeersTurnAdvancesWhenNoSeer (GameAtSeersTurn game) = do+    let seer    = game ^?! players . seers+    let command = quitCommand $ seer ^. name++    hasn't (stage . _SeersTurn) (run_ (apply command >> checkStage) game)++prop_checkSeersTurnResetsSee :: GameWithSee -> Bool+prop_checkSeersTurnResetsSee (GameWithSee game) =+    isNothing $ run_ checkStage game ^. see++prop_checkSeersTurnDoesNothingUnlessSeen :: GameAtSeersTurn -> Bool+prop_checkSeersTurnDoesNothingUnlessSeen (GameAtSeersTurn game) =+    has (stage . _SeersTurn) (run_ checkStage game)
+ test/src/Game/Werewolf/Test/Engine/Village.hs view
@@ -0,0 +1,55 @@+{-|+Module      : Game.Werewolf.Test.Engine.Village+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com+-}++module Game.Werewolf.Test.Engine.Village (+    -- * Tests+    allVillageEngineTests,+) where++import Control.Lens hiding (isn't)++import Game.Werewolf+import Game.Werewolf.Test.Arbitrary+import Game.Werewolf.Test.Util++import Test.QuickCheck+import Test.Tasty+import Test.Tasty.QuickCheck++allVillageEngineTests :: [TestTree]+allVillageEngineTests =+    [ testProperty "check stage skips village's turn when allowed voters empty"         prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty++    , testProperty "check villages' turn advances to devoted servant's turn"            prop_checkVillagesTurnAdvancesToDevotedServantsTurn+    , testProperty "check villages' turn skips devoted servant's turn when conflicted"  prop_checkVillagesTurnSkipsDevotedServantsTurnWhenConflicted+    , testProperty "check villages' turn does nothing unless all voted"                 prop_checkVillagesTurnDoesNothingUnlessAllVoted+    ]++prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty :: GameAtWitchsTurn -> Property+prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty (GameAtWitchsTurn game) =+    forAll (arbitraryWitchPassCommand game') $ \(Blind passWitchsTurnCommand) -> do+        hasn't (stage . _VillagesTurn) (run_ (apply passWitchsTurnCommand >> checkStage) game')+    where+        game' = game & allowedVoters .~ []++prop_checkVillagesTurnAdvancesToDevotedServantsTurn :: GameWithMajorityVote -> Property+prop_checkVillagesTurnAdvancesToDevotedServantsTurn (GameWithMajorityVote game) =+    isn't angel target && isn't devotedServant target+    ==> has (stage . _DevotedServantsTurn) (run_ checkStage game)+    where+        target = head $ getVoteResult game++prop_checkVillagesTurnSkipsDevotedServantsTurnWhenConflicted :: GameWithConflictingVote -> Bool+prop_checkVillagesTurnSkipsDevotedServantsTurnWhenConflicted (GameWithConflictingVote game) =+    hasn't (stage . _DevotedServantsTurn) (run_ checkStage game)++prop_checkVillagesTurnDoesNothingUnlessAllVoted :: GameAtVillagesTurn -> Property+prop_checkVillagesTurnDoesNothingUnlessAllVoted (GameAtVillagesTurn game) =+    forAll (runArbitraryCommands n game) $ \game' ->+    has (stage . _VillagesTurn) (run_ checkStage game')+    where+        n = length (game ^. players) - 1
+ test/src/Game/Werewolf/Test/Engine/Werewolf.hs view
@@ -0,0 +1,89 @@+{-|+Module      : Game.Werewolf.Test.Engine.Werewolf+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com+-}++module Game.Werewolf.Test.Engine.Werewolf (+    -- * Tests+    allWerewolfEngineTests,+) where++import Control.Lens++import qualified Data.Map   as Map+import           Data.Maybe++import Game.Werewolf+import Game.Werewolf.Test.Arbitrary+import Game.Werewolf.Test.Util++import Test.QuickCheck+import Test.Tasty+import Test.Tasty.QuickCheck++allWerewolfEngineTests :: [TestTree]+allWerewolfEngineTests =+    [ testProperty "check stage skips werewolves' turn when no werewolves" prop_checkStageSkipsWerewolvesTurnWhenNoWerewolves++    , testProperty "check werewolves' turn advances to witch's turn"                    prop_checkWerewolvesTurnAdvancesToWitchsTurn+    , testProperty "check werewolves' turn skips witch's turn when healed and poisoned" prop_checkWerewolvesTurnSkipsWitchsTurnWhenHealedAndPoisoned+    , testProperty "check werewolves' turn kills one player when consensus"             prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus+    , testProperty "check werewolves' turn kills no one when conflicted"                prop_checkWerewolvesTurnKillsNoOneWhenConflicted+    , testProperty "check werewolves' turn kills no one when target defended"           prop_checkWerewolvesTurnKillsNoOneWhenTargetDefended+    , testProperty "check werewolves' turn resets protect"                              prop_checkWerewolvesTurnResetsProtect+    , testProperty "check werewolves' turn resets votes"                                prop_checkWerewolvesTurnResetsVotes+    , testProperty "check werewolves' turn does nothing unless all voted"               prop_checkWerewolvesTurnDoesNothingUnlessAllVoted+    ]++prop_checkStageSkipsWerewolvesTurnWhenNoWerewolves :: GameWithNoWerewolvesAtProtectorsTurn -> Property+prop_checkStageSkipsWerewolvesTurnWhenNoWerewolves (GameWithNoWerewolvesAtProtectorsTurn game) =+    forAll (arbitraryProtectCommand game) $ \(Blind command) -> do+        let game' = run_ (apply command) game++        hasn't (stage . _WerewolvesTurn) game'++prop_checkWerewolvesTurnAdvancesToWitchsTurn :: GameWithDevourVotes -> Property+prop_checkWerewolvesTurnAdvancesToWitchsTurn (GameWithDevourVotes game) =+    length (getVoteResult game) == 1+    ==> has (stage . _WitchsTurn) (run_ checkStage game)++prop_checkWerewolvesTurnSkipsWitchsTurnWhenHealedAndPoisoned :: GameWithDevourVotes -> Bool+prop_checkWerewolvesTurnSkipsWitchsTurnWhenHealedAndPoisoned (GameWithDevourVotes game) =+    hasn't (stage . _WitchsTurn) (run_ checkStage game')+    where+        game' = game & healUsed .~ True & poisonUsed .~ True++prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus :: GameWithDevourVotes -> Property+prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus (GameWithDevourVotes game) =+    length (getVoteResult game) == 1+    ==> has (events . traverse . _DevourEvent) (run_ checkStage game)++prop_checkWerewolvesTurnKillsNoOneWhenConflicted :: GameWithDevourVotes -> Property+prop_checkWerewolvesTurnKillsNoOneWhenConflicted (GameWithDevourVotes game) =+    length (getVoteResult game) > 1+    ==> hasn't (events . traverse . _DevourEvent) (run_ checkStage game)++prop_checkWerewolvesTurnKillsNoOneWhenTargetDefended :: GameWithProtectAndDevourVotes -> Property+prop_checkWerewolvesTurnKillsNoOneWhenTargetDefended (GameWithProtectAndDevourVotes game) =+    length (getVoteResult game) == 1+    ==> hasn't (events . traverse . _DevourEvent) (run_ checkStage game')+    where+        target  = head $ getVoteResult game+        game'   = game & protect .~ Just (target ^. name)++prop_checkWerewolvesTurnResetsProtect :: GameWithProtectAndDevourVotes -> Bool+prop_checkWerewolvesTurnResetsProtect (GameWithProtectAndDevourVotes game) =+    isNothing $ run_ checkStage game ^. protect++prop_checkWerewolvesTurnResetsVotes :: GameWithDevourVotes -> Bool+prop_checkWerewolvesTurnResetsVotes (GameWithDevourVotes game) =+    Map.null $ run_ checkStage game ^. votes++prop_checkWerewolvesTurnDoesNothingUnlessAllVoted :: GameAtWerewolvesTurn -> Property+prop_checkWerewolvesTurnDoesNothingUnlessAllVoted (GameAtWerewolvesTurn game) =+    forAll (runArbitraryCommands n game) $ \game' ->+    has (stage . _WerewolvesTurn) (run_ checkStage game')+    where+        n = length (game ^.. players . werewolves) - 1
+ test/src/Game/Werewolf/Test/Engine/Witch.hs view
@@ -0,0 +1,103 @@+{-|+Module      : Game.Werewolf.Test.Engine.Witch+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com+-}++module Game.Werewolf.Test.Engine.Witch (+    -- * Tests+    allWitchEngineTests,+) where++import Control.Lens++import Data.Maybe++import Game.Werewolf+import Game.Werewolf.Command.Global+import Game.Werewolf.Test.Arbitrary+import Game.Werewolf.Test.Util++import Test.QuickCheck+import Test.Tasty+import Test.Tasty.QuickCheck++allWitchEngineTests :: [TestTree]+allWitchEngineTests =+    [ testProperty "check stage skips witch's turn when no witch" prop_checkStageSkipsWitchsTurnWhenNoWitch++    , testProperty "check witch's turn advances to villages' turn"              prop_checkWitchsTurnAdvancesToVillagesTurn+    , testProperty "check witch's turn advances when no witch"                  prop_checkWitchsTurnAdvancesWhenNoWitch+    , testProperty "check witch's turn heals devouree when healed"              prop_checkWitchsTurnHealsDevoureeWhenHealed+    , testProperty "check witch's turn kills one player when poisoned"          prop_checkWitchsTurnKillsOnePlayerWhenPoisoned+    , testProperty "check witch's turn does nothing when passed"                prop_checkWitchsTurnDoesNothingWhenPassed+    , testProperty "check witch's turn does nothing unless actioned or passed"  prop_checkWitchsTurnDoesNothingUnlessActionedOrPassed+    , testProperty "check witch's turn resets heal"                             prop_checkWitchsTurnResetsHeal+    , testProperty "check witch's turn resets poison"                           prop_checkWitchsTurnResetsPoison+    , testProperty "check witch's turn clears passed"                           prop_checkWitchsTurnClearsPassed+    ]++prop_checkStageSkipsWitchsTurnWhenNoWitch :: GameWithDevourVotes -> Property+prop_checkStageSkipsWitchsTurnWhenNoWitch (GameWithDevourVotes game) =+    null (run_ checkStage game' ^.. players . angels . dead)+    ==> hasn't (stage . _WitchsTurn) game'+    where+        witchsName  = game ^?! players . witches . name+        game'       = run_ (apply (quitCommand witchsName) >> checkStage) game++prop_checkWitchsTurnAdvancesToVillagesTurn :: GameAtWitchsTurn -> Property+prop_checkWitchsTurnAdvancesToVillagesTurn (GameAtWitchsTurn game) =+    forAll (arbitraryWitchPassCommand game) $ \(Blind command) ->+    has (stage . _VillagesTurn) (run_ (apply command >> checkStage) game)++prop_checkWitchsTurnAdvancesWhenNoWitch :: GameAtWitchsTurn -> Bool+prop_checkWitchsTurnAdvancesWhenNoWitch (GameAtWitchsTurn game) = do+    let witch   = game ^?! players . witches+    let command = quitCommand $ witch ^. name++    hasn't (stage . _WitchsTurn) (run_ (apply command >> checkStage) game)++prop_checkWitchsTurnHealsDevoureeWhenHealed :: GameWithHeal -> Property+prop_checkWitchsTurnHealsDevoureeWhenHealed (GameWithHeal game) =+    forAll (arbitraryWitchPassCommand game) $ \(Blind command) ->+    none (is dead) (run_ (apply command >> checkStage) game ^. players)++prop_checkWitchsTurnKillsOnePlayerWhenPoisoned :: GameWithPoison -> Property+prop_checkWitchsTurnKillsOnePlayerWhenPoisoned (GameWithPoison game) =+    forAll (arbitraryWitchPassCommand game) $ \(Blind command) ->+    length (run_ (apply command >> checkStage) game ^.. players . traverse . dead) == 1++prop_checkWitchsTurnDoesNothingWhenPassed :: GameAtWitchsTurn -> Property+prop_checkWitchsTurnDoesNothingWhenPassed (GameAtWitchsTurn game) =+    forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> do+        let game' = run_ (apply command >> checkStage) game++        none (is dead) $ game' ^. players++prop_checkWitchsTurnDoesNothingUnlessActionedOrPassed :: GameAtWitchsTurn -> Bool+prop_checkWitchsTurnDoesNothingUnlessActionedOrPassed (GameAtWitchsTurn game) = do+    let game' = run_ checkStage game++    has (stage . _WitchsTurn) game'++prop_checkWitchsTurnResetsHeal :: GameWithHeal -> Property+prop_checkWitchsTurnResetsHeal (GameWithHeal game) =+    forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> do+        let game' = run_ (apply command >> checkStage) game++        not $ game' ^. heal++prop_checkWitchsTurnResetsPoison :: GameWithPoison -> Property+prop_checkWitchsTurnResetsPoison (GameWithPoison game) =+    forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> do+        let game' = run_ (apply command >> checkStage) game++        isNothing $ game' ^. poison++prop_checkWitchsTurnClearsPassed :: GameAtWitchsTurn -> Property+prop_checkWitchsTurnClearsPassed (GameAtWitchsTurn game) =+    forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> do+        let game' = run_ (apply command >> checkStage) game++        not $ game' ^. passed
+ test/src/Game/Werewolf/Test/Engine/WolfHound.hs view
@@ -0,0 +1,56 @@+{-|+Module      : Game.Werewolf.Test.Engine.WolfHound+Copyright   : (c) Henry J. Wylde, 2016+License     : BSD3+Maintainer  : public@hjwylde.com+-}++module Game.Werewolf.Test.Engine.WolfHound (+    -- * Tests+    allWolfHoundEngineTests,+) where++import Control.Lens++import Game.Werewolf+import Game.Werewolf.Command.Global+import Game.Werewolf.Test.Arbitrary+import Game.Werewolf.Test.Util++import Test.QuickCheck+import Test.Tasty+import Test.Tasty.QuickCheck++allWolfHoundEngineTests :: [TestTree]+allWolfHoundEngineTests =+    [ testProperty "check stage skips wolf-hound's turn when no wolf-hound"             prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound++    , testProperty "check wolf-hound's turn advances to seer's turn"                prop_checkWolfHoundsTurnAdvancesToSeersTurn+    , testProperty "check wolf-hound's turn advances when no wolf-hound"            prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound+    , testProperty "check wolf-hound's turn does nothing unless allegiance chosen"  prop_checkWolfHoundsTurnDoesNothingUnlessAllegianceChosen+    ]++prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound :: GameWithProtect -> Bool+prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound (GameWithProtect game) =+    hasn't (stage . _WolfHoundsTurn) game'+    where+        wolfHoundsName  = game ^?! players . wolfHounds . name+        game'           = run_ (apply (quitCommand wolfHoundsName) >> checkStage) game++prop_checkWolfHoundsTurnAdvancesToSeersTurn :: GameAtWolfHoundsTurn -> Property+prop_checkWolfHoundsTurnAdvancesToSeersTurn (GameAtWolfHoundsTurn game) =+    forAll (arbitraryWolfHoundChooseCommand game) $ \(Blind command) -> do+        let game' = run_ (apply command >> checkStage) game++        has (stage . _SeersTurn) game'++prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound :: GameAtWolfHoundsTurn -> Bool+prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound (GameAtWolfHoundsTurn game) = do+    let wolfHound   = game ^?! players . wolfHounds+    let command     = quitCommand $ wolfHound ^. name++    hasn't (stage . _WolfHoundsTurn) (run_ (apply command >> checkStage) game)++prop_checkWolfHoundsTurnDoesNothingUnlessAllegianceChosen :: GameAtWolfHoundsTurn -> Bool+prop_checkWolfHoundsTurnDoesNothingUnlessAllegianceChosen (GameAtWolfHoundsTurn game) =+    has (stage . _WolfHoundsTurn) (run_ checkStage game)
test/src/Game/Werewolf/Test/Game.hs view
@@ -12,8 +12,6 @@  import Control.Lens -import Data.Maybe- import Game.Werewolf import Game.Werewolf.Test.Arbitrary () @@ -27,20 +25,24 @@     [ testProperty "new game starts at village's turn when angel in play"   prop_newGameStartsAtVillagesTurnWhenAngelInPlay     , testProperty "new game starts at sunset when no angel in play"        prop_newGameStartsAtSunsetWhenNoAngelInPlay     , testProperty "new game starts on first round"                         prop_newGameStartsOnFirstRound+    , testProperty "new game uses given players"                            prop_newGameUsesGivenPlayers     , testProperty "new game starts with events empty"                      prop_newGameStartsWithEventsEmpty-    , testProperty "new game starts with passes empty"                      prop_newGameStartsWithPassesEmpty+    , testProperty "new game starts with boots empty"                       prop_newGameStartsWithBootsEmpty+    , testProperty "new game starts with allegiance chosen false"           prop_newGameStartsWithAllegianceChosenFalse     , testProperty "new game starts with allowed voters full"               prop_newGameStartsWithAllowedVotersFull     , testProperty "new game starts with heal false"                        prop_newGameStartsWithHealFalse     , testProperty "new game starts with heal used false"                   prop_newGameStartsWithHealUsedFalse+    , testProperty "new game starts with hunter retaliated false"           prop_newGameStartsWithHunterRetaliatedFalse+    , testProperty "new game starts with jester revealed false"             prop_newGameStartsWithJesterRevealedFalse+    , testProperty "new game starts with passed false"                      prop_newGameStartsWithPassedFalse     , testProperty "new game starts with no poison"                         prop_newGameStartsWithNoPoison     , testProperty "new game starts with poison used false"                 prop_newGameStartsWithPoisonUsedFalse     , testProperty "new game starts with no prior protect"                  prop_newGameStartsWithNoPriorProtect     , testProperty "new game starts with no protect"                        prop_newGameStartsWithNoProtect+    , testProperty "new game starts with no role model"                     prop_newGameStartsWithNoRoleModel     , testProperty "new game starts with scapegoat blamed false"            prop_newGameStartsWithScapegoatBlamedFalse     , testProperty "new game starts with no see"                            prop_newGameStartsWithNoSee-    , testProperty "new game starts with jester revealed false"             prop_newGameStartsWithJesterRevealedFalse     , testProperty "new game starts with votes empty"                       prop_newGameStartsWithVotesEmpty-    , testProperty "new game uses given players"                            prop_newGameUsesGivenPlayers     ]  prop_newGameStartsAtVillagesTurnWhenAngelInPlay :: [Player] -> Property@@ -56,12 +58,18 @@ prop_newGameStartsOnFirstRound :: [Player] -> Bool prop_newGameStartsOnFirstRound players = isFirstRound $ newGame players +prop_newGameUsesGivenPlayers :: [Player] -> Bool+prop_newGameUsesGivenPlayers players' = newGame players' ^. players == players'+ prop_newGameStartsWithEventsEmpty :: [Player] -> Bool prop_newGameStartsWithEventsEmpty players = has (events . _Empty) (newGame players) -prop_newGameStartsWithPassesEmpty :: [Player] -> Bool-prop_newGameStartsWithPassesEmpty players = has (passes . _Empty) (newGame players)+prop_newGameStartsWithBootsEmpty :: [Player] -> Bool+prop_newGameStartsWithBootsEmpty players = has (boots . _Empty) (newGame players) +prop_newGameStartsWithAllegianceChosenFalse :: [Player] -> Bool+prop_newGameStartsWithAllegianceChosenFalse players = not $ newGame players ^. allegianceChosen+ prop_newGameStartsWithAllowedVotersFull :: [Player] -> Property prop_newGameStartsWithAllowedVotersFull players = newGame players ^. allowedVoters === players ^.. names @@ -71,30 +79,35 @@ prop_newGameStartsWithHealUsedFalse :: [Player] -> Bool prop_newGameStartsWithHealUsedFalse players = not $ newGame players ^. healUsed +prop_newGameStartsWithHunterRetaliatedFalse :: [Player] -> Bool+prop_newGameStartsWithHunterRetaliatedFalse players = not $ newGame players ^. hunterRetaliated++prop_newGameStartsWithJesterRevealedFalse :: [Player] -> Bool+prop_newGameStartsWithJesterRevealedFalse players = not $ newGame players ^. jesterRevealed++prop_newGameStartsWithPassedFalse :: [Player] -> Bool+prop_newGameStartsWithPassedFalse players = not $ newGame players ^. passed+ prop_newGameStartsWithNoPoison :: [Player] -> Bool-prop_newGameStartsWithNoPoison players = isNothing $ newGame players ^. poison+prop_newGameStartsWithNoPoison players = has (poison . _Nothing) (newGame players)  prop_newGameStartsWithPoisonUsedFalse :: [Player] -> Bool prop_newGameStartsWithPoisonUsedFalse players = not $ newGame players ^. poisonUsed  prop_newGameStartsWithNoPriorProtect :: [Player] -> Bool-prop_newGameStartsWithNoPriorProtect players = isNothing $ newGame players ^. priorProtect+prop_newGameStartsWithNoPriorProtect players = has (priorProtect . _Nothing) (newGame players)  prop_newGameStartsWithNoProtect :: [Player] -> Bool-prop_newGameStartsWithNoProtect players = isNothing $ newGame players ^. protect+prop_newGameStartsWithNoProtect players = has (protect . _Nothing) (newGame players) +prop_newGameStartsWithNoRoleModel :: [Player] -> Bool+prop_newGameStartsWithNoRoleModel players = has (roleModel . _Nothing) (newGame players)+ prop_newGameStartsWithScapegoatBlamedFalse :: [Player] -> Bool prop_newGameStartsWithScapegoatBlamedFalse players = not $ newGame players ^. scapegoatBlamed  prop_newGameStartsWithNoSee :: [Player] -> Bool-prop_newGameStartsWithNoSee players = isNothing $ newGame players ^. see--prop_newGameStartsWithJesterRevealedFalse :: [Player] -> Bool-prop_newGameStartsWithJesterRevealedFalse players =-    not $ newGame players ^. jesterRevealed+prop_newGameStartsWithNoSee players = has (see . _Nothing) (newGame players)  prop_newGameStartsWithVotesEmpty :: [Player] -> Bool prop_newGameStartsWithVotesEmpty players = has (votes . _Empty) (newGame players)--prop_newGameUsesGivenPlayers :: [Player] -> Bool-prop_newGameUsesGivenPlayers players' = newGame players' ^. players == players'
werewolf.cabal view
@@ -1,5 +1,5 @@ name:           werewolf-version:        0.5.1.0+version:        0.5.2.0  author:         Henry J. Wylde maintainer:     public@hjwylde.com@@ -78,13 +78,14 @@         Game.Werewolf.Command         Game.Werewolf.Command.DevotedServant         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.WildChild         Game.Werewolf.Command.Witch         Game.Werewolf.Command.WolfHound         Game.Werewolf.Engine@@ -135,6 +136,18 @@         Game.Werewolf.Test.Command.See         Game.Werewolf.Test.Command.Vote         Game.Werewolf.Test.Engine+        Game.Werewolf.Test.Engine.Angel+        Game.Werewolf.Test.Engine.DevotedServant+        Game.Werewolf.Test.Engine.Hunter+        Game.Werewolf.Test.Engine.Lynching+        Game.Werewolf.Test.Engine.Orphan+        Game.Werewolf.Test.Engine.Protector+        Game.Werewolf.Test.Engine.Scapegoat+        Game.Werewolf.Test.Engine.Seer+        Game.Werewolf.Test.Engine.Village+        Game.Werewolf.Test.Engine.Werewolf+        Game.Werewolf.Test.Engine.Witch+        Game.Werewolf.Test.Engine.WolfHound         Game.Werewolf.Test.Game         Game.Werewolf.Test.Player         Game.Werewolf.Test.Util