(#11) added getPendingVoters and getPlayerVote to Game

hjwylde · Jan 30, 2016 · cff7527 · cff7527
1 parent d1a4e1b
commit cff7527
Show file tree

Hide file tree

Showing 4 changed files with 20 additions and 14 deletions.
diff --git a/src/Game/Werewolf/Command.hs b/src/Game/Werewolf/Command.hs
@@ -32,8 +32,8 @@ import qualified Data.Map  as Map
 import           Data.Text (Text)
 
 import Game.Werewolf.Engine
-import Game.Werewolf.Game     hiding (isGameOver, isSeersTurn, isVillagesTurn, isWerewolvesTurn,
-                               killPlayer)
+import Game.Werewolf.Game     hiding (getPendingVoters, getPlayerVote, isGameOver, isSeersTurn,
+                               isVillagesTurn, isWerewolvesTurn, killPlayer)
 import Game.Werewolf.Player   hiding (doesPlayerExist)
 import Game.Werewolf.Response
 

diff --git a/src/Game/Werewolf/Engine.hs b/src/Game/Werewolf/Engine.hs
@@ -52,8 +52,8 @@ import qualified Data.Map        as Map
 import           Data.Text       (Text)
 import qualified Data.Text       as T
 
-import           Game.Werewolf.Game     hiding (isGameOver, isSeersTurn, isVillagesTurn,
-                                         isWerewolvesTurn, killPlayer)
+import           Game.Werewolf.Game     hiding (getPendingVoters, getPlayerVote, isGameOver,
+                                         isSeersTurn, isVillagesTurn, isWerewolvesTurn, killPlayer)
 import qualified Game.Werewolf.Game     as Game
 import           Game.Werewolf.Player   hiding (doesPlayerExist)
 import qualified Game.Werewolf.Player   as Player
@@ -174,14 +174,10 @@ isGameOver :: MonadState Game m => m Bool
 isGameOver = gets Game.isGameOver
 
 getPlayerVote :: MonadState Game m => Text -> m (Maybe Text)
-getPlayerVote playerName = use $ votes . at playerName
+getPlayerVote playerName = gets $ Game.getPlayerVote playerName
 
 getPendingVoters :: MonadState Game m => m [Player]
-getPendingVoters = do
-    votes'          <- use votes
-    alivePlayers    <- uses players filterAlive
-
-    return $ filter (flip Map.notMember votes' . _name) alivePlayers
+getPendingVoters = gets Game.getPendingVoters
 
 defaultFilePath :: MonadIO m => m FilePath
 defaultFilePath = (</> defaultFileName) <$> liftIO getHomeDirectory

diff --git a/src/Game/Werewolf/Game.hs b/src/Game/Werewolf/Game.hs
@@ -20,7 +20,8 @@ module Game.Werewolf.Game (
     killPlayer,
 
     -- ** Queries
-    isGameOver, isSeersTurn, isSunset, isVillagesTurn, isWerewolvesTurn,
+    isGameOver, isSeersTurn, isSunset, isVillagesTurn, isWerewolvesTurn, getPlayerVote,
+    getPendingVoters,
 
     -- * Stage
     Stage(..),
@@ -34,7 +35,7 @@ import qualified Data.Map  as Map
 import           Data.Text (Text)
 
 import Game.Werewolf.Player
-import Game.Werewolf.Role   hiding (Villagers, Werewolves)
+import Game.Werewolf.Role   hiding (Villagers, Werewolves, _name)
 
 data Game = Game
     { _stage   :: Stage
@@ -74,6 +75,15 @@ isVillagesTurn game = game ^. stage == VillagesTurn
 isWerewolvesTurn :: Game -> Bool
 isWerewolvesTurn game = game ^. stage == WerewolvesTurn
 
+getPlayerVote :: Text -> Game -> Maybe Text
+getPlayerVote playerName game = game ^. votes . at playerName
+
+getPendingVoters :: Game -> [Player]
+getPendingVoters game = filter (flip Map.notMember votes' . _name) alivePlayers
+    where
+        votes'          = game ^. votes
+        alivePlayers    = filterAlive $ game ^. players
+
 stageCycle :: [Stage]
 stageCycle = cycle [Sunset, SeersTurn, WerewolvesTurn, Sunrise, VillagesTurn]
 

diff --git a/test/src/Game/Werewolf/Test/Arbitrary.hs b/test/src/Game/Werewolf/Test/Arbitrary.hs
@@ -52,7 +52,7 @@ arbitraryCommand game = case game ^. stage of
 
 arbitraryDevourVoteCommand :: Game -> Gen Command
 arbitraryDevourVoteCommand game = do
-    let applicableCallers   = filter (flip Map.notMember (game ^. votes) . _name) (filterAlive . filterWerewolves $ game ^. players)
+    let applicableCallers   = filterWerewolves $ getPendingVoters game
     target                  <- suchThat (arbitraryPlayer game) $ not . isWerewolf
 
     if null applicableCallers
@@ -61,7 +61,7 @@ arbitraryDevourVoteCommand game = do
 
 arbitraryLynchVoteCommand :: Game -> Gen Command
 arbitraryLynchVoteCommand game = do
-    let applicableCallers   = filter (flip Map.notMember (game ^. votes) . _name) (filterAlive $ game ^. players)
+    let applicableCallers   = getPendingVoters game
     target                  <- arbitraryPlayer game
 
     if null applicableCallers