werewolf 0.3.3.2 → 0.3.4.0

raw patch · 17 files changed

+213/−105 lines, 17 files

Files

• CHANGELOG.md +20/−0
• app/Main.hs +2/−0
• app/Werewolf/Commands/Help.hs +3/−0
• app/Werewolf/Commands/Ping.hs +43/−0
• app/Werewolf/Commands/Start.hs +2/−1
• app/Werewolf/Commands/Vote.hs +4/−4
• app/Werewolf/Options.hs +5/−0
• src/Game/Werewolf/Command.hs +27/−10
• src/Game/Werewolf/Engine.hs +20/−35
• src/Game/Werewolf/Game.hs +15/−6
• src/Game/Werewolf/Response.hs +48/−19
• src/Game/Werewolf/Role.hs +7/−1
• test/app/Main.hs +2/−4
• test/src/Game/Werewolf/Test/Arbitrary.hs +2/−0
• test/src/Game/Werewolf/Test/Engine.hs +5/−14
• test/src/Game/Werewolf/Test/Game.hs +5/−10
• werewolf.cabal +3/−1

@@ -2,11 +2,31 @@  #### Upcoming +#### v0.3.4.0++*Minor*++* Added a `ping` command. ([#64](https://github.com/hjwylde/werewolf/issues/64))++*Revisions*++* Added missing apostrophe to the new turn message. ([#63](https://github.com/hjwylde/werewolf/issues/63))+* Changed the "Whom would you like to lynch?" text to be a public message displayed after the devoured message. ([#56](https://github.com/hjwylde/werewolf/issues/56))+* Better prompt to action when villagers vote.+* Changed devour vote messages to be sent immediately. ([#57](https://github.com/hjwylde/werewolf/issues/57))+* Removed useless `only` function. ([#55](https://github.com/hjwylde/werewolf/issues/55))+* Turned start of day and night into distinct turns.+* Added private message to players when the game is over. ([#65](https://github.com/hjwylde/werewolf/issues/65))+ #### v0.3.3.2 +*Revisions*+ * Fixed missing file in Cabal file. ([#18](https://github.com/hjwylde/werewolf/issues/18))  #### v0.3.3.1++*Revisions*  * Added `noIntersperse` to `interpret`. ([#60](https://github.com/hjwylde/werewolf/issues/60)) 

@@ -24,6 +24,7 @@ import qualified Werewolf.Commands.End       as End import qualified Werewolf.Commands.Help      as Help import qualified Werewolf.Commands.Interpret as Interpret+import qualified Werewolf.Commands.Ping      as Ping import qualified Werewolf.Commands.Quit      as Quit import qualified Werewolf.Commands.See       as See import qualified Werewolf.Commands.Start     as Start@@ -50,6 +51,7 @@     End                                 -> End.handle callerName     Help options                        -> Help.handle callerName options     Interpret (Interpret.Options args)  -> interpret callerName args+    Ping                                -> Ping.handle callerName     Quit                                -> Quit.handle callerName     See options                         -> See.handle callerName options     Start options                       -> Start.handle callerName options

@@ -64,6 +64,9 @@     "end",     "- Ends the current game."     ], [+    "ping",+    "- Pings the status of the current game publicly."+    ], [     "quit",     "- Quit the current game."     ], [

@@ -0,0 +1,43 @@+{-|+Module      : Werewolf.Commands.Ping+Description : Handler for the ping subcommand.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Handler for the ping subcommand.+-}++{-# LANGUAGE OverloadedStrings #-}++module Werewolf.Commands.Ping (+    -- * Handle+    handle,+) where++import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.State+import Control.Monad.Writer++import Data.Text (Text)++import Game.Werewolf.Command+import Game.Werewolf.Engine   hiding (isVillagersTurn)+import Game.Werewolf.Response++-- | Handle.+handle :: MonadIO m => Text -> m ()+handle callerName = do+    unlessM doesGameExist $ exitWith failure {+        messages = [privateMessage [callerName] "No game is running."]+        }++    game <- readGame++    let command = pingCommand++    case runExcept (execWriterT $ execStateT (apply command) game) of+        Left errorMessages  -> exitWith failure { messages = errorMessages }+        Right messages      -> exitWith success { messages = messages }

@@ -21,6 +21,7 @@  import Control.Monad.Except import Control.Monad.Extra+import Control.Monad.State import Control.Monad.Writer  import Data.Text (Text)@@ -48,7 +49,7 @@          players <- createPlayers playerNames extraRoles -        runWriterT $ startGame callerName players+        runWriterT $ startGame callerName players >>= execStateT checkTurn      case result of         Left errorMessages      -> exitWith failure { messages = errorMessages }

@@ -27,7 +27,7 @@ import Data.Text (Text)  import Game.Werewolf.Command-import Game.Werewolf.Engine   hiding (isVillagersTurn)+import Game.Werewolf.Engine   hiding (isWerewolvesTurn) import Game.Werewolf.Game import Game.Werewolf.Response @@ -45,9 +45,9 @@      game <- readGame -    let command = (if isVillagersTurn game-            then lynchVoteCommand-            else devourVoteCommand+    let command = (if isWerewolvesTurn game+            then devourVoteCommand+            else lynchVoteCommand             ) callerName targetName      case runExcept (runWriterT $ execStateT (apply command >> checkTurn >> checkGameOver) game) of

@@ -45,6 +45,7 @@     = End     | Help Help.Options     | Interpret Interpret.Options+    | Ping     | Quit     | See See.Options     | Start Start.Options@@ -81,6 +82,7 @@         command "end"       $ info (helper <*> end)         (fullDesc <> progDesc "End the current game"),         command "help"      $ info (helper <*> help_)       (fullDesc <> progDesc "Help documents"),         command "interpret" $ info (helper <*> interpret)   (fullDesc <> progDesc "Interpret a command" <> noIntersperse),+        command "ping"      $ info (helper <*> ping)        (fullDesc <> progDesc "Pings the status of the current game publicly"),         command "quit"      $ info (helper <*> quit)        (fullDesc <> progDesc "Quit the current game"),         command "see"       $ info (helper <*> see)         (fullDesc <> progDesc "See a player's allegiance"),         command "start"     $ info (helper <*> start)       (fullDesc <> progDesc "Start a new game"),@@ -102,6 +104,9 @@  interpret :: Parser Command interpret = Interpret . Interpret.Options <$> many (T.pack <$> strArgument (metavar "-- COMMAND ARG..."))++ping :: Parser Command+ping = pure Ping  quit :: Parser Command quit = pure Quit

@@ -10,6 +10,7 @@ -}  {-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes            #-}  module Game.Werewolf.Command (@@ -17,7 +18,8 @@     Command(..),      -- ** Instances-    devourVoteCommand, lynchVoteCommand, noopCommand, quitCommand, seeCommand, statusCommand,+    devourVoteCommand, lynchVoteCommand, noopCommand, pingCommand, quitCommand, seeCommand,+    statusCommand, ) where  import Control.Lens         hiding (only)@@ -26,17 +28,16 @@ import Control.Monad.State  hiding (state) import Control.Monad.Writer +import           Data.List import qualified Data.Map  as Map-import Data.List import           Data.Text (Text)-import           qualified Data.Text as T  import Game.Werewolf.Engine-import Game.Werewolf.Role hiding (Werewolves, Villagers, name, _name, findByName_)-import Game.Werewolf.Player hiding (doesPlayerExist) import Game.Werewolf.Game     hiding (isGameOver, isSeersTurn, isVillagersTurn, isWerewolvesTurn,                                killPlayer)+import Game.Werewolf.Player   hiding (doesPlayerExist) import Game.Werewolf.Response+import Game.Werewolf.Role     hiding (Villagers, Werewolves, findByName_, name, _name)  data Command = Command { apply :: forall m . (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => m () } @@ -51,6 +52,10 @@      votes %= Map.insert callerName targetName +    aliveWerewolfNames <- uses players $ map _name . filterAlive . filterWerewolves++    tell [playerMadeDevourVoteMessage aliveWerewolfNames callerName targetName]+ lynchVoteCommand :: Text -> Text -> Command lynchVoteCommand callerName targetName = Command $ do     validatePlayer callerName callerName@@ -63,6 +68,18 @@ noopCommand :: Command noopCommand = Command $ return () +pingCommand :: Command+pingCommand = Command $ use turn >>= \turn' -> case turn' of+    Seers       -> tell [pingSeersMessage]+    Villagers   -> do+        game <- get++        tell [waitingOnMessage Nothing $ filter (flip Map.notMember (game ^. votes) . _name) (filterAlive $ game ^. players)]+    Werewolves  -> tell [pingWerewolvesMessage]+    NoOne       -> return ()+    NightFalling -> return ()+    DayBreaking  -> return ()+ quitCommand :: Text -> Command quitCommand callerName = Command $ do     validatePlayer callerName callerName@@ -95,20 +112,20 @@         game <- get          tell $ standardStatusMessages turn' (game ^. players)-        tell [waitingOnMessage callerName $ filter (flip Map.notMember (game ^. votes) . _name) (filterAlive $ game ^. players)]+        tell [waitingOnMessage (Just [callerName]) $ filter (flip Map.notMember (game ^. votes) . _name) (filterAlive $ game ^. players)]     Werewolves  -> do         unlessM (doesPlayerExist callerName) $ throwError [playerDoesNotExistMessage callerName callerName]          game <- get          tell $ standardStatusMessages turn' (game ^. players)-        whenM (isPlayerWerewolf callerName) $ tell [waitingOnMessage callerName $ filter (flip Map.notMember (game ^. votes) . _name) (filterAlive . filterWerewolves $ game ^. players)]+        whenM (isPlayerWerewolf callerName) $ tell [waitingOnMessage (Just [callerName]) $ filter (flip Map.notMember (game ^. votes) . _name) (filterAlive . filterWerewolves $ game ^. players)]     NoOne       -> do         aliveAllegiances <- uses players $ nub . map (_allegiance . _role) . filterAlive -        case aliveAllegiances of-            [allegiance]    -> tell [gameOverMessage . Just . T.pack $ show allegiance]-            _               -> tell [gameOverMessage Nothing]+        when (length aliveAllegiances <= 1) $ turn .= NoOne >> get >>= tell . gameOverMessages+    NightFalling -> return ()+    DayBreaking  -> return ()     where         standardStatusMessages turn players = [             currentTurnMessage callerName turn,

@@ -10,6 +10,7 @@ -}  {-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings     #-}  module Game.Werewolf.Engine (@@ -39,7 +40,7 @@     randomiseRoles, ) where -import Control.Lens         hiding (cons, only)+import Control.Lens         hiding (cons) import Control.Monad.Except import Control.Monad.Random import Control.Monad.State  hiding (state)@@ -48,7 +49,6 @@ import           Data.List.Extra import qualified Data.Map        as Map import           Data.Text       (Text)-import qualified Data.Text       as T  import           Game.Werewolf.Game     hiding (isGameOver, isSeersTurn, isVillagersTurn,                                          isWerewolvesTurn, killPlayer)@@ -56,8 +56,8 @@ import           Game.Werewolf.Player   hiding (doesPlayerExist) import qualified Game.Werewolf.Player   as Player import           Game.Werewolf.Response-import           Game.Werewolf.Role     (Role, werewolfRole, villagerRole, _allegiance)-import           qualified Game.Werewolf.Role     as Role+import           Game.Werewolf.Role     (Role, villagerRole, werewolfRole, _allegiance)+import qualified Game.Werewolf.Role     as Role  import System.Directory import System.FilePath@@ -68,6 +68,10 @@  checkTurn' :: (MonadState Game m, MonadWriter [Message] m) => m () checkTurn' = use turn >>= \turn' -> case turn' of+    NightFalling -> advanceTurn++    DayBreaking -> advanceTurn+     Seers -> do         seersCount  <- uses players (length . filterAlive . filterSeers)         votes'      <- use sees@@ -87,25 +91,16 @@         when (playersCount == Map.size votes') $ do             tell $ map (uncurry playerMadeLynchVoteMessage) (Map.toList votes') -            let mLynchedName = only . last $ groupSortOn (length . flip elemIndices (Map.elems votes')) (nub $ Map.elems votes')-            case mLynchedName of-                Nothing                -> do-                    aliveScapegoats <- uses players (filterAlive . filterScapegoats)--                    let mScapegoat = only aliveScapegoats-                    case mScapegoat of-                        Nothing        -> tell [noPlayerLynchedMessage]-                        Just scapegoat -> do-                            killPlayer scapegoat-                            tell [scapegoatLynchedMessage (scapegoat ^. name)]--                Just lynchedName       -> do+            case last $ groupSortOn (length . flip elemIndices (Map.elems votes')) (nub $ Map.elems votes') of+                [lynchedName]   -> do                     target <- uses players (findByName_ lynchedName)                      killPlayer target                     tell [playerLynchedMessage (target ^. name) (target ^. role . Role.name)]--            tell [nightFallsMessage]+                _               ->+                    uses players (filterAlive . filterScapegoats) >>= \aliveScapegoats -> case aliveScapegoats of+                        (scapegoat:_)   -> killPlayer scapegoat >> tell [scapegoatLynchedMessage (scapegoat ^. name)]+                        []              -> tell [noPlayerLynchedMessage]              advanceTurn @@ -114,25 +109,18 @@         votes'          <- use votes          when (length aliveWerewolves == Map.size votes') $ do-            tell $ map (uncurry . playerMadeDevourVoteMessage $ map _name aliveWerewolves) (Map.toList votes')-             advanceTurn -            let mTargetName = only . last $ groupSortOn (length . flip elemIndices (Map.elems votes')) (nub $ Map.elems votes')-            case mTargetName of-                Nothing         -> tell [noPlayerDevouredMessage]-                Just targetName -> do+            case last $ groupSortOn (length . flip elemIndices (Map.elems votes')) (nub $ Map.elems votes') of+                [targetName]    -> do                     target <- uses players (findByName_ targetName)                      killPlayer target-                    tell [playerDevouredMessage (target ^. name) (target ^. role . Role.name)]+                    tell [playerDevouredMessage (target ^. name) (target ^. role . Role.name), villagersLynchVoteMessage]+                _               -> tell [noPlayerDevouredMessage, villagersLynchVoteMessage]      NoOne -> return () -only :: [a] -> Maybe a-only [a]    = Just a-only _      = Nothing- advanceTurn :: (MonadState Game m, MonadWriter [Message] m) => m () advanceTurn = do     turn' <- use turn@@ -140,7 +128,7 @@      let nextTurn = if length (nub $ map (_allegiance . _role) alivePlayers) <= 1         then NoOne-        else head . drop1 $ filter (turnAvailable $ map _role alivePlayers) (dropWhile (turn' /=) turnRotation)+        else head $ filter (turnAvailable $ map _role alivePlayers) (drop1 $ dropWhile (turn' /=) turnRotation)      tell $ turnMessages nextTurn alivePlayers @@ -152,10 +140,7 @@ checkGameOver = do     aliveAllegiances <- uses players $ nub . map (_allegiance . _role) . filterAlive -    case aliveAllegiances of-        []              -> turn .= NoOne >> tell [gameOverMessage Nothing]-        [allegiance]    -> turn .= NoOne >> tell [gameOverMessage . Just . T.pack $ show allegiance]-        _               -> return ()+    when (length aliveAllegiances <= 1) $ turn .= NoOne >> get >>= tell . gameOverMessages  startGame :: (MonadError [Message] m, MonadWriter [Message] m) => Text -> [Player] -> m Game startGame callerName players = do

@@ -20,6 +20,7 @@     killPlayer,      -- ** Queries+    isNightfallTurn, isDaybreakTurn,     isSeersTurn, isVillagersTurn, isWerewolvesTurn, isGameOver,      -- * Turn@@ -43,7 +44,7 @@     , _votes   :: Map Text Text     } deriving (Eq, Read, Show) -data Turn = Seers | Villagers | Werewolves | NoOne+data Turn = NightFalling | DayBreaking | Seers | Villagers | Werewolves | NoOne     deriving (Eq, Read, Show)  makeLenses ''Game@@ -58,6 +59,12 @@ killPlayer :: Game -> Player -> Game killPlayer game player = game & players %~ map (\player' -> if player' == player then player' & state .~ Dead else player') +isNightfallTurn :: Game -> Bool+isNightfallTurn game = game ^. turn == NightFalling++isDaybreakTurn :: Game -> Bool+isDaybreakTurn game = game ^. turn == DayBreaking+ isSeersTurn :: Game -> Bool isSeersTurn game = game ^. turn == Seers @@ -71,10 +78,12 @@ isGameOver game = game ^. turn == NoOne  turnRotation :: [Turn]-turnRotation = cycle [Seers, Werewolves, Villagers, NoOne]+turnRotation = cycle [NightFalling, Seers, Werewolves, DayBreaking, Villagers, NoOne]  turnAvailable :: [Role] -> Turn -> Bool-turnAvailable aliveRoles Seers  = seerRole `elem` aliveRoles-turnAvailable _ Villagers       = True-turnAvailable _ Werewolves      = True-turnAvailable _ NoOne           = False+turnAvailable _ NightFalling          = True+turnAvailable _ DayBreaking           = True+turnAvailable aliveRoles Seers        = seerRole `elem` aliveRoles+turnAvailable _ Villagers             = True+turnAvailable _ Werewolves            = True+turnAvailable _ NoOne                 = False

@@ -28,8 +28,11 @@     publicMessage, privateMessage,      -- ** Generic messages-    newGameMessages, turnMessages, nightFallsMessage, gameOverMessage, playerQuitMessage,+    newGameMessages, turnMessages, nightFallsMessage, gameOverMessages, playerQuitMessage, +    -- ** Ping messages+    pingSeersMessage, pingWerewolvesMessage,+     -- ** Status messages     currentTurnMessage, rolesInGameMessage, playersInGameMessage, waitingOnMessage, @@ -42,7 +45,7 @@      -- ** Werewolves turn messages     werewolvesTurnMessages, playerMadeDevourVoteMessage, playerDevouredMessage,-    noPlayerDevouredMessage,+    noPlayerDevouredMessage, villagersLynchVoteMessage,      -- ** Generic error messages     gameIsOverMessage, playerDoesNotExistMessage, playerCannotDoThatMessage,@@ -73,7 +76,7 @@  import           Game.Werewolf.Game import           Game.Werewolf.Player-import           Game.Werewolf.Role   (Role, allegiance, description)+import           Game.Werewolf.Role   (Role, allegiance, description, _allegiance) import qualified Game.Werewolf.Role   as Role import           GHC.Generics @@ -127,7 +130,7 @@ privateMessage to = Message (Just to)  newGameMessages :: Game -> [Message]-newGameMessages game = [newPlayersInGameMessage players', rolesInGameMessage Nothing $ map _role players'] ++ map (newPlayerMessage players') players' ++ [nightFallsMessage] ++ turnMessages turn' players'+newGameMessages game = [newPlayersInGameMessage players', rolesInGameMessage Nothing $ map _role players'] ++ map (newPlayerMessage players') players' ++ turnMessages turn' players'     where         turn'       = game ^. turn         players'    = game ^. players@@ -148,25 +151,47 @@             | otherwise                                 = T.concat [", along with ", T.intercalate ", " (map _name $ filterWerewolves players \\ [player]), "."]  turnMessages :: Turn -> [Player] -> [Message]+turnMessages NightFalling _     = [nightFallsMessage]+turnMessages DayBreaking _      = [] turnMessages Seers players      = seersTurnMessages $ filter isSeer players-turnMessages Villagers players  = villagersTurnMessage players+turnMessages Villagers _        = [villagersTurnMessage] turnMessages Werewolves players = werewolvesTurnMessages $ filter isWerewolf players turnMessages NoOne _            = []  nightFallsMessage :: Message nightFallsMessage = publicMessage "Night falls, the townsfolk are asleep." -gameOverMessage :: Maybe Text -> Message-gameOverMessage Nothing             = publicMessage "The game is over! Everyone died..."-gameOverMessage (Just allegiance)   = publicMessage $ T.unwords ["The game is over! The", allegiance, "have won."]+gameOverMessages :: Game -> [Message]+gameOverMessages game = case aliveAllegiances of+    [allegiance]    -> concat [+        [publicMessage $ T.unwords ["The game is over! The", T.pack $ show allegiance, "have won."]],+        map (playerWonMessage . _name) (filter ((allegiance ==) . _allegiance . _role) players'),+        map (playerLostMessage . _name) (filter ((allegiance /=) . _allegiance . _role) players')+        ]+    _               -> publicMessage "The game is over! Everyone died...":map (playerLostMessage . _name) players'+    where+        players'            = game ^. players+        aliveAllegiances    = nub $ map (_allegiance . _role) (filterAlive players') +playerWonMessage :: Text -> Message+playerWonMessage name = privateMessage [name] "Victory! You won!"++playerLostMessage :: Text -> Message+playerLostMessage name = privateMessage [name] "Feck, you lost this time round..."+ playerQuitMessage :: Player -> Message playerQuitMessage player = publicMessage $ T.unwords [player ^. name, "the", player ^. role . Role.name, "has quit!"] +pingSeersMessage :: Message+pingSeersMessage = publicMessage "Waiting on the Seers..."++pingWerewolvesMessage :: Message+pingWerewolvesMessage = publicMessage "Waiting on the Werewolves..."+ currentTurnMessage :: Text -> Turn -> Message currentTurnMessage name NoOne   = gameIsOverMessage name-currentTurnMessage name turn    = privateMessage [name] $ T.unwords [-    "It's currently the", T.pack $ show turn, "turn."+currentTurnMessage name turn    = privateMessage [name] $ T.concat [+    "It's currently the ", T.pack $ show turn, "' turn."     ]  rolesInGameMessage :: Maybe [Text] -> [Role] -> Message@@ -194,8 +219,8 @@             T.intercalate ", " (map (\player -> T.concat [player ^. name, " (", player ^. role . Role.name, ")"]) $ filterDead players), "."             ] -waitingOnMessage :: Text -> [Player] -> Message-waitingOnMessage name players = privateMessage [name] $ T.concat [+waitingOnMessage :: Maybe [Text] -> [Player] -> Message+waitingOnMessage to players = Message to $ T.concat [     "Waiting on ", T.intercalate ", " playerNames, "..."     ]     where@@ -210,12 +235,12 @@ playerSeenMessage :: Text -> Player -> Message playerSeenMessage seerName target = privateMessage [seerName] $ T.concat [target ^. name, " is aligned with the ", T.pack . show $ target ^. role . allegiance, "."] -villagersTurnMessage :: [Player] -> [Message]-villagersTurnMessage players = [-    publicMessage "The sun rises. Everybody wakes up and opens their eyes...",-    privateMessage (map _name players) "Whom would you like to lynch?"-    ]+villagersTurnMessage :: Message+villagersTurnMessage = publicMessage "The sun rises. Everybody wakes up and opens their eyes..." +villagersLynchVoteMessage :: Message+villagersLynchVoteMessage = publicMessage "Whom would you like to lynch?"+ playerMadeLynchVoteMessage :: Text -> Text -> Message playerMadeLynchVoteMessage voterName targetName = publicMessage $ T.concat [voterName, " voted to lynch ", targetName, "."] @@ -254,11 +279,15 @@ playerDevouredMessage name roleName = publicMessage $ T.concat [     "As you open them you notice a door broken down and ",     name, "'s guts half devoured and spilling out over the cobblestones.",-    " From the look of their personal effects, you deduce they were a ", roleName, "."+    " From the look of their personal effects, you deduce they were a ", roleName, ".",+    " As the village bays for vengeance, the town clerk calls for a vote."     ]  noPlayerDevouredMessage :: Message-noPlayerDevouredMessage = publicMessage "Surprisingly you see everyone present at the town square. Perhaps the Werewolves have left Miller's Hollow?"+noPlayerDevouredMessage = publicMessage $ T.unwords [+    "Surprisingly you see everyone present at the town square. Perhaps the Werewolves have left Miller's Hollow?",+    "Still got to keep up the tradition though, so the town clerk calls for a vote."+    ]  gameIsOverMessage :: Text -> Message gameIsOverMessage name = privateMessage [name] "The game is over!"

@@ -17,7 +17,7 @@     Role(..), name, allegiance, description, advice,      -- ** Instances-    allRoles, seerRole, villagerRole, werewolfRole, scapegoatRole,+    allRoles, diurnalRoles, nocturnalRoles, seerRole, villagerRole, werewolfRole, scapegoatRole,      -- ** Queries     findByName, findByName_,@@ -44,6 +44,12 @@  allRoles :: [Role] allRoles = [seerRole, villagerRole, werewolfRole, scapegoatRole]++diurnalRoles :: [Role]+diurnalRoles = [villagerRole, scapegoatRole]++nocturnalRoles :: [Role]+nocturnalRoles = [seerRole, werewolfRole]  seerRole :: Role seerRole = Role

@@ -92,8 +92,7 @@     testProperty "PROP: check game over advances turn" prop_checkGameOverAdvancesTurn,     testProperty "PROP: check game over does nothing when at least two allegiances alive" prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive, -    testProperty "PROP: start game starts with seers turn when seers present" prop_startGameStartsWithSeersTurnWhenSeersPresent,-    testProperty "PROP: start game starts with werewolves turn when seers absent" prop_startGameStartsWithWerewolvesTurnWhenSeersAbsent,+    testProperty "PROP: start game starts with nightfall turn" prop_startGameStartsWithNightfallTurn,     testProperty "PROP: start game uses given players" prop_startGameUsesGivenPlayers,     testProperty "PROP: start game errors unless unique player names" prop_startGameErrorsUnlessUniquePlayerNames,     testProperty "PROP: start game errors when less than 7 players" prop_startGameErrorsWhenLessThan7Players,@@ -110,8 +109,7 @@  allGameTests :: [TestTree] allGameTests = [-    testProperty "PROP: new game starts with seers turn when seers present" prop_newGameStartsWithSeersTurnWhenSeersPresent,-    testProperty "PROP: new game starts with werewolves turn when seers absent" prop_newGameStartsWithWerewolvesTurnWhenSeersAbsent,+    testProperty "PROP: new game starts with nightfall turn" prop_newGameStartsWithNightfallTurn,      testProperty "PROP: new game starts with sees empty" prop_newGameStartsWithSeesEmpty,     testProperty "PROP: new game starts with votes empty" prop_newGameStartsWithVotesEmpty,

@@ -42,6 +42,8 @@  arbitraryCommand :: Game -> Gen Command arbitraryCommand game = case game ^. turn of+    DayBreaking -> return noopCommand+    NightFalling -> return noopCommand     Seers       -> arbitrarySeeCommand game     Villagers   -> arbitraryLynchVoteCommand game     Werewolves  -> arbitraryDevourVoteCommand game

@@ -24,8 +24,7 @@     prop_checkGameOverAdvancesTurn, prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive,      -- * startGame-    prop_startGameStartsWithSeersTurnWhenSeersPresent,-    prop_startGameStartsWithWerewolvesTurnWhenSeersAbsent, prop_startGameUsesGivenPlayers,+    prop_startGameStartsWithNightfallTurn, prop_startGameUsesGivenPlayers,     prop_startGameErrorsUnlessUniquePlayerNames, prop_startGameErrorsWhenLessThan7Players,     prop_startGameErrorsWhenMoreThan24Players, @@ -205,18 +204,10 @@             length (nub . map (_allegiance . _role) . filterAlive $ game' ^. players) > 1             ==> not . isGameOver $ run_ checkGameOver game' -prop_startGameStartsWithSeersTurnWhenSeersPresent :: [Player] -> Property-prop_startGameStartsWithSeersTurnWhenSeersPresent players = and [-    any isSeer players,-    isRight . runExcept . runWriterT $ startGame "" players-    ] ==> isSeersTurn (fst . fromRight . runExcept . runWriterT $ startGame "" players)--prop_startGameStartsWithWerewolvesTurnWhenSeersAbsent :: [Player] -> Property-prop_startGameStartsWithWerewolvesTurnWhenSeersAbsent players = and [-    isRight . runExcept . runWriterT $ startGame "" players'-    ] ==> isWerewolvesTurn (fst . fromRight . runExcept . runWriterT $ startGame "" players')-    where-        players' = filter (not . isSeer) players+prop_startGameStartsWithNightfallTurn :: [Player] -> Property+prop_startGameStartsWithNightfallTurn players =+    isRight (runExcept . runWriterT $ startGame "" players)+    ==> isNightfallTurn (fst . fromRight . runExcept . runWriterT $ startGame "" players)  prop_startGameUsesGivenPlayers :: [Player] -> Property prop_startGameUsesGivenPlayers players' = and [

@@ -8,9 +8,9 @@ {-# OPTIONS_HADDOCK hide, prune #-}  module Game.Werewolf.Test.Game (-    prop_newGameStartsWithSeersTurnWhenSeersPresent,-    prop_newGameStartsWithWerewolvesTurnWhenSeersAbsent, prop_newGameStartsWithSeesEmpty,-    prop_newGameStartsWithVotesEmpty, prop_newGameUsesGivenPlayers,+    prop_newGameStartsWithNightfallTurn,+    prop_newGameStartsWithSeesEmpty, prop_newGameStartsWithVotesEmpty,+    prop_newGameUsesGivenPlayers, ) where  import Control.Lens@@ -20,13 +20,8 @@ import Game.Werewolf.Game import Game.Werewolf.Player -import Test.QuickCheck--prop_newGameStartsWithSeersTurnWhenSeersPresent :: [Player] -> Property-prop_newGameStartsWithSeersTurnWhenSeersPresent players = any isSeer players ==> isSeersTurn (newGame players)--prop_newGameStartsWithWerewolvesTurnWhenSeersAbsent :: [Player] -> Bool-prop_newGameStartsWithWerewolvesTurnWhenSeersAbsent players = isWerewolvesTurn (newGame $ filter (not . isSeer) players)+prop_newGameStartsWithNightfallTurn :: [Player] -> Bool+prop_newGameStartsWithNightfallTurn players = isNightfallTurn (newGame players)  prop_newGameStartsWithSeesEmpty :: [Player] -> Bool prop_newGameStartsWithSeesEmpty players = Map.null $ newGame players ^. sees

@@ -1,5 +1,5 @@ name:           werewolf-version:        0.3.3.2+version:        0.3.4.0  author:         Henry J. Wylde maintainer:     public@hjwylde.com@@ -31,6 +31,7 @@         Werewolf.Commands.End,         Werewolf.Commands.Help,         Werewolf.Commands.Interpret,+        Werewolf.Commands.Ping,         Werewolf.Commands.Quit,         Werewolf.Commands.See,         Werewolf.Commands.Start,@@ -71,6 +72,7 @@         CPP,         DeriveGeneric,         FlexibleContexts,+        MultiParamTypeClasses,         OverloadedStrings,         RankNTypes,         TemplateHaskell