packages feed

werewolf 0.5.3.0 → 0.5.4.0

raw patch · 50 files changed

+322/−1340 lines, 50 filesdep +tostring

Dependencies added: tostring

Files

CHANGELOG.md view
@@ -2,6 +2,18 @@  ### Upcoming +### v0.5.4.0++*Minor*++* Added `--include-seer` option to `start`. ([#179](https://github.com/hjwylde/werewolf/issues/179))+* Added the Village Drunk role. ([#160](https://github.com/hjwylde/werewolf/issues/160))++*Revisions*++* Minor updates to the `help rules` text.+* Removed most logical tests and kept error ones. ([#164](https://github.com/hjwylde/werewolf/issues/164))+ ### v0.5.3.0  *Minor*@@ -43,7 +55,7 @@ *Revisions*  * Updated the Protector's description and rules. ([#132](https://github.com/hjwylde/werewolf/issues/132))-* Improved the Enligsh used. ([#72](https://github.com/hjwylde/werewolf/issues/72))+* Improved the English used. ([#72](https://github.com/hjwylde/werewolf/issues/72)) * Added which player is the Villager-Villager to `status`. ([#144](https://github.com/hjwylde/werewolf/issues/144))  ### v0.5.0.0
README.md view
@@ -40,6 +40,7 @@ The Ambiguous are able to change allegiance throughout the game.  * Orphan+* Village Drunk  **The Loners:**
app/Werewolf/Command/Boot.hs view
@@ -19,6 +19,7 @@  import Control.Monad.Except import Control.Monad.Extra+import Control.Monad.Random import Control.Monad.State import Control.Monad.Writer @@ -34,7 +35,7 @@     { argTarget :: Text     } deriving (Eq, Show) -handle :: MonadIO m => Text -> Text -> Options -> m ()+handle :: (MonadIO m, MonadRandom m) => Text -> Text -> Options -> m () handle callerName tag (Options targetName) = do     unlessM (doesGameExist tag) $ exitWith failure         { messages = [noGameRunningMessage callerName]@@ -44,6 +45,7 @@      let command = bootCommand callerName targetName -    case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of+    result <- runExceptT . runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game+    case result of         Left errorMessages      -> exitWith failure { messages = errorMessages }         Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Choose.hs view
@@ -22,6 +22,7 @@ import Control.Lens import Control.Monad.Except import Control.Monad.Extra+import Control.Monad.Random import Control.Monad.State import Control.Monad.Writer @@ -39,7 +40,7 @@     { args :: [Text]     } deriving (Eq, Show) -handle :: MonadIO m => Text -> Text -> Options -> m ()+handle :: (MonadIO m, MonadRandom m) => Text -> Text -> Options -> m () handle callerName tag (Options args) = do     unlessM (doesGameExist tag) $ exitWith failure         { messages = [noGameRunningMessage callerName]@@ -56,6 +57,7 @@                 { messages = [playerCannotDoThatRightNowMessage callerName]                 } -    case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of+    result <- runExceptT . runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game+    case result of         Left errorMessages      -> exitWith failure { messages = errorMessages }         Right (game, messages)  -> writeOrDeleteGame tag game >> exitWith success { messages = messages }
app/Werewolf/Command/Circle.hs view
@@ -44,6 +44,6 @@      let command = circleCommand callerName includeDead -    case runExcept (execWriterT $ execStateT (apply command) game) of+    case runExcept . execWriterT $ execStateT (apply command) game of         Left errorMessages  -> exitWith failure { messages = errorMessages }         Right messages      -> exitWith success { messages = messages }
app/Werewolf/Command/Heal.hs view
@@ -18,6 +18,7 @@  import Control.Monad.Except import Control.Monad.Extra+import Control.Monad.Random import Control.Monad.State import Control.Monad.Writer @@ -29,7 +30,7 @@ import Werewolf.Game import Werewolf.Messages -handle :: MonadIO m => Text -> Text -> m ()+handle :: (MonadIO m, MonadRandom m) => Text -> Text -> m () handle callerName tag = do     unlessM (doesGameExist tag) $ exitWith failure         { messages = [noGameRunningMessage callerName]@@ -39,6 +40,7 @@      let command = healCommand callerName -    case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of+    result <- runExceptT . runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game+    case result of         Left errorMessages      -> exitWith failure { messages = errorMessages }         Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Help.hs view
@@ -73,7 +73,7 @@ commandsMessages :: Text -> Maybe Game -> [Text] commandsMessages callerName mGame = map (T.intercalate "\n") $ filter (/= [])     [ [ "Global commands:"-      , "- `start ([-e | --extra-roles ROLE,...] | [-r | --random-extra-roles]) PLAYER...`"+      , "- `start ([-e | --extra-roles ROLE,...] | [-r | --random-extra-roles]) [--include-seer] PLAYER...`"       , "- `end`"       , "- `boot PLAYER`"       , "- `quit`"@@ -125,35 +125,38 @@ rulesMessages :: Maybe Game -> [Text] rulesMessages mGame = map (T.intercalate "\n")     [ [ T.unwords+        [ "Each player is informed of their role (see `help roles` for a list) at the start of the"+        , "game."+        ]+      , T.unwords         [ "Each night, the Werewolves transform and subsequently assault and devour one Villager."-        , "After feasting their lycanthropic form subsides and they once again hide in plain sight."+        , "After feasting, their lycanthropic form subsides and they once again hide in plain"+        , "sight."         ]       , T.unwords         [ "Each day, after discovering the victim, the village gathers in the town square. In a"         , "democratic fashion they then vote for whom they believe to be a Werewolf. The votee is"-        , "immediately tied to a pyre and burned alive in an attempt to rid them of any"-        , "lycanthropy."-        ]-    , T.unwords-        [ "The number of Werewolves in play depends upon the number of players and extra roles in"-        , "the game."+        , "immediately tied to a pyre and burned alive in an attempt to rid Fougères of all"+        , "lupines."         ]       ]-    , filter (/= "") [ T.concat-        [ "Each player is informed of their role (see `help roles` for a list) at the start of the"-        , "game. A game begins at night and follows a standard cycle."+    , filter (/= "")+      [ T.concat+        [ "A game begins at night and follows a standard cycle."         , whenRoleInPlay mGame fallenAngelRole-          " (N.B., when the Fallen Angel is in play the game begins with the village vote.)"+            " (N.B., when the Fallen Angel is in play the game begins with the village vote.)"         ]       , whenRoleInPlay mGame fallenAngelRole         "- (When the Fallen Angel is in play) the village votes to lynch a suspect."       , "- The village falls asleep."       , 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 villageDrunkRole+        "- (Third round only) the Village Drunk sobers up and remembers their allegiance."       , whenRoleInPlay mGame seerRole         "- The Seer wakes up and sees someone's allegiance."+      , whenRoleInPlay mGame protectorRole+        "- The Protector wakes up and protects someone."       , "- The Werewolves wake up and vote to devour a victim."       , whenRoleInPlay mGame witchRole         "- The Witch wakes up and may heal the victim and/or poison someone."
app/Werewolf/Command/Pass.hs view
@@ -16,6 +16,7 @@  import Control.Monad.Except import Control.Monad.Extra+import Control.Monad.Random import Control.Monad.State import Control.Monad.Writer @@ -27,7 +28,7 @@ import Werewolf.Game import Werewolf.Messages -handle :: MonadIO m => Text -> Text -> m ()+handle :: (MonadIO m, MonadRandom m) => Text -> Text -> m () handle callerName tag = do     unlessM (doesGameExist tag) $ exitWith failure         { messages = [noGameRunningMessage callerName]@@ -37,6 +38,7 @@      let command = passCommand callerName -    case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of+    result <- runExceptT . runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game+    case result of         Left errorMessages      -> exitWith failure { messages = errorMessages }         Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Ping.hs view
@@ -37,6 +37,6 @@      let command = pingCommand callerName -    case runExcept (execWriterT $ execStateT (apply command) game) of+    case runExcept . execWriterT $ execStateT (apply command) game of         Left errorMessages  -> exitWith failure { messages = errorMessages }         Right messages      -> exitWith success { messages = messages }
app/Werewolf/Command/Poison.hs view
@@ -19,6 +19,7 @@  import Control.Monad.Except import Control.Monad.Extra+import Control.Monad.Random import Control.Monad.State import Control.Monad.Writer @@ -34,7 +35,7 @@     { argTarget :: Text     } deriving (Eq, Show) -handle :: MonadIO m => Text -> Text -> Options -> m ()+handle :: (MonadIO m, MonadRandom m) => Text -> Text -> Options -> m () handle callerName tag (Options targetName) = do     unlessM (doesGameExist tag) $ exitWith failure         { messages = [noGameRunningMessage callerName]@@ -44,6 +45,7 @@      let command = poisonCommand callerName targetName -    case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of+    result <- runExceptT . runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game+    case result of         Left errorMessages      -> exitWith failure { messages = errorMessages }         Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Protect.hs view
@@ -19,6 +19,7 @@  import Control.Monad.Except import Control.Monad.Extra+import Control.Monad.Random import Control.Monad.State import Control.Monad.Writer @@ -34,7 +35,7 @@     { argTarget :: Text     } deriving (Eq, Show) -handle :: MonadIO m => Text -> Text -> Options -> m ()+handle :: (MonadIO m, MonadRandom m) => Text -> Text -> Options -> m () handle callerName tag (Options targetName) = do     unlessM (doesGameExist tag) $ exitWith failure         { messages = [noGameRunningMessage callerName]@@ -44,6 +45,7 @@      let command = protectCommand callerName targetName -    case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of+    result <- runExceptT . runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game+    case result of         Left errorMessages      -> exitWith failure { messages = errorMessages }         Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Quit.hs view
@@ -16,6 +16,7 @@  import Control.Monad.Except import Control.Monad.Extra+import Control.Monad.Random import Control.Monad.State import Control.Monad.Writer @@ -27,7 +28,7 @@ import Werewolf.Game import Werewolf.Messages -handle :: MonadIO m => Text -> Text -> m ()+handle :: (MonadIO m, MonadRandom m) => Text -> Text -> m () handle callerName tag = do     unlessM (doesGameExist tag) $ exitWith failure         { messages = [noGameRunningMessage callerName]@@ -37,6 +38,7 @@      let command = quitCommand callerName -    case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of+    result <- runExceptT . runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game+    case result of         Left errorMessages      -> exitWith failure { messages = errorMessages }         Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/See.hs view
@@ -19,6 +19,7 @@  import Control.Monad.Except import Control.Monad.Extra+import Control.Monad.Random import Control.Monad.State import Control.Monad.Writer @@ -34,7 +35,7 @@     { argTarget :: Text     } deriving (Eq, Show) -handle :: MonadIO m => Text -> Text -> Options -> m ()+handle :: (MonadIO m, MonadRandom m) => Text -> Text -> Options -> m () handle callerName tag (Options targetName) = do     unlessM (doesGameExist tag) $ exitWith failure         { messages = [noGameRunningMessage callerName]@@ -44,6 +45,7 @@      let command = seeCommand callerName targetName -    case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of+    result <- runExceptT . runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game+    case result of         Left errorMessages      -> exitWith failure { messages = errorMessages }         Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Start.hs view
@@ -28,6 +28,7 @@ import Control.Monad.State import Control.Monad.Writer +import           Data.List import           Data.Text (Text) import qualified Data.Text as T @@ -40,15 +41,16 @@ import Werewolf.Messages  data Options = Options-    { optExtraRoles :: ExtraRoles-    , argPlayers    :: [Text]+    { optExtraRoles  :: ExtraRoles+    , optIncludeSeer :: Bool+    , argPlayers     :: [Text]     } deriving (Eq, Show)  data ExtraRoles = None | Random | Use [Text]     deriving (Eq, Show) -handle :: MonadIO m => Text -> Text -> Options -> m ()-handle callerName tag (Options extraRoles playerNames) = do+handle :: (MonadIO m, MonadRandom m) => Text -> Text -> Options -> m ()+handle callerName tag (Options extraRoles includeSeer playerNames) = do     whenM (doesGameExist tag &&^ (hasn't (stage . _GameOver) <$> readGame tag)) $ exitWith failure         { messages = [gameAlreadyRunningMessage callerName]         }@@ -59,16 +61,19 @@             Random          -> randomExtraRoles $ length playerNames             Use roleNames   -> useExtraRoles callerName roleNames -        players <- createPlayers (callerName:playerNames) (padRoles extraRoles' (length playerNames + 1))+        let extraRoles''    = if includeSeer then nub (seerRole:extraRoles') else extraRoles'+        let roles           = padRoles extraRoles'' (length playerNames + 1) +        players <- createPlayers (callerName:playerNames) <$> shuffleM roles+         runWriterT $ startGame callerName players >>= execStateT checkStage      case result of         Left errorMessages      -> exitWith failure { messages = errorMessages }         Right (game, messages)  -> writeOrDeleteGame tag game >> exitWith success { messages = messages } -randomExtraRoles :: MonadIO m => Int -> m [Role]-randomExtraRoles n = liftIO . evalRandIO $ do+randomExtraRoles :: MonadRandom m => Int -> m [Role]+randomExtraRoles n = do     let minimum = n `div` 3      count <- getRandomR (minimum, minimum + 2)
app/Werewolf/Command/Status.hs view
@@ -37,6 +37,6 @@      let command = statusCommand callerName -    case runExcept (execWriterT $ execStateT (apply command) game) of+    case runExcept . execWriterT $ execStateT (apply command) game of         Left errorMessages  -> exitWith failure { messages = errorMessages }         Right messages      -> exitWith success { messages = messages }
app/Werewolf/Command/Vote.hs view
@@ -20,6 +20,7 @@ import Control.Lens import Control.Monad.Except import Control.Monad.Extra+import Control.Monad.Random import Control.Monad.State import Control.Monad.Writer @@ -36,7 +37,7 @@     { argTarget :: Text     } deriving (Eq, Show) -handle :: MonadIO m => Text -> Text -> Options -> m ()+handle :: (MonadIO m, MonadRandom m) => Text -> Text -> Options -> m () handle callerName tag (Options targetName) = do     unlessM (doesGameExist tag) $ exitWith failure         { messages = [noGameRunningMessage callerName]@@ -51,6 +52,7 @@                 { messages = [playerCannotDoThatRightNowMessage callerName]                 } -    case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of+    result <- runExceptT . runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game+    case result of         Left errorMessages      -> exitWith failure { messages = errorMessages }         Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Game.hs view
@@ -22,7 +22,6 @@  import Control.Lens         hiding (cons) import Control.Monad.Except-import Control.Monad.Random  import           Data.List.Extra import           Data.Text       (Text)@@ -34,10 +33,9 @@  import System.Directory import System.FilePath-import System.Random.Shuffle -createPlayers :: MonadIO m => [Text] -> [Role] -> m [Player]-createPlayers playerNames roles = liftIO $ zipWith newPlayer playerNames <$> evalRandIO (shuffleM roles)+createPlayers :: [Text] -> [Role] -> [Player]+createPlayers playerNames roles = zipWith newPlayer playerNames roles  padRoles :: [Role] -> Int -> [Role] padRoles roles n = roles ++ simpleVillagerRoles ++ simpleWerewolfRoles
app/Werewolf/Options.hs view
@@ -172,6 +172,10 @@ start :: Parser Command start = fmap Start $ Start.Options     <$> (extraRolesOption <|> randomExtraRolesOption)+    <*> switch (mconcat+        [ long "include-seer"+        , help "Always include the Seer"+        ])     <*> some (T.pack <$> strArgument (metavar "PLAYER..."))     where         extraRolesOption = fmap (Start.Use . filter (/= T.empty) . T.splitOn "," . T.pack) (strOption $ mconcat
src/Game/Werewolf/Command/Status.hs view
@@ -39,20 +39,21 @@  pingCommand :: Text -> Command pingCommand callerName = Command $ use stage >>= \stage' -> case stage' of-    FerinasGrunt    -> return ()-    GameOver        -> tell [gameIsOverMessage callerName]-    HuntersTurn1    -> pingRole hunterRole-    HuntersTurn2    -> pingRole hunterRole-    Lynching        -> return ()-    OrphansTurn     -> pingRole orphanRole-    ProtectorsTurn  -> pingRole protectorRole-    ScapegoatsTurn  -> pingRole scapegoatRole-    SeersTurn       -> pingRole seerRole-    Sunrise         -> return ()-    Sunset          -> return ()-    VillagesTurn    -> pingVillagers-    WerewolvesTurn  -> pingWerewolves-    WitchsTurn      -> pingRole witchRole+    FerinasGrunt        -> return ()+    GameOver            -> tell [gameIsOverMessage callerName]+    HuntersTurn1        -> pingRole hunterRole+    HuntersTurn2        -> pingRole hunterRole+    Lynching            -> return ()+    OrphansTurn         -> pingRole orphanRole+    ProtectorsTurn      -> pingRole protectorRole+    ScapegoatsTurn      -> pingRole scapegoatRole+    SeersTurn           -> pingRole seerRole+    Sunrise             -> return ()+    Sunset              -> return ()+    VillageDrunksTurn   -> pingRole villageDrunkRole+    VillagesTurn        -> pingVillagers+    WerewolvesTurn      -> pingWerewolves+    WitchsTurn          -> pingRole witchRole  pingRole :: (MonadState Game m, MonadWriter [Message] m) => Role -> m () pingRole role' = do
src/Game/Werewolf/Engine.hs view
@@ -24,6 +24,7 @@ import Control.Lens         hiding (cons, isn't) import Control.Monad.Except import Control.Monad.Extra+import Control.Monad.Random import Control.Monad.State  hiding (state) import Control.Monad.Writer @@ -45,7 +46,7 @@  import Prelude hiding (round) -checkStage :: (MonadState Game m, MonadWriter [Message] m) => m ()+checkStage :: (MonadRandom m, MonadState Game m, MonadWriter [Message] m) => m () checkStage = do     game <- get     checkBoots >> checkStage' >> checkEvents@@ -65,7 +66,7 @@          removePlayer (bootee ^. name) -checkStage' :: (MonadState Game m, MonadWriter [Message] m) => m ()+checkStage' :: (MonadRandom m, MonadState Game m, MonadWriter [Message] m) => m () checkStage' = use stage >>= \stage' -> case stage' of     FerinasGrunt -> do         druid       <- findPlayerBy_ role druidRole@@ -141,6 +142,20 @@                 setPlayerAllegiance (orphan ^. name) Werewolves                  tell $ orphanJoinedPackMessages (orphan ^. name) aliveWerewolfNames++        advanceStage++    VillageDrunksTurn -> do+        aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get++        randomAllegiance <- getRandomAllegiance+        players . villageDrunks . role . allegiance .= randomAllegiance++        villageDrunk <- findPlayerBy_ role villageDrunkRole++        if is villager villageDrunk+            then tell [villageDrunkJoinedVillageMessage $ villageDrunk ^. name]+            else tell $ villageDrunkJoinedPackMessages (villageDrunk ^. name) aliveWerewolfNames          advanceStage
src/Game/Werewolf/Game.hs view
@@ -23,8 +23,8 @@      Stage(..),     _FerinasGrunt, _GameOver, _HuntersTurn1, _HuntersTurn2, _Lynching, _OrphansTurn,-    _ProtectorsTurn, _ScapegoatsTurn, _SeersTurn, _Sunrise, _Sunset, _VillagesTurn, _WerewolvesTurn,-    _WitchsTurn,+    _ProtectorsTurn, _ScapegoatsTurn, _SeersTurn, _Sunrise, _Sunset, _VillageDrunksTurn,+    _VillagesTurn, _WerewolvesTurn, _WitchsTurn,      allStages,     stageCycle, stageAvailable,@@ -41,7 +41,7 @@     getAllowedVoters, getPendingVoters, getVoteResult,      -- ** Queries-    isFirstRound,+    isFirstRound, isThirdRound,     doesPlayerExist,     hasAnyoneWon, hasFallenAngelWon, hasVillagersWon, hasWerewolvesWon, ) where@@ -49,10 +49,11 @@ import Control.Lens hiding (isn't)  import           Data.List.Extra-import           Data.Map        (Map)-import qualified Data.Map        as Map+import           Data.Map             (Map)+import qualified Data.Map             as Map import           Data.Maybe-import           Data.Text       (Text)+import           Data.String.ToString+import           Data.Text            (Text)  import Game.Werewolf.Player @@ -109,10 +110,27 @@ --   Once the game reaches a turn stage, it requires a 'Game.Werewolf.Command.Command' to help push --   it past. Often only certain roles and commands may be performed at any given stage. data Stage  = FerinasGrunt | GameOver | HuntersTurn1 | HuntersTurn2 | Lynching | OrphansTurn-            | ProtectorsTurn | ScapegoatsTurn | SeersTurn | Sunrise | Sunset | VillagesTurn-            | WerewolvesTurn | WitchsTurn+            | ProtectorsTurn | ScapegoatsTurn | SeersTurn | Sunrise | Sunset | VillageDrunksTurn+            | VillagesTurn | WerewolvesTurn | WitchsTurn     deriving (Eq, Read, Show) +instance ToString Stage where+    toString FerinasGrunt       = "Ferina's Grunt"+    toString GameOver           = "Game over"+    toString HuntersTurn1       = "Hunter's turn"+    toString HuntersTurn2       = "Hunter's turn"+    toString Lynching           = "Lynching"+    toString OrphansTurn        = "Orphan's turn"+    toString ProtectorsTurn     = "Protector's turn"+    toString ScapegoatsTurn     = "Scapegoat's turn"+    toString SeersTurn          = "Seer's turn"+    toString Sunrise            = "Sunrise"+    toString Sunset             = "Sunset"+    toString VillageDrunksTurn  = "Village Drunk's turn"+    toString VillagesTurn       = "village's turn"+    toString WerewolvesTurn     = "Werewolves' turn"+    toString WitchsTurn         = "Witch's turn"+ -- TODO (hjw): remove events -- | Events occur /after/ a 'Stage' is advanced. This is automatically handled in --   'Game.Werewolf.Engine.checkStage', while an event's specific behaviour is defined by@@ -140,8 +158,9 @@     , HuntersTurn1     , ScapegoatsTurn     , Sunset-    , SeersTurn     , OrphansTurn+    , VillageDrunksTurn+    , SeersTurn     , ProtectorsTurn     , WerewolvesTurn     , WitchsTurn@@ -175,6 +194,9 @@ stageAvailable game SeersTurn           = has (players . seers . alive) game stageAvailable _ Sunrise                = True stageAvailable _ Sunset                 = True+stageAvailable game VillageDrunksTurn   =+    has (players . villageDrunks . alive) game+    && isThirdRound game stageAvailable game VillagesTurn        =     (has (players . fallenAngels . alive) game || not (isFirstRound game))     && any (is alive) (getAllowedVoters game)@@ -244,6 +266,10 @@ -- | @'isFirstRound' game = game ^. 'round' == 0@ isFirstRound :: Game -> Bool isFirstRound game = game ^. round == 0++-- | @'isThirdRound' game = game ^. 'round' == 2@+isThirdRound :: Game -> Bool+isThirdRound game = game ^. round == 2  -- | Queries whether the player is in the game. doesPlayerExist :: Text -> Game -> Bool
src/Game/Werewolf/Messages.hs view
@@ -66,6 +66,9 @@     -- * Seer's turn messages     playerSeenMessage, +    -- * Village Drunk's turn messages+    villageDrunkJoinedVillageMessage, villageDrunkJoinedPackMessages,+     -- * Villages' turn messages     playerMadeLynchVoteMessage, playerLynchedMessage, noPlayerLynchedMessage,     jesterLynchedMessage, scapegoatLynchedMessage,@@ -93,8 +96,9 @@ import Control.Lens  import           Data.List.Extra-import           Data.Text       (Text)-import qualified Data.Text       as T+import           Data.String.ToString+import           Data.Text            (Text)+import qualified Data.Text            as T  import           Game.Werewolf.Game import           Game.Werewolf.Player@@ -138,24 +142,25 @@  stageMessages :: Game -> [Message] stageMessages game = case game ^. stage of-    FerinasGrunt    -> []-    GameOver        -> []-    HuntersTurn1    -> huntersTurnMessages huntersName-    HuntersTurn2    -> huntersTurnMessages huntersName-    Lynching        -> []-    OrphansTurn     -> orphansTurnMessages orphansName-    ProtectorsTurn  -> protectorsTurnMessages protectorsName-    ScapegoatsTurn  -> scapegoatsTurnMessages scapegoatsName-    SeersTurn       -> seersTurnMessages seersName-    Sunrise         -> [sunriseMessage]-    Sunset          -> [nightFallsMessage]-    VillagesTurn    -> if isFirstRound game+    FerinasGrunt        -> []+    GameOver            -> []+    HuntersTurn1        -> huntersTurnMessages huntersName+    HuntersTurn2        -> huntersTurnMessages huntersName+    Lynching            -> []+    OrphansTurn         -> orphansTurnMessages orphansName+    ProtectorsTurn      -> protectorsTurnMessages protectorsName+    ScapegoatsTurn      -> scapegoatsTurnMessages scapegoatsName+    SeersTurn           -> seersTurnMessages seersName+    Sunrise             -> [sunriseMessage]+    Sunset              -> [nightFallsMessage]+    VillageDrunksTurn   -> [villageDrunksTurnMessage]+    VillagesTurn        -> if isFirstRound game         then firstVillagesTurnMessages         else villagesTurnMessages-    WerewolvesTurn  -> if isFirstRound game+    WerewolvesTurn      -> if isFirstRound game         then firstWerewolvesTurnMessages aliveWerewolfNames         else werewolvesTurnMessages aliveWerewolfNames-    WitchsTurn      -> witchsTurnMessages game+    WitchsTurn          -> witchsTurnMessages game     where         players'            = game ^. players         huntersName         = players' ^?! hunters . name@@ -195,6 +200,9 @@     , privateMessage to "Whose allegiance would you like to `see`?"     ] +villageDrunksTurnMessage :: Message+villageDrunksTurnMessage = publicMessage "The Village Drunk sobers up."+ sunriseMessage :: Message sunriseMessage = publicMessage "The sun rises. Everybody wakes up and opens their eyes..." @@ -266,8 +274,8 @@         [ [publicMessage "You should have heeded my warning, for now the Fallen Angel has been set free!"]         , [publicMessage "The game is over! The Fallen Angel has won."]         , [playerRolesMessage]-        , [playerWonMessage $ game ^?! players . fallenAngels . name]-        , playerLostMessages+        , [playerWonMessage fallenAngelsName]+        , map playerLostMessage (game ^.. players . names \\ [fallenAngelsName])         ]     | hasVillagersWon game      = concat         [ [publicMessage "The game is over! The Villagers have won."]@@ -294,7 +302,6 @@             ]          winningAllegiance-            | hasFallenAngelWon game    = FallenAngel             | hasVillagersWon game      = Villagers             | hasWerewolvesWon game     = Werewolves             | otherwise                 = undefined@@ -306,6 +313,8 @@         playerContributedMessages   = map playerContributedMessage (winningPlayers ^.. traverse . dead . name)         playerLostMessages          = map playerLostMessage (losingPlayers ^.. names) +        fallenAngelsName = game ^?! players . fallenAngels . name+ playerWonMessage :: Text -> Message playerWonMessage to = privateMessage to "Victory! You won!" @@ -377,24 +386,8 @@ currentStageMessages _ Sunrise      = [] currentStageMessages _ Sunset       = [] currentStageMessages to turn        = [privateMessage to $ T.concat-    [ "It's currently the ", showTurn turn, " turn."+    [ "It's currently the ", T.pack $ toString turn, "."     ]]-    where-        showTurn :: Stage -> Text-        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"-        showTurn Sunrise        = undefined-        showTurn Sunset         = undefined-        showTurn VillagesTurn   = "village's"-        showTurn WerewolvesTurn = "Werewolves'"-        showTurn WitchsTurn     = "Witch's"  rolesInGameMessage :: Maybe Text -> [Role] -> Message rolesInGameMessage mTo roles = Message mTo $ T.concat@@ -482,13 +475,29 @@  playerSeenMessage :: Text -> Player -> Message playerSeenMessage to target = privateMessage to $ T.concat-    [targetName, " is aligned with the ", allegiance', "."]+    [targetName, " is aligned with ", article, T.pack $ toString allegiance', "."]     where         targetName  = target ^. name-        allegiance' = case target ^. role . allegiance of-            FallenAngel -> "Fallen Angel"-            Villagers   -> "Villagers"-            Werewolves  -> "Werewolves"+        allegiance' = target ^. role . allegiance+        article     = if allegiance' == NoOne then "" else "the "++villageDrunkJoinedVillageMessage :: Text -> Message+villageDrunkJoinedVillageMessage to = privateMessage to $ T.unwords+    [ "Somehow you managed to avoid getting killed while in your drunken stupor. Thank God for"+    , "that, maybe now you can actually help the village."+    ]++villageDrunkJoinedPackMessages :: Text -> [Text] -> [Message]+villageDrunkJoinedPackMessages villageDrunksName werewolfNames =+    privateMessage villageDrunksName (T.concat+        [ "As you start to feel sober for the first time in days a new thirst begins to take hold."+        , " The bloodthirst starts to bring back memories, memories of your true home with "+        , concatList werewolfNames, "."+        ])+    : groupMessages werewolfNames (T.unwords+        [ villageDrunksName+        , "the Village Drunk has finally sobered up and remembered their true home."+        ])  playerMadeLynchVoteMessage :: Text -> Text -> Message playerMadeLynchVoteMessage voterName targetName = publicMessage $ T.concat
src/Game/Werewolf/Player.hs view
@@ -27,7 +27,7 @@      -- ** Traversals     druid, fallenAngel, hunter, jester, orphan, protector, scapegoat, seer, simpleVillager,-    simpleWerewolf, trueVillager, witch,+    simpleWerewolf, trueVillager, villageDrunk, witch,     villager, werewolf,      -- | These are provided just as a bit of sugar to avoid continually writing @'traverse' .@.@@ -35,7 +35,7 @@      -- | N.B., these are not legal traversals for the same reason 'filtered' isn't!     druids, fallenAngels, hunters, jesters, orphans, protectors, scapegoats, seers, simpleVillagers,-    simpleWerewolves, trueVillagers, witches,+    simpleWerewolves, trueVillagers, villageDrunks, witches,     villagers, werewolves,     alive, dead, @@ -163,6 +163,14 @@ trueVillager :: Traversal' Player () trueVillager = role . only trueVillagerRole +-- | The traversal of 'Player's with a 'villageDrunkRole'.+--+-- @+-- 'villageDrunk' = 'role' . 'only' 'villageDrunkRole'+-- @+villageDrunk :: Traversal' Player ()+villageDrunk = role . only villageDrunkRole+ -- | The traversal of 'Player's with a 'witchRole'. -- -- @@@ -298,6 +306,14 @@ -- @ trueVillagers :: Traversable t => Traversal' (t Player) Player trueVillagers = traverse . filtered (is trueVillager)++-- | This 'Traversal' provides the traversal of 'villageDrunk' 'Player's.+--+-- @+-- 'villageDrunks' = 'traverse' . 'filtered' ('is' 'villageDrunk')+-- @+villageDrunks :: Traversable t => Traversal' (t Player) Player+villageDrunks = traverse . filtered (is villageDrunk)  -- | This 'Traversal' provides the traversal of 'witch' 'Player's. --
src/Game/Werewolf/Role.hs view
@@ -24,7 +24,7 @@     name, allegiance, balance, description, rules,      Allegiance(..),-    _FallenAngel, _Villagers, _Werewolves,+    _NoOne, _Villagers, _Werewolves,      -- ** Instances     allRoles, restrictedRoles,@@ -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.-    orphanRole,+    orphanRole, villageDrunkRole,      -- *** The Loners     -- | The Loners look out for themselves and themselves alone.@@ -65,8 +65,9 @@ import           Data.Function import           Data.List import           Data.Monoid-import           Data.Text     (Text)-import qualified Data.Text     as T+import           Data.String.ToString+import           Data.Text            (Text)+import qualified Data.Text            as T  -- | Role definitions require only a few pieces of information. --   Most of the game logic behind a role is implemented in "Game.Werewolf.Command" and@@ -86,10 +87,16 @@     , _rules       :: Text     } deriving (Read, Show) --- | The Loner allegiances are seldom used, rather they are present for correctness.-data Allegiance = FallenAngel | Villagers | Werewolves+-- | The 'NoOne' allegiance is used for the Loners. It is not used to determine who has won (i.e.,+--   if one Loner wins, the others still lose).+data Allegiance = NoOne | Villagers | Werewolves     deriving (Eq, Read, Show) +instance ToString Allegiance where+    toString NoOne      = "no-one"+    toString Villagers  = "Villagers"+    toString Werewolves = "Werewolves"+ makeLenses ''Role  instance Eq Role where@@ -111,6 +118,7 @@     , simpleVillagerRole     , simpleWerewolfRole     , trueVillagerRole+    , villageDrunkRole     , witchRole     ] @@ -153,6 +161,37 @@         ]     } +-- | /Hah, maybe not as liked as the Jester, but the Drunk sure does their fair share of stupid/+--   /things in the night! No-one knows if they even actually make it home; sometimes people see/+--   /them sleeping outside the Blacksmith's home, others say they see them wandering towards the/+--   /woods. It's pointless quizzing the Village Drunk in the, morning about their doings; they can/+--   /never remember what they did!/+--+--   The Village Drunk is randomly assigned an alignment at the start, either Villagers or+--   Werewolves. However, they are not told to which allegiance they belong.+--+--   On the third night the Village Drunk sobers up and is informed of their role.+villageDrunkRole :: Role+villageDrunkRole = Role+    { _name         = "Village Drunk"+    , _allegiance   = Villagers+    , _balance      = -1+    , _description  = T.unwords+        [ "Hah, maybe not as liked as the Jester, but the Drunk sure does their fair share of"+        , "stupid things in the night! No-one knows if they even actually make it home; sometimes"+        , "people see them sleeping outside the Blacksmith's home, others say they see them"+        , "wandering towards the woods. It's pointless quizzing the Village Drunk in the, morning"+        , "about their doings; they can never remember what they did!"+        ]+    , _rules        = T.intercalate "\n"+        [ T.unwords+            [ "The Village Drunk is randomly assigned an alignment at the start, either Villagers"+            , "or Werewolves. However, they are not told to which allegiance they belong."+            ]+        , "On the third night the Village Drunk sobers up and is informed of their role."+        ]+    }+ -- | /Long ago during the War in Heaven, angels fell from the sky as one by one those that followed/ --   /Lucifer were defeated. For centuries they lived amongst mortal Villagers as punishment for/ --   /their sins and wrongdoings. The Fallen Angel was one such being and is now one of the few/@@ -167,7 +206,7 @@ fallenAngelRole :: Role fallenAngelRole = Role     { _name         = "Fallen Angel"-    , _allegiance   = FallenAngel+    , _allegiance   = NoOne     , _balance      = 0     , _description  = T.unwords         [ "Long ago during the War in Heaven, angels fell from the sky as one by one those that"@@ -430,11 +469,11 @@  -- | The counter-part to 'isn't', but more general as it takes a 'Getting' instead. is :: Getting Any s a -> s -> Bool-is query = has query+is = has  -- | A re-write of 'Control.Lens.Prism.isn't' to be more general by taking a 'Getting' instead. isn't :: Getting All s a -> s -> Bool-isn't query = hasn't query+isn't = hasn't  -- | A companion to 'filtered' that, rather than using a predicate, filters on the given lens for -- matches.
src/Game/Werewolf/Util.hs view
@@ -17,7 +17,7 @@     -- * Game      -- ** Manipulations-    killPlayer, removePlayer, setPlayerAllegiance,+    killPlayer, removePlayer, setPlayerAllegiance, getRandomAllegiance,      -- ** Searches     findPlayerBy_, getAdjacentAlivePlayers, getPlayerVote, getAllowedVoters, getPendingVoters,@@ -38,9 +38,10 @@     isPlayerAlive, isPlayerDead, ) where -import Control.Lens        hiding (cons)+import Control.Lens         hiding (cons) import Control.Monad.Extra-import Control.Monad.State hiding (state)+import Control.Monad.Random+import Control.Monad.State  hiding (state)  import           Data.List import qualified Data.Map   as Map@@ -83,6 +84,10 @@ --   they align themselves differently given some trigger. setPlayerAllegiance :: MonadState Game m => Text -> Allegiance -> m () setPlayerAllegiance name' allegiance' = modify $ players . traverse . filteredBy name name' . role . allegiance .~ allegiance'++-- | Get a random allegiance (either Villagers or Werewolves).+getRandomAllegiance :: MonadRandom m => m Allegiance+getRandomAllegiance = fromList [(Villagers, 0.5), (Werewolves, 0.5)]  findPlayerBy_ :: (Eq a, MonadState Game m) => Lens' Player a -> a -> m Player findPlayerBy_ lens value = fromJust <$> preuse (players . traverse . filteredBy lens value)
test/app/Main.hs view
@@ -12,8 +12,6 @@  import Game.Werewolf.Test.Command import Game.Werewolf.Test.Engine-import Game.Werewolf.Test.Game-import Game.Werewolf.Test.Player  import Test.Tasty import Test.Tasty.QuickCheck@@ -22,5 +20,4 @@ main = defaultMain . localOption (QuickCheckTests 20) =<< tests  tests :: IO TestTree-tests = return . testGroup "Tests" $ concat-    [allCommandTests, allEngineTests, allGameTests, allPlayerTests]+tests = return . testGroup "Tests" $ allCommandTests ++ allEngineTests
test/src/Game/Werewolf/Test/Arbitrary.hs view
@@ -11,18 +11,13 @@     -- * Initial arbitraries      -- ** Game-    NewGame(..),     GameAtGameOver(..), GameAtHuntersTurn(..), GameAtOrphansTurn(..), GameAtProtectorsTurn(..),     GameAtScapegoatsTurn(..), GameAtSeersTurn(..), GameAtSunrise(..), GameAtVillagesTurn(..),     GameAtWerewolvesTurn(..), GameAtWitchsTurn(..),-    GameOnSecondRound(..),-    GameWithAllowedVoters(..), GameWithConflictingVote(..), GameWithDeadPlayers(..),-    GameWithDevourEvent(..), GameWithDevourVotes(..), GameWithHeal(..),++    GameWithAllowedVoters(..), GameWithDevourEvent(..), GameWithDevourVotes(..), GameWithHeal(..),     GameWithJesterRevealedAtVillagesTurn(..), GameWithLynchVotes(..), GameWithMajorityVote(..),-    GameWithNoAllowedVotersAtVillagesTurn(..), GameWithNoWerewolvesAtProtectorsTurn(..),-    GameWithOneAllegianceAlive(..), GameWithPoison(..), GameWithProtect(..),-    GameWithProtectAndDevourVotes(..), GameWithRoleModel(..), GameWithRoleModelAtVillagesTurn(..),-    GameWithSee(..),+    GameWithPoison(..), GameWithProtect(..),      -- ** Player     arbitraryPlayerSet,@@ -34,6 +29,7 @@     arbitraryScapegoatChooseCommand, arbitraryHealCommand, arbitraryPassCommand,     arbitraryPoisonCommand, arbitraryProtectCommand, arbitraryQuitCommand, arbitrarySeeCommand,     arbitraryWerewolfVoteCommand, arbitraryVillagerVoteCommand,+     runArbitraryCommands,      -- ** Player@@ -65,8 +61,8 @@  instance Arbitrary Game where     arbitrary = do-        (NewGame game)  <- arbitrary-        stage'          <- arbitrary+        game    <- newGame <$> arbitraryPlayerSet+        stage'  <- arbitrary          return $ game & stage .~ stage' @@ -88,12 +84,6 @@ instance Arbitrary Text where     arbitrary = T.pack <$> vectorOf 6 (elements ['a'..'z']) -newtype NewGame = NewGame Game-    deriving (Eq, Show)--instance Arbitrary NewGame where-    arbitrary = NewGame . newGame <$> arbitraryPlayerSet- newtype GameAtGameOver = GameAtGameOver Game     deriving (Eq, Show) @@ -185,15 +175,6 @@          return $ GameAtWitchsTurn (game & stage .~ WitchsTurn) -newtype GameOnSecondRound = GameOnSecondRound Game-    deriving (Eq, Show)--instance Arbitrary GameOnSecondRound where-    arbitrary = do-        game <- arbitrary--        return $ GameOnSecondRound (game & round .~ 1)- newtype GameWithAllowedVoters = GameWithAllowedVoters Game     deriving (Eq, Show) @@ -214,17 +195,6 @@          return $ GameWithConflictingVote game -newtype GameWithDeadPlayers = GameWithDeadPlayers Game-    deriving (Eq, Show)--instance Arbitrary GameWithDeadPlayers where-    arbitrary = do-        game                <- arbitrary-        (NonEmpty players') <- NonEmpty <$> sublistOf (game ^. players)-        let game'           = foldr killPlayer game (players' ^.. names)--        return $ GameWithDeadPlayers (run_ checkStage game')- newtype GameWithDevourEvent = GameWithDevourEvent Game     deriving (Eq, Show) @@ -293,49 +263,6 @@          return $ GameWithMajorityVote 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)--instance Arbitrary GameWithOneAllegianceAlive where-    arbitrary = do-        game            <- arbitrary-        allegiance'     <- elements [Villagers, Werewolves]-        let playerNames = game ^.. players . traverse . filteredBy (role . allegiance) allegiance' . name-        let game'       = foldr killPlayer game (game ^.. players . names \\ playerNames)--        return $ GameWithOneAllegianceAlive game'--newtype GameWithPassAtWitchsTurn = GameWithPassAtWitchsTurn Game-    deriving (Eq, Show)--instance Arbitrary GameWithPassAtWitchsTurn where-    arbitrary = do-        game            <- arbitrary-        let game'       = game & stage .~ WitchsTurn-        (Blind command) <- arbitraryPassCommand game'--        return $ GameWithPassAtWitchsTurn (run_ (apply command) game')- newtype GameWithPoison = GameWithPoison Game     deriving (Eq, Show) @@ -358,47 +285,6 @@          return $ GameWithProtect (run_ (apply command) game') -newtype GameWithProtectAndDevourVotes = GameWithProtectAndDevourVotes Game-    deriving (Eq, Show)--instance Arbitrary GameWithProtectAndDevourVotes where-    arbitrary = do-        (GameWithProtect game)  <- arbitrary-        let game'               = run_ checkStage game--        GameWithProtectAndDevourVotes <$> runArbitraryCommands (length $ game' ^. players) game'--newtype GameWithRoleModel = GameWithRoleModel Game-    deriving (Eq, Show)--instance Arbitrary GameWithRoleModel where-    arbitrary = do-        (GameAtOrphansTurn game) <- arbitrary-        (Blind command)             <- arbitraryOrphanChooseCommand game-        let game'                   = run_ (apply command) game--        return $ GameWithRoleModel game'--newtype GameWithRoleModelAtVillagesTurn = GameWithRoleModelAtVillagesTurn Game-    deriving (Eq, Show)--instance Arbitrary GameWithRoleModelAtVillagesTurn where-    arbitrary = do-        (GameWithRoleModel game) <- arbitrary--        return $ GameWithRoleModelAtVillagesTurn (game & stage .~ VillagesTurn)--newtype GameWithSee = GameWithSee Game-    deriving (Eq, Show)--instance Arbitrary GameWithSee where-    arbitrary = do-        game            <- arbitrary-        let game'       = game & stage .~ SeersTurn-        (Blind command) <- arbitrarySeeCommand game'--        return $ GameWithSee (run_ (apply command) game')- arbitraryPlayerSet :: Gen [Player] arbitraryPlayerSet = do     n       <- choose (14, 30)@@ -413,20 +299,21 @@  arbitraryCommand :: Game -> Gen (Blind Command) arbitraryCommand game = case game ^. stage of-    FerinasGrunt    -> return $ Blind noopCommand-    GameOver        -> return $ Blind noopCommand-    HuntersTurn1    -> arbitraryHunterChooseCommand game-    HuntersTurn2    -> arbitraryHunterChooseCommand game-    Lynching        -> return $ Blind noopCommand-    OrphansTurn     -> arbitraryOrphanChooseCommand game-    ProtectorsTurn  -> arbitraryProtectCommand game-    ScapegoatsTurn  -> arbitraryScapegoatChooseCommand game-    SeersTurn       -> arbitrarySeeCommand game-    Sunrise         -> return $ Blind noopCommand-    Sunset          -> return $ Blind noopCommand-    VillagesTurn    -> arbitraryVillagerVoteCommand game-    WerewolvesTurn  -> arbitraryWerewolfVoteCommand game-    WitchsTurn      -> oneof+    FerinasGrunt        -> return $ Blind noopCommand+    GameOver            -> return $ Blind noopCommand+    HuntersTurn1        -> arbitraryHunterChooseCommand game+    HuntersTurn2        -> arbitraryHunterChooseCommand game+    Lynching            -> return $ Blind noopCommand+    OrphansTurn         -> arbitraryOrphanChooseCommand game+    ProtectorsTurn      -> arbitraryProtectCommand game+    ScapegoatsTurn      -> arbitraryScapegoatChooseCommand game+    SeersTurn           -> arbitrarySeeCommand game+    Sunrise             -> return $ Blind noopCommand+    Sunset              -> return $ Blind noopCommand+    VillageDrunksTurn   -> return $ Blind noopCommand+    VillagesTurn        -> arbitraryVillagerVoteCommand game+    WerewolvesTurn      -> arbitraryWerewolfVoteCommand game+    WitchsTurn          -> oneof         [ arbitraryHealCommand game         , arbitraryPassCommand game         , arbitraryPoisonCommand game
test/src/Game/Werewolf/Test/Command/Choose.hs view
@@ -14,8 +14,6 @@  import Control.Lens hiding (elements, isn't) -import Data.Maybe- import Game.Werewolf import Game.Werewolf.Command.Hunter    as Hunter import Game.Werewolf.Command.Orphan    as Orphan@@ -34,8 +32,6 @@     , 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@@ -45,7 +41,6 @@     , 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 "scapegoat choose command errors when game is over"              prop_scapegoatChooseCommandErrorsWhenGameIsOver     , testProperty "scapegoat choose command errors when caller does not exist"     prop_scapegoatChooseCommandErrorsWhenCallerDoesNotExist@@ -53,8 +48,6 @@     , testProperty "scapegoat choose command errors when any target is dead"        prop_scapegoatChooseCommandErrorsWhenAnyTargetIsDead     , testProperty "scapegoat choose command errors when not scapegoat's turn"      prop_scapegoatChooseCommandErrorsWhenNotScapegoatsTurn     , testProperty "scapegoat choose command errors when caller not scapegoat"      prop_scapegoatChooseCommandErrorsWhenCallerNotScapegoat-    , testProperty "scapegoat choose command sets allowed voters"                   prop_scapegoatChooseCommandSetsAllowedVoters-    , testProperty "scapegoat choose command resets scapegoat blamed"               prop_scapegoatChooseCommandResetsScapegoatBlamed     ]  prop_hunterChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property@@ -100,26 +93,6 @@          verbose_runCommandErrors game command -prop_hunterChooseCommandKillsTarget :: GameAtHuntersTurn -> Property-prop_hunterChooseCommandKillsTarget (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--        is dead $ game' ^?! players . traverse . filteredBy name (target ^. name)--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--        game' ^. hunterRetaliated- prop_orphanChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property prop_orphanChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =     forAll (arbitraryOrphanChooseCommand game) $ verbose_runCommandErrors game . getBlind@@ -180,16 +153,6 @@          verbose_runCommandErrors game command -prop_orphanChooseCommandSetsRoleModel :: GameAtOrphansTurn -> Property-prop_orphanChooseCommandSetsRoleModel (GameAtOrphansTurn game) = do-    let orphan = game ^?! players . orphans--    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_scapegoatChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property prop_scapegoatChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =     forAll (arbitraryScapegoatChooseCommand game) $ verbose_runCommandErrors game . getBlind@@ -233,18 +196,3 @@         let command = Scapegoat.chooseCommand (caller ^. name) (targets ^.. names)          verbose_runCommandErrors game command--prop_scapegoatChooseCommandSetsAllowedVoters :: GameAtScapegoatsTurn -> Property-prop_scapegoatChooseCommandSetsAllowedVoters (GameAtScapegoatsTurn game) = do-    let scapegoat = game ^?! players . scapegoats--    forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> do-        let command = Scapegoat.chooseCommand (scapegoat ^. name) (targets ^.. names)-        let game'   = run_ (apply command) game--        game' ^. allowedVoters === targets ^.. names--prop_scapegoatChooseCommandResetsScapegoatBlamed :: GameAtScapegoatsTurn -> Property-prop_scapegoatChooseCommandResetsScapegoatBlamed (GameAtScapegoatsTurn game) = do-    forAll (arbitraryScapegoatChooseCommand game) $ \(Blind command) ->-        not $ run_ (apply command) game ^. scapegoatBlamed
test/src/Game/Werewolf/Test/Command/Heal.hs view
@@ -10,7 +10,7 @@     allHealCommandTests, ) where -import Control.Lens hiding (elements, isn't)+import Control.Lens hiding (isn't)  import Game.Werewolf import Game.Werewolf.Command.Witch@@ -29,8 +29,6 @@     , testProperty "heal command errors when not witch's turn"      prop_healCommandErrorsWhenNotWitchsTurn     , testProperty "heal command errors when caller has healed"     prop_healCommandErrorsWhenCallerHasHealed     , testProperty "heal command errors when caller not witch"      prop_healCommandErrorsWhenCallerNotWitch-    , testProperty "heal command sets heal"                         prop_healCommandSetsHeal-    , testProperty "heal command sets heal used"                    prop_healCommandSetsHealUsed     ]  prop_healCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property@@ -81,13 +79,3 @@         let command = healCommand (caller ^. name)          verbose_runCommandErrors game command--prop_healCommandSetsHeal :: GameWithDevourEvent -> Property-prop_healCommandSetsHeal (GameWithDevourEvent game) =-    forAll (arbitraryHealCommand game) $ \(Blind command) ->-        (run_ (apply command) game) ^. heal--prop_healCommandSetsHealUsed :: GameWithDevourEvent -> Property-prop_healCommandSetsHealUsed (GameWithDevourEvent game) =-    forAll (arbitraryHealCommand game) $ \(Blind command) ->-        (run_ (apply command) game) ^. healUsed
test/src/Game/Werewolf/Test/Command/Pass.hs view
@@ -10,7 +10,7 @@     allPassCommandTests, ) where -import Control.Lens hiding (elements, isn't)+import Control.Lens hiding (isn't)  import Game.Werewolf import Game.Werewolf.Command.Witch@@ -26,7 +26,6 @@     , 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 sets passed"                         prop_witchPassCommandSetsPassed     ]  prop_witchPassCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property@@ -50,10 +49,3 @@ prop_witchPassCommandErrorsWhenNotWitchsTurn game =     hasn't (stage . _WitchsTurn) game     ==> forAll (arbitraryPassCommand game) $ verbose_runCommandErrors game . getBlind--prop_witchPassCommandSetsPassed :: GameAtWitchsTurn -> Property-prop_witchPassCommandSetsPassed (GameAtWitchsTurn game) =-    forAll (arbitraryPassCommand game) $ \(Blind command) -> do-        let game' = run_ (apply command) game--        game' ^. passed
test/src/Game/Werewolf/Test/Command/Poison.hs view
@@ -10,9 +10,7 @@     allPoisonCommandTests, ) where -import Control.Lens hiding (elements, isn't)--import Data.Maybe+import Control.Lens hiding (isn't)  import Game.Werewolf import Game.Werewolf.Command.Witch@@ -33,8 +31,6 @@     , testProperty "poison command errors when not witch's turn"        prop_poisonCommandErrorsWhenNotWitchsTurn     , testProperty "poison command errors when caller has poisoned"     prop_poisonCommandErrorsWhenCallerHasPoisoned     , testProperty "poison command errors when caller not witch"        prop_poisonCommandErrorsWhenCallerNotWitch-    , testProperty "poison command sets poison"                         prop_poisonCommandSetsPoison-    , testProperty "poison command sets poison used"                    prop_poisonCommandSetsPoisonUsed     ]  prop_poisonCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property@@ -106,13 +102,3 @@         let command = poisonCommand (caller ^. name) (target ^. name)          verbose_runCommandErrors game command--prop_poisonCommandSetsPoison :: GameAtWitchsTurn -> Property-prop_poisonCommandSetsPoison (GameAtWitchsTurn game) =-    forAll (arbitraryPoisonCommand game) $ \(Blind command) ->-    isJust (run_ (apply command) game ^. poison)--prop_poisonCommandSetsPoisonUsed :: GameAtWitchsTurn -> Property-prop_poisonCommandSetsPoisonUsed (GameAtWitchsTurn game) =-    forAll (arbitraryPoisonCommand game) $ \(Blind command) ->-    run_ (apply command) game ^. poisonUsed
test/src/Game/Werewolf/Test/Command/Protect.hs view
@@ -10,7 +10,7 @@     allProtectCommandTests, ) where -import Control.Lens hiding (elements, isn't)+import Control.Lens hiding (isn't)  import Data.Maybe @@ -32,8 +32,6 @@     , testProperty "protect command errors when not protector's turn"       prop_protectCommandErrorsWhenNotProtectorsTurn     , testProperty "protect command errors when caller not protector"       prop_protectCommandErrorsWhenCallerNotProtector     , testProperty "protect command errors when target is prior protect"    prop_protectCommandErrorsWhenTargetIsPriorProtect-    , testProperty "protect command sets prior protect"                     prop_protectCommandSetsPriorProtect-    , testProperty "protect command sets protect"                           prop_protectCommandSetsProtect     ]  prop_protectCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property@@ -97,13 +95,3 @@     let command     = protectCommand (protector ^. name) (fromJust $ game' ^. priorProtect)      verbose_runCommandErrors game' command--prop_protectCommandSetsPriorProtect :: GameAtProtectorsTurn -> Property-prop_protectCommandSetsPriorProtect (GameAtProtectorsTurn game) =-    forAll (arbitraryProtectCommand game) $ \(Blind command) ->-    isJust $ run_ (apply command) game ^. priorProtect--prop_protectCommandSetsProtect :: GameAtProtectorsTurn -> Property-prop_protectCommandSetsProtect (GameAtProtectorsTurn game) =-    forAll (arbitraryProtectCommand game) $ \(Blind command) ->-    isJust $ run_ (apply command) game ^. protect
test/src/Game/Werewolf/Test/Command/Quit.hs view
@@ -10,9 +10,7 @@     allQuitCommandTests, ) where -import Control.Lens hiding (elements, isn't)--import Data.Maybe+import Control.Lens  import Game.Werewolf import Game.Werewolf.Command.Global@@ -24,20 +22,9 @@  allQuitCommandTests :: [TestTree] allQuitCommandTests =-    [ testProperty "quit command errors when game is over"                                      prop_quitCommandErrorsWhenGameIsOver-    , testProperty "quit command errors when caller does not exist"                             prop_quitCommandErrorsWhenCallerDoesNotExist-    , testProperty "quit command errors when caller is dead"                                    prop_quitCommandErrorsWhenCallerIsDead-    , testProperty "quit command kills player"                                                  prop_quitCommandKillsPlayer-    , testProperty "quit command clears heal when caller is witch"                              prop_quitCommandClearsHealWhenCallerIsWitch-    , testProperty "quit command clears heal used when caller is witch"                         prop_quitCommandClearsHealUsedWhenCallerIsWitch-    , testProperty "quit command clears poison when caller is witch"                            prop_quitCommandClearsPoisonWhenCallerIsWitch-    , testProperty "quit command clears poison used when caller is witch"                       prop_quitCommandClearsPoisonUsedWhenCallerIsWitch-    , testProperty "quit command clears prior protect when caller is protector"                 prop_quitCommandClearsPriorProtectWhenCallerIsProtector-    , 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 orphan"                       prop_quitCommandClearsRoleModelWhenCallerIsOrphan-    , testProperty "quit command sets fallen angel's allegiance when caller is fallen angel"    prop_quitCommandSetsFallenAngelsAllegianceWhenCallerIsFallenAngel+    [ testProperty "quit command errors when game is over"          prop_quitCommandErrorsWhenGameIsOver+    , testProperty "quit command errors when caller does not exist" prop_quitCommandErrorsWhenCallerDoesNotExist+    , testProperty "quit command errors when caller is dead"        prop_quitCommandErrorsWhenCallerIsDead     ]  prop_quitCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property@@ -56,82 +43,3 @@         let command = quitCommand $ caller ^. name          verbose_runCommandErrors game' command--prop_quitCommandKillsPlayer :: Game -> Property-prop_quitCommandKillsPlayer game =-    hasn't (stage . _GameOver) game-    ==> forAll (arbitraryQuitCommand game) $ \(Blind command) -> do-        let game' = run_ (apply command) game--        length (game' ^.. players . traverse . dead) == 1--prop_quitCommandClearsHealWhenCallerIsWitch :: GameWithHeal -> Bool-prop_quitCommandClearsHealWhenCallerIsWitch (GameWithHeal game) = do-    let witch   = game ^?! players . witches-    let command = quitCommand (witch ^. name)--    not $ run_ (apply command) game ^. heal--prop_quitCommandClearsHealUsedWhenCallerIsWitch :: GameWithHeal -> Bool-prop_quitCommandClearsHealUsedWhenCallerIsWitch (GameWithHeal game) = do-    let witch   = game ^?! players . witches-    let command = quitCommand (witch ^. name)--    not $ run_ (apply command) game ^. healUsed--prop_quitCommandClearsPoisonWhenCallerIsWitch :: GameWithPoison -> Bool-prop_quitCommandClearsPoisonWhenCallerIsWitch (GameWithPoison game) = do-    let witch   = game ^?! players . witches-    let command = quitCommand (witch ^. name)--    isNothing $ run_ (apply command) game ^. poison--prop_quitCommandClearsPoisonUsedWhenCallerIsWitch :: GameWithPoison -> Bool-prop_quitCommandClearsPoisonUsedWhenCallerIsWitch (GameWithPoison game) = do-    let witch   = game ^?! players . witches-    let command = quitCommand (witch ^. name)--    not $ run_ (apply command) game ^. poisonUsed--prop_quitCommandClearsPriorProtectWhenCallerIsProtector :: GameWithProtect -> Bool-prop_quitCommandClearsPriorProtectWhenCallerIsProtector (GameWithProtect game) = do-    let protector   = game ^?! players . protectors-    let command     = quitCommand (protector ^. name)--    isNothing $ run_ (apply command) game ^. priorProtect--prop_quitCommandClearsProtectWhenCallerIsProtector :: GameWithProtect -> Bool-prop_quitCommandClearsProtectWhenCallerIsProtector (GameWithProtect game) = do-    let protector   = game ^?! players . protectors-    let command     = quitCommand (protector ^. name)--    isNothing $ run_ (apply command) game ^. protect--prop_quitCommandClearsPlayersDevourVote :: GameWithDevourVotes -> Property-prop_quitCommandClearsPlayersDevourVote (GameWithDevourVotes game) =-    forAll (arbitraryWerewolf game) $ \caller -> do-        let command = quitCommand (caller ^. name)--        isNothing $ run_ (apply command) game ^. votes . at (caller ^. name)--prop_quitCommandClearsPlayersLynchVote :: GameWithLynchVotes -> Property-prop_quitCommandClearsPlayersLynchVote (GameWithLynchVotes game) =-    forAll (arbitraryPlayer game) $ \caller -> do-        let command = quitCommand (caller ^. name)--        isNothing $ run_ (apply command) game ^. votes . at (caller ^. 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--prop_quitCommandSetsFallenAngelsAllegianceWhenCallerIsFallenAngel :: Game -> Bool-prop_quitCommandSetsFallenAngelsAllegianceWhenCallerIsFallenAngel game = do-    let fallenAngelsName    = game ^?! players . fallenAngels . name-    let command             = quitCommand fallenAngelsName-    let game'               = run_ (apply command) game--    is villager $ game' ^?! players . fallenAngels
test/src/Game/Werewolf/Test/Command/See.hs view
@@ -10,9 +10,7 @@     allSeeCommandTests, ) where -import Control.Lens hiding (elements, isn't)--import Data.Maybe+import Control.Lens hiding (isn't)  import Game.Werewolf import Game.Werewolf.Command.Seer@@ -31,7 +29,6 @@     , testProperty "see command errors when target is dead"         prop_seeCommandErrorsWhenTargetIsDead     , testProperty "see command errors when not seer's turn"        prop_seeCommandErrorsWhenNotSeersTurn     , testProperty "see command errors when caller not seer"        prop_seeCommandErrorsWhenCallerNotSeer-    , testProperty "see command sets see"                           prop_seeCommandSetsSee     ]  prop_seeCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property@@ -86,8 +83,3 @@         let command = seeCommand (caller ^. name) (target ^. name)          verbose_runCommandErrors game command--prop_seeCommandSetsSee :: GameAtSeersTurn -> Property-prop_seeCommandSetsSee (GameAtSeersTurn game) =-    forAll (arbitrarySeeCommand game) $ \(Blind command) ->-    isJust $ run_ (apply command) game ^. see
test/src/Game/Werewolf/Test/Command/Vote.hs view
@@ -10,9 +10,7 @@     allVoteCommandTests, ) where -import Control.Lens hiding (elements, isn't)--import qualified Data.Map as Map+import Control.Lens hiding (isn't)  import Game.Werewolf import Game.Werewolf.Command.Villager as Villager@@ -34,7 +32,6 @@     , testProperty "werewolf vote command errors when caller not werewolf"      prop_werewolfVoteCommandErrorsWhenCallerNotWerewolf     , testProperty "werewolf vote command errors when caller has voted"         prop_werewolfVoteCommandErrorsWhenCallerHasVoted     , testProperty "werewolf vote command errors when target werewolf"          prop_werewolfVoteCommandErrorsWhenTargetWerewolf-    , testProperty "werewolf vote command updates votes"                        prop_werewolfVoteCommandUpdatesVotes      , testProperty "villager vote command errors when game is over"                     prop_villagerVoteCommandErrorsWhenGameIsOver     , testProperty "villager vote command errors when caller does not exist"            prop_villagerVoteCommandErrorsWhenCallerDoesNotExist@@ -45,7 +42,6 @@     , testProperty "villager vote command errors when caller has voted"                 prop_villagerVoteCommandErrorsWhenCallerHasVoted     , testProperty "villager vote command errors when caller is not in allowed voters"  prop_villagerVoteCommandErrorsWhenCallerIsNotInAllowedVoters     , testProperty "villager vote command errors when caller is known jester"           prop_villagerVoteCommandErrorsWhenCallerIsKnownJester-    , testProperty "villager vote command updates votes"                                prop_villagerVoteCommandUpdatesVotes     ]  prop_werewolfVoteCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property@@ -113,13 +109,6 @@     forAll (arbitraryWerewolf game) $ \target ->     verbose_runCommandErrors game (Werewolf.voteCommand (caller ^. name) (target ^. name)) -prop_werewolfVoteCommandUpdatesVotes :: GameAtWerewolvesTurn -> Property-prop_werewolfVoteCommandUpdatesVotes (GameAtWerewolvesTurn game) =-    forAll (arbitraryWerewolfVoteCommand game) $ \(Blind command) -> do-        let game' = run_ (apply command) game--        Map.size (game' ^. votes) == 1- prop_villagerVoteCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property prop_villagerVoteCommandErrorsWhenGameIsOver (GameAtGameOver game) =     forAll (arbitraryVillagerVoteCommand game) $ verbose_runCommandErrors game . getBlind@@ -189,10 +178,3 @@         verbose_runCommandErrors game command     where         caller = game ^?! players . jesters--prop_villagerVoteCommandUpdatesVotes :: GameAtVillagesTurn -> Property-prop_villagerVoteCommandUpdatesVotes (GameAtVillagesTurn game) =-    forAll (arbitraryVillagerVoteCommand game) $ \(Blind command) -> do-        let game' = run_ (apply command) game--        Map.size (game' ^. votes) == 1
test/src/Game/Werewolf/Test/Engine.hs view
@@ -17,96 +17,20 @@ import Control.Monad.Writer  import Data.Either.Extra-import Data.List.Extra  import Game.Werewolf-import Game.Werewolf.Test.Arbitrary-import Game.Werewolf.Test.Engine.FallenAngel-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.Util--import Prelude hiding (round)+import Game.Werewolf.Test.Arbitrary ()  import Test.QuickCheck import Test.Tasty import Test.Tasty.QuickCheck  allEngineTests :: [TestTree]-allEngineTests = concat-    [ allFallenAngelEngineTests-    , allHunterEngineTests-    , allLynchingEngineTests-    , allOrphanEngineTests-    , allProtectorEngineTests-    , allScapegoatEngineTests-    , allSeerEngineTests-    , allVillageEngineTests-    , allWerewolfEngineTests-    , allWitchEngineTests--    , allGameOverTests-    , allStartGameTests-    ]--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 fallen angel dead"    prop_checkGameOverAdvancesStageWhenAfterFirstRoundAndFallenAngelDead-    , testProperty "check game over does nothing when fallen angel dead but aligned with villagers" prop_checkGameOverDoesNothingWhenFallenAngelDeadButAlignedWithVillagers-    , testProperty "check game over does nothing when game over"                                    prop_checkGameOverDoesNothingWhenGameOver-    ]--allStartGameTests :: [TestTree]-allStartGameTests =-    [ testProperty "start game uses given players"                              prop_startGameUsesGivenPlayers-    , testProperty "start game errors unless unique player names"               prop_startGameErrorsUnlessUniquePlayerNames+allEngineTests =+    [ testProperty "start game errors unless unique player names"               prop_startGameErrorsUnlessUniquePlayerNames     , testProperty "start game errors when less than 7 players"                 prop_startGameErrorsWhenLessThan7Players     , testProperty "start game errors when more than 1 of a restricted role"    prop_startGameErrorsWhenMoreThan1OfARestrictedRole     ]--prop_checkGameOverAdvancesStageWhenOneAllegianceAlive :: GameWithOneAllegianceAlive -> Property-prop_checkGameOverAdvancesStageWhenOneAllegianceAlive (GameWithOneAllegianceAlive game) =-    forAll (sublistOf $ game ^.. players . traverse . alive) $ \players' -> do-        let game' = foldr killPlayer game (players' ^.. names)--        has (stage . _GameOver) $ run_ checkGameOver game'--prop_checkGameOverDoesNothingWhenGameOver :: GameAtGameOver -> Property-prop_checkGameOverDoesNothingWhenGameOver (GameAtGameOver game) =-    run_ checkStage game === game---- TODO (hjw): pending---prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive :: GameWithDeadPlayers -> Property---prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive (GameWithDeadPlayers game) =---    length (nub . map (view $ role . allegiance) . filterAlive $ game ^. players) > 1---    ==> not . is gameOver $ run_ checkGameOver game--prop_checkGameOverAdvancesStageWhenAfterFirstRoundAndFallenAngelDead :: GameOnSecondRound -> Bool-prop_checkGameOverAdvancesStageWhenAfterFirstRoundAndFallenAngelDead (GameOnSecondRound game) = do-    let fallenAngelsName    = game ^?! players . fallenAngels . name-    let game'               = killPlayer fallenAngelsName game--    has (stage . _GameOver) $ run_ checkGameOver game'--prop_checkGameOverDoesNothingWhenFallenAngelDeadButAlignedWithVillagers :: GameOnSecondRound -> Bool-prop_checkGameOverDoesNothingWhenFallenAngelDeadButAlignedWithVillagers (GameOnSecondRound game) = do-    let fallenAngelsName    = game ^?! players . fallenAngels . name-    let game'               = killPlayer fallenAngelsName game & players . traverse . filteredBy name fallenAngelsName . role . allegiance .~ Villagers--    hasn't (stage . _GameOver) $ run_ checkGameOver game'--prop_startGameUsesGivenPlayers :: Property-prop_startGameUsesGivenPlayers =-    forAll arbitraryPlayerSet $ \players' ->-    (fst . fromRight . runExcept . runWriterT $ startGame "" players') ^. players == players'  prop_startGameErrorsUnlessUniquePlayerNames :: Game -> Property prop_startGameErrorsUnlessUniquePlayerNames game =
− test/src/Game/Werewolf/Test/Engine/FallenAngel.hs 
@@ -1,39 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Engine.FallenAngel-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Game.Werewolf.Test.Engine.FallenAngel (-    -- * Tests-    allFallenAngelEngineTests,-) 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--allFallenAngelEngineTests :: [TestTree]-allFallenAngelEngineTests =-    [ testProperty "check sunrise increments round"                 prop_checkSunriseIncrementsRound-    , testProperty "check sunrise sets fallen angel's allegiance"   prop_checkSunriseSetsFallenAngelsAllegiance-    ]--prop_checkSunriseIncrementsRound :: GameAtSunrise -> Property-prop_checkSunriseIncrementsRound (GameAtSunrise game) =-    run_ checkStage game ^. round === game ^. round + 1--prop_checkSunriseSetsFallenAngelsAllegiance :: GameAtSunrise -> Bool-prop_checkSunriseSetsFallenAngelsAllegiance (GameAtSunrise game) = do-    let game' = run_ checkStage game--    is villager $ game' ^?! players . fallenAngels
− test/src/Game/Werewolf/Test/Engine/Hunter.hs 
@@ -1,21 +0,0 @@-{-|-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 
@@ -1,85 +0,0 @@-{-|-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 :: GameWithMajorityVote -> Property-prop_checkLynchingLynchesOnePlayerWhenConsensus (GameWithMajorityVote 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 :: GameWithMajorityVote -> Bool-prop_checkLynchingResetsVotes (GameWithMajorityVote game) =-    Map.null $ run_ checkStage game ^. votes--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 
@@ -1,68 +0,0 @@-{-|-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.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)--    isn't fallenAngel roleModel' && isn't hunter roleModel' && isn't jester roleModel'-        ==> is werewolf $ run_ checkStage game' ^?! players . orphans-    where-        roleModel' = game ^?! players . traverse . filteredBy name (fromJust $ game ^. roleModel)
− test/src/Game/Werewolf/Test/Engine/Protector.hs 
@@ -1,52 +0,0 @@-{-|-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 
@@ -1,44 +0,0 @@-{-|-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 seer's turn"             prop_checkScapegoatsTurnAdvancesToSeersTurn-    , 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_checkScapegoatsTurnAdvancesToSeersTurn :: GameWithAllowedVoters -> Bool-prop_checkScapegoatsTurnAdvancesToSeersTurn (GameWithAllowedVoters game) =-    has (stage . _SeersTurn) (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 
@@ -1,59 +0,0 @@-{-|-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 :: GameWithMajorityVote -> Bool-prop_checkStageSkipsSeersTurnWhenNoSeer (GameWithMajorityVote 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 
@@ -1,56 +0,0 @@-{-|-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---- TODO (hjw): merge with lynching tests-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 (arbitraryPassCommand game') $ \(Blind command) -> do-        hasn't (stage . _VillagesTurn) (run_ (apply command >> checkStage) game')-    where-        game' = game & allowedVoters .~ []----prop_checkVillagesTurnAdvancesToDevotedServantsTurn :: GameWithMajorityVote -> Property---prop_checkVillagesTurnAdvancesToDevotedServantsTurn (GameWithMajorityVote game) =---    isn't fallenAngel 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 
@@ -1,89 +0,0 @@-{-|-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 
@@ -1,103 +0,0 @@-{-|-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 . fallenAngels . 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 (arbitraryPassCommand 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 (arbitraryPassCommand game) $ \(Blind command) ->-    none (is dead) (run_ (apply command >> checkStage) game ^. players)--prop_checkWitchsTurnKillsOnePlayerWhenPoisoned :: GameWithPoison -> Property-prop_checkWitchsTurnKillsOnePlayerWhenPoisoned (GameWithPoison game) =-    forAll (arbitraryPassCommand game) $ \(Blind command) ->-    length (run_ (apply command >> checkStage) game ^.. players . traverse . dead) == 1--prop_checkWitchsTurnDoesNothingWhenPassed :: GameAtWitchsTurn -> Property-prop_checkWitchsTurnDoesNothingWhenPassed (GameAtWitchsTurn game) =-    forAll (arbitraryPassCommand 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 (arbitraryPassCommand game) $ \(Blind command) -> do-        let game' = run_ (apply command >> checkStage) game--        not $ game' ^. heal--prop_checkWitchsTurnResetsPoison :: GameWithPoison -> Property-prop_checkWitchsTurnResetsPoison (GameWithPoison game) =-    forAll (arbitraryPassCommand game) $ \(Blind command) -> do-        let game' = run_ (apply command >> checkStage) game--        isNothing $ game' ^. poison--prop_checkWitchsTurnClearsPassed :: GameAtWitchsTurn -> Property-prop_checkWitchsTurnClearsPassed (GameAtWitchsTurn game) =-    forAll (arbitraryPassCommand game) $ \(Blind command) -> do-        let game' = run_ (apply command >> checkStage) game--        not $ game' ^. passed
− test/src/Game/Werewolf/Test/Game.hs 
@@ -1,109 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Game-Copyright   : (c) Henry J. Wylde, 2016-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Game.Werewolf.Test.Game (-    -- * Tests-    allGameTests,-) where--import Control.Lens--import Game.Werewolf-import Game.Werewolf.Test.Arbitrary ()--import Prelude hiding (round)--import Test.Tasty-import Test.Tasty.QuickCheck--allGameTests :: [TestTree]-allGameTests =-    [ testProperty "new game starts at village's turn when fallen angel in play"    prop_newGameStartsAtVillagesTurnWhenFallenAngelInPlay-    , testProperty "new game starts at sunset when no fallen angel in play"         prop_newGameStartsAtSunsetWhenNoFallenAngelInPlay-    , 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 boots empty"                               prop_newGameStartsWithBootsEmpty-    , 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 votes empty"                               prop_newGameStartsWithVotesEmpty-    ]--prop_newGameStartsAtVillagesTurnWhenFallenAngelInPlay :: [Player] -> Property-prop_newGameStartsAtVillagesTurnWhenFallenAngelInPlay players =-    has fallenAngels players-    ==> has (stage . _VillagesTurn) (newGame players)--prop_newGameStartsAtSunsetWhenNoFallenAngelInPlay :: [Player] -> Property-prop_newGameStartsAtSunsetWhenNoFallenAngelInPlay players =-    hasn't fallenAngels players-    ==> has (stage . _Sunset) (newGame players)--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_newGameStartsWithBootsEmpty :: [Player] -> Bool-prop_newGameStartsWithBootsEmpty players = has (boots . _Empty) (newGame players)--prop_newGameStartsWithAllowedVotersFull :: [Player] -> Property-prop_newGameStartsWithAllowedVotersFull players = newGame players ^. allowedVoters === players ^.. names--prop_newGameStartsWithHealFalse :: [Player] -> Bool-prop_newGameStartsWithHealFalse players = not $ newGame players ^. heal--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 = has (poison . _Nothing) (newGame players)--prop_newGameStartsWithPoisonUsedFalse :: [Player] -> Bool-prop_newGameStartsWithPoisonUsedFalse players = not $ newGame players ^. poisonUsed--prop_newGameStartsWithNoPriorProtect :: [Player] -> Bool-prop_newGameStartsWithNoPriorProtect players = has (priorProtect . _Nothing) (newGame players)--prop_newGameStartsWithNoProtect :: [Player] -> Bool-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 = has (see . _Nothing) (newGame players)--prop_newGameStartsWithVotesEmpty :: [Player] -> Bool-prop_newGameStartsWithVotesEmpty players = has (votes . _Empty) (newGame players)
− test/src/Game/Werewolf/Test/Player.hs 
@@ -1,29 +0,0 @@-{-|-Module      : Game.Werewolf.Test.Player-Copyright   : (c) Henry J. Wylde, 2015-License     : BSD3-Maintainer  : public@hjwylde.com--}--module Game.Werewolf.Test.Player (-    -- * Tests-    allPlayerTests,-) where--import Control.Lens--import Data.Text--import Game.Werewolf-import Game.Werewolf.Test.Arbitrary ()--import Test.Tasty-import Test.Tasty.QuickCheck--allPlayerTests :: [TestTree]-allPlayerTests =-    [ testProperty "new player is alive" prop_newPlayerIsAlive-    ]--prop_newPlayerIsAlive :: Text -> Role -> Bool-prop_newPlayerIsAlive name role = newPlayer name role ^. state == Alive
test/src/Game/Werewolf/Test/Util.hs view
@@ -11,6 +11,7 @@ ) where  import Control.Monad.Except+import Control.Monad.Random import Control.Monad.State  hiding (State) import Control.Monad.Writer @@ -20,10 +21,10 @@  import Test.QuickCheck -run :: StateT Game (WriterT [Message] (Except [Message])) a -> Game -> Either [Message] (Game, [Message])-run action game = runExcept . runWriterT $ execStateT action game+run :: StateT Game (WriterT [Message] (ExceptT [Message] (Rand StdGen))) a -> Game -> Either [Message] (Game, [Message])+run action game = evalRand (runExceptT . runWriterT $ execStateT action game) (mkStdGen 0) -run_ :: StateT Game (WriterT [Message] (Except [Message])) a -> Game -> Game+run_ :: StateT Game (WriterT [Message] (ExceptT [Message] (Rand StdGen))) a -> Game -> Game run_ action = fst . fromRight . run action  verbose_runCommandErrors :: Game -> Command -> Property
werewolf.cabal view
@@ -1,5 +1,5 @@ name:           werewolf-version:        0.5.3.0+version:        0.5.4.0  author:         Henry J. Wylde maintainer:     public@hjwylde.com@@ -111,8 +111,10 @@         extra == 1.4.*,         filepath == 1.4.*,         lens >= 4.12 && < 4.14,+        MonadRandom == 0.4.*,         mtl == 2.2.*,         text == 1.2.*,+        tostring == 0.2.*,         transformers == 0.4.*  test-suite werewolf-test@@ -132,18 +134,6 @@         Game.Werewolf.Test.Command.See         Game.Werewolf.Test.Command.Vote         Game.Werewolf.Test.Engine-        Game.Werewolf.Test.Engine.FallenAngel-        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.Game-        Game.Werewolf.Test.Player         Game.Werewolf.Test.Util      default-language: Haskell2010@@ -154,6 +144,7 @@         containers == 0.5.*,         extra == 1.4.*,         lens >= 4.12 && < 4.14,+        MonadRandom == 0.4.*,         mtl == 2.2.*,         QuickCheck == 2.8.*,         tasty >= 0.10 && < 0.12,