diff --git a/app/Werewolf/Commands/End.hs b/app/Werewolf/Commands/End.hs index 740b93b..0aad3a3 100644 --- a/app/Werewolf/Commands/End.hs +++ b/app/Werewolf/Commands/End.hs @@ -16,32 +16,26 @@ module Werewolf.Commands.End ( handle, ) where -import Control.Lens import Control.Monad.Extra import Control.Monad.IO.Class -import Data.Maybe import Data.Text (Text) import qualified Data.Text as T -import Game.Werewolf.Engine +import Game.Werewolf.Engine hiding (doesPlayerExist) import Game.Werewolf.Game -import Game.Werewolf.Player import Game.Werewolf.Response import Werewolf.Messages handle :: MonadIO m => Text -> m () handle callerName = do - unlessM doesGameExist $ exitWith failure - { messages = [noGameRunningMessage callerName] - } + unlessM doesGameExist $ exitWith failure { messages = [noGameRunningMessage callerName] } game <- readGame - when (isNothing $ findByName callerName (game ^. players)) $ exitWith failure - { messages = [playerCannotDoThatMessage callerName] - } + unless (doesPlayerExist callerName game) $ + exitWith failure { messages = [playerCannotDoThatMessage callerName] } deleteGame diff --git a/app/Werewolf/Messages.hs b/app/Werewolf/Messages.hs index a25b0cf..f64f023 100644 --- a/app/Werewolf/Messages.hs +++ b/app/Werewolf/Messages.hs @@ -16,7 +16,8 @@ module Werewolf.Messages ( engineVersionMessage, -- ** Error messages - noGameRunningMessage, gameAlreadyRunningMessage, roleDoesNotExistMessage, playerCannotDoThatMessage, + noGameRunningMessage, gameAlreadyRunningMessage, roleDoesNotExistMessage, + playerCannotDoThatMessage, ) where import Data.Text (Text) @@ -26,7 +27,8 @@ import Data.Version import Game.Werewolf.Response engineVersionMessage :: Text -> Version -> Message -engineVersionMessage to version = privateMessage to $ T.unwords ["Version", T.pack $ showVersion version] +engineVersionMessage to version = + privateMessage to $ T.unwords ["Version", T.pack $ showVersion version] noGameRunningMessage :: Text -> Message noGameRunningMessage to = privateMessage to "No game is running." diff --git a/src/Game/Werewolf/Command.hs b/src/Game/Werewolf/Command.hs index 5ce6ef0..4f5f5fa 100644 --- a/src/Game/Werewolf/Command.hs +++ b/src/Game/Werewolf/Command.hs @@ -39,11 +39,11 @@ import qualified Data.Text as T import Game.Werewolf.Engine import Game.Werewolf.Game hiding (getAllowedVoters, getDevourEvent, getPendingVoters, getPlayerVote, isDefendersTurn, isGameOver, - isScapegoatsTurn, isSeersTurn, isVillagesTurn, + isScapegoatsTurn, isSeersTurn, isVillagesTurn, doesPlayerExist, isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn, killPlayer, setPlayerRole) import Game.Werewolf.Messages -import Game.Werewolf.Player hiding (doesPlayerExist) +import Game.Werewolf.Internal.Player import Game.Werewolf.Response import Game.Werewolf.Role hiding (name) import qualified Game.Werewolf.Role as Role diff --git a/src/Game/Werewolf/Engine.hs b/src/Game/Werewolf/Engine.hs index 9bf21ad..0bec6a6 100644 --- a/src/Game/Werewolf/Engine.hs +++ b/src/Game/Werewolf/Engine.hs @@ -68,14 +68,13 @@ import qualified Data.Text as T import Game.Werewolf.Game hiding (getAllowedVoters, getDevourEvent, getPassers, getPendingVoters, getPlayerVote, getVoteResult, - isDefendersTurn, isGameOver, isScapegoatsTurn, isSeersTurn, + isDefendersTurn, isGameOver, isScapegoatsTurn, isSeersTurn, doesPlayerExist, isVillagesTurn, isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn, killPlayer, setPlayerAllegiance, setPlayerRole) import qualified Game.Werewolf.Game as Game import Game.Werewolf.Messages -import Game.Werewolf.Player hiding (doesPlayerExist) -import qualified Game.Werewolf.Player as Player +import Game.Werewolf.Internal.Player import Game.Werewolf.Response import Game.Werewolf.Role hiding (name) import qualified Game.Werewolf.Role as Role @@ -365,7 +364,7 @@ createPlayers :: MonadIO m => [Text] -> [Role] -> m [Player] createPlayers playerNames extraRoles = zipWith newPlayer playerNames <$> randomiseRoles extraRoles (length playerNames) doesPlayerExist :: MonadState Game m => Text -> m Bool -doesPlayerExist name = uses players $ Player.doesPlayerExist name +doesPlayerExist name = gets $ Game.doesPlayerExist name isPlayerDefender :: MonadState Game m => Text -> m Bool isPlayerDefender name = isDefender <$> findPlayerByName_ name diff --git a/src/Game/Werewolf/Game.hs b/src/Game/Werewolf/Game.hs index a4d04b1..346cd42 100644 --- a/src/Game/Werewolf/Game.hs +++ b/src/Game/Werewolf/Game.hs @@ -22,6 +22,7 @@ module Game.Werewolf.Game ( -- ** Queries isFirstRound, + doesPlayerExist, getPassers, getPlayerVote, getAllowedVoters, getPendingVoters, getVoteResult, -- * Stage @@ -48,7 +49,7 @@ import qualified Data.Map as Map import Data.Maybe import Data.Text (Text) -import Game.Werewolf.Player +import Game.Werewolf.Internal.Player import Game.Werewolf.Role hiding (name) import Prelude hiding (round) @@ -119,6 +120,9 @@ setPlayerAllegiance name' allegiance' game = game & players %~ map (\player -> i isFirstRound :: Game -> Bool isFirstRound game = game ^. round == 0 +doesPlayerExist :: Text -> Game -> Bool +doesPlayerExist name = isJust . findByName name . view players + getPassers :: Game -> [Player] getPassers game = map (`findByName_` players') passes' where diff --git a/src/Game/Werewolf/Player.hs b/src/Game/Werewolf/Internal/Player.hs similarity index 95% rename from src/Game/Werewolf/Player.hs rename to src/Game/Werewolf/Internal/Player.hs index 84309d9..5e9cc95 100644 --- a/src/Game/Werewolf/Player.hs +++ b/src/Game/Werewolf/Internal/Player.hs @@ -1,5 +1,5 @@ {-| -Module : Game.Werewolf.Player +Module : Game.Werewolf.Internal.Player Description : Simplistic player data structure with functions for searching, filtering and querying lists of players. Copyright : (c) Henry J. Wylde, 2016 @@ -14,7 +14,7 @@ attributes. {-# LANGUAGE TemplateHaskell #-} -module Game.Werewolf.Player ( +module Game.Werewolf.Internal.Player ( -- * Player Player, name, role, state, @@ -31,7 +31,6 @@ module Game.Werewolf.Player ( filterAlive, filterDead, -- ** Queries - doesPlayerExist, isAngel, isDefender, isScapegoat, isSeer, isSimpleVillager, isSimpleWerewolf, isVillageIdiot, isVillagerVillager, isWildChild, isWitch, isWolfHound, isVillager, isWerewolf, @@ -110,10 +109,6 @@ filterAlive = filter isAlive filterDead :: [Player] -> [Player] filterDead = filter isDead --- | @doesPlayerExist name = isJust . findByName name@ -doesPlayerExist :: Text -> [Player] -> Bool -doesPlayerExist name = isJust . findByName name - -- | @isAngel player = player ^. role == 'angelRole'@ isAngel :: Player -> Bool isAngel player = player ^. role == angelRole diff --git a/src/Game/Werewolf/Messages.hs b/src/Game/Werewolf/Messages.hs index d97847f..fac8629 100644 --- a/src/Game/Werewolf/Messages.hs +++ b/src/Game/Werewolf/Messages.hs @@ -88,7 +88,7 @@ import Data.Text (Text) import qualified Data.Text as T import Game.Werewolf.Game -import Game.Werewolf.Player +import Game.Werewolf.Internal.Player import Game.Werewolf.Response import Game.Werewolf.Role hiding (name) import qualified Game.Werewolf.Role as Role diff --git a/src/Game/Werewolf/Response.hs b/src/Game/Werewolf/Response.hs index 32319b2..c8a13b0 100644 --- a/src/Game/Werewolf/Response.hs +++ b/src/Game/Werewolf/Response.hs @@ -81,6 +81,10 @@ failure = Response False [] exitWith :: MonadIO m => Response -> m () exitWith response = liftIO $ T.putStrLn (T.decodeUtf8 $ encode response) >> Exit.exitSuccess +-- | A message may be either public or private, indicated by it's @to@ field. +-- +-- Each message contains a single text field. This field is permitted to contain special +-- characters such as new lines and tabs. data Message = Message { to :: Maybe Text -- ^ The message recipient: 'Nothing' for a public message, -- 'Just' for a private message. @@ -105,7 +109,7 @@ publicMessage = Message Nothing privateMessage :: Text -> Text -> Message privateMessage to = Message (Just to) --- | @groupmessages tos message@ +-- | @groupMessages tos message@ -- -- Creates multiple private messages (1 to each recipient) with the given text. groupMessages :: [Text] -> Text -> [Message] diff --git a/test/app/Main.hs b/test/app/Main.hs index c0b2741..0698aec 100644 --- a/test/app/Main.hs +++ b/test/app/Main.hs @@ -15,7 +15,6 @@ module Main ( import Game.Werewolf.Test.Command import Game.Werewolf.Test.Engine import Game.Werewolf.Test.Game -import Game.Werewolf.Test.Player import Test.Tasty @@ -24,4 +23,4 @@ main = defaultMain =<< tests tests :: IO TestTree tests = return . testGroup "Tests" $ concat - [allCommandTests, allEngineTests, allGameTests, allPlayerTests] + [allCommandTests, allEngineTests, allGameTests] diff --git a/test/src/Game/Werewolf/Test/Arbitrary.hs b/test/src/Game/Werewolf/Test/Arbitrary.hs index 109b118..0bac5e0 100644 --- a/test/src/Game/Werewolf/Test/Arbitrary.hs +++ b/test/src/Game/Werewolf/Test/Arbitrary.hs @@ -50,7 +50,7 @@ import qualified Data.Text as T import Game.Werewolf.Command import Game.Werewolf.Engine (checkStage) import Game.Werewolf.Game -import Game.Werewolf.Player +import Game.Werewolf.Internal.Player import Game.Werewolf.Role hiding (name) import Game.Werewolf.Test.Util diff --git a/test/src/Game/Werewolf/Test/Command.hs b/test/src/Game/Werewolf/Test/Command.hs index 825b799..4e72e03 100644 --- a/test/src/Game/Werewolf/Test/Command.hs +++ b/test/src/Game/Werewolf/Test/Command.hs @@ -24,7 +24,7 @@ import qualified Data.Text as T import Game.Werewolf.Command import Game.Werewolf.Engine (checkStage) import Game.Werewolf.Game -import Game.Werewolf.Player +import Game.Werewolf.Internal.Player import Game.Werewolf.Role hiding (name) import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util @@ -158,7 +158,7 @@ prop_chooseAllegianceCommandErrorsWhenCallerDoesNotExist :: GameAtWolfHoundsTurn prop_chooseAllegianceCommandErrorsWhenCallerDoesNotExist (GameAtWolfHoundsTurn game) caller allegiance = do let command = chooseAllegianceCommand (caller ^. name) (T.pack $ show allegiance) - not (doesPlayerExist (caller ^. name) (game ^. players)) + not (doesPlayerExist (caller ^. name) game) ==> verbose_runCommandErrors game command prop_chooseAllegianceCommandErrorsWhenCallerIsDead :: GameAtWolfHoundsTurn -> Allegiance -> Property @@ -213,7 +213,7 @@ prop_choosePlayerCommandErrorsWhenCallerDoesNotExist (GameAtWildChildsTurn game) forAll (arbitraryPlayer game) $ \target -> do let command = choosePlayerCommand (caller ^. name) (target ^. name) - not (doesPlayerExist (caller ^. name) (game ^. players)) + not (doesPlayerExist (caller ^. name) game) ==> verbose_runCommandErrors game command prop_choosePlayerCommandErrorsWhenTargetDoesNotExist :: GameAtWildChildsTurn -> Player -> Property @@ -221,7 +221,7 @@ prop_choosePlayerCommandErrorsWhenTargetDoesNotExist (GameAtWildChildsTurn game) let wildChild = findByRole_ wildChildRole (game ^. players) let command = choosePlayerCommand (wildChild ^. name) (target ^. name) - not (doesPlayerExist (target ^. name) (game ^. players)) + not (doesPlayerExist (target ^. name) game) ==> verbose_runCommandErrors game command prop_choosePlayerCommandErrorsWhenCallerIsDead :: GameAtWildChildsTurn -> Property @@ -283,7 +283,7 @@ prop_choosePlayersCommandErrorsWhenCallerDoesNotExist (GameAtScapegoatsTurn game forAll (NonEmpty <$> sublistOf (filterAlive $ game ^. players)) $ \(NonEmpty targets) -> do let command = choosePlayersCommand (caller ^. name) (map (view name) targets) - not (doesPlayerExist (caller ^. name) (game ^. players)) + not (doesPlayerExist (caller ^. name) game) ==> verbose_runCommandErrors game command prop_choosePlayersCommandErrorsWhenAnyTargetDoesNotExist :: GameAtScapegoatsTurn -> Player -> Property @@ -291,7 +291,7 @@ prop_choosePlayersCommandErrorsWhenAnyTargetDoesNotExist (GameAtScapegoatsTurn g let scapegoat = findByRole_ scapegoatRole (game ^. players) let command = choosePlayersCommand (scapegoat ^. name) [target ^. name] - not (doesPlayerExist (target ^. name) (game ^. players)) + not (doesPlayerExist (target ^. name) game) ==> verbose_runCommandErrors game command prop_choosePlayersCommandErrorsWhenAnyTargetIsDead :: GameAtScapegoatsTurn -> Property @@ -342,7 +342,7 @@ prop_healCommandErrorsWhenGameIsOver (GameAtGameOver game) = do prop_healCommandErrorsWhenCallerDoesNotExist :: GameWithDevourEvent -> Player -> Property prop_healCommandErrorsWhenCallerDoesNotExist (GameWithDevourEvent game) caller = - not (doesPlayerExist (caller ^. name) (game ^. players)) + not (doesPlayerExist (caller ^. name) game) ==> verbose_runCommandErrors game (healCommand (caller ^. name)) prop_healCommandErrorsWhenCallerIsDead :: GameWithDevourEvent -> Property @@ -397,7 +397,7 @@ prop_passCommandErrorsWhenGameIsOver (GameAtGameOver game) = prop_passCommandErrorsWhenCallerDoesNotExist :: GameAtWitchsTurn -> Player -> Property prop_passCommandErrorsWhenCallerDoesNotExist (GameAtWitchsTurn game) caller = - not (doesPlayerExist (caller ^. name) (game ^. players)) + not (doesPlayerExist (caller ^. name) game) ==> verbose_runCommandErrors game (passCommand (caller ^. name)) prop_passCommandErrorsWhenCallerIsDead :: GameAtWitchsTurn -> Property @@ -426,7 +426,7 @@ prop_poisonCommandErrorsWhenGameIsOver (GameAtGameOver game) = prop_poisonCommandErrorsWhenCallerDoesNotExist :: GameAtWitchsTurn -> Player -> Property prop_poisonCommandErrorsWhenCallerDoesNotExist (GameAtWitchsTurn game) caller = - not (doesPlayerExist (caller ^. name) (game ^. players)) + not (doesPlayerExist (caller ^. name) game) ==> forAll (arbitraryPlayer game) $ \target -> do let command = poisonCommand (caller ^. name) (target ^. name) @@ -437,7 +437,7 @@ prop_poisonCommandErrorsWhenTargetDoesNotExist (GameAtWitchsTurn game) target = let witch = findByRole_ witchRole (game ^. players) let command = poisonCommand (witch ^. name) (target ^. name) - not (doesPlayerExist (target ^. name) (game ^. players)) + not (doesPlayerExist (target ^. name) game) ==> verbose_runCommandErrors game command prop_poisonCommandErrorsWhenCallerIsDead :: GameAtWitchsTurn -> Property @@ -507,7 +507,7 @@ prop_protectCommandErrorsWhenGameIsOver (GameAtGameOver game) = prop_protectCommandErrorsWhenCallerDoesNotExist :: GameAtDefendersTurn -> Player -> Property prop_protectCommandErrorsWhenCallerDoesNotExist (GameAtDefendersTurn game) caller = - not (doesPlayerExist (caller ^. name) (game ^. players)) + not (doesPlayerExist (caller ^. name) game) ==> forAll (arbitraryPlayer game) $ \target -> do let command = protectCommand (caller ^. name) (target ^. name) @@ -518,7 +518,7 @@ prop_protectCommandErrorsWhenTargetDoesNotExist (GameAtDefendersTurn game) targe let defender = findByRole_ defenderRole (game ^. players) let command = protectCommand (defender ^. name) (target ^. name) - not (doesPlayerExist (target ^. name) (game ^. players)) + not (doesPlayerExist (target ^. name) game) ==> verbose_runCommandErrors game command prop_protectCommandErrorsWhenCallerIsDead :: GameAtDefendersTurn -> Property @@ -579,7 +579,7 @@ prop_quitCommandErrorsWhenGameIsOver (GameAtGameOver game) = prop_quitCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property prop_quitCommandErrorsWhenCallerDoesNotExist game caller = - not (doesPlayerExist (caller ^. name) (game ^. players)) + not (doesPlayerExist (caller ^. name) game) ==> verbose_runCommandErrors game (quitCommand $ caller ^. name) prop_quitCommandErrorsWhenCallerIsDead :: Game -> Property @@ -674,7 +674,7 @@ prop_seeCommandErrorsWhenGameIsOver (GameAtGameOver game) = prop_seeCommandErrorsWhenCallerDoesNotExist :: GameAtSeersTurn -> Player -> Property prop_seeCommandErrorsWhenCallerDoesNotExist (GameAtSeersTurn game) caller = - not (doesPlayerExist (caller ^. name) (game ^. players)) + not (doesPlayerExist (caller ^. name) game) ==> forAll (arbitraryPlayer game) $ \target -> do let command = seeCommand (caller ^. name) (target ^. name) @@ -685,7 +685,7 @@ prop_seeCommandErrorsWhenTargetDoesNotExist (GameAtSeersTurn game) target = do let seer = findByRole_ seerRole (game ^. players) let command = seeCommand (seer ^. name) (target ^. name) - not (doesPlayerExist (target ^. name) (game ^. players)) + not (doesPlayerExist (target ^. name) game) ==> verbose_runCommandErrors game command prop_seeCommandErrorsWhenCallerIsDead :: GameAtSeersTurn -> Property @@ -732,7 +732,7 @@ prop_voteDevourCommandErrorsWhenGameIsOver (GameAtGameOver game) = prop_voteDevourCommandErrorsWhenCallerDoesNotExist :: GameAtWerewolvesTurn -> Player -> Property prop_voteDevourCommandErrorsWhenCallerDoesNotExist (GameAtWerewolvesTurn game) caller = - not (doesPlayerExist (caller ^. name) (game ^. players)) + not (doesPlayerExist (caller ^. name) game) ==> forAll (arbitraryPlayer game) $ \target -> do let command = voteDevourCommand (caller ^. name) (target ^. name) @@ -740,7 +740,7 @@ prop_voteDevourCommandErrorsWhenCallerDoesNotExist (GameAtWerewolvesTurn game) c prop_voteDevourCommandErrorsWhenTargetDoesNotExist :: GameAtWerewolvesTurn -> Player -> Property prop_voteDevourCommandErrorsWhenTargetDoesNotExist (GameAtWerewolvesTurn game) target = - not (doesPlayerExist (target ^. name) (game ^. players)) + not (doesPlayerExist (target ^. name) game) ==> forAll (arbitraryWerewolf game) $ \caller -> do let command = voteDevourCommand (caller ^. name) (target ^. name) @@ -804,7 +804,7 @@ prop_voteLynchCommandErrorsWhenGameIsOver (GameAtGameOver game) = prop_voteLynchCommandErrorsWhenCallerDoesNotExist :: GameAtVillagesTurn -> Player -> Property prop_voteLynchCommandErrorsWhenCallerDoesNotExist (GameAtVillagesTurn game) caller = - not (doesPlayerExist (caller ^. name) (game ^. players)) + not (doesPlayerExist (caller ^. name) game) ==> forAll (arbitraryPlayer game) $ \target -> do let command = voteLynchCommand (caller ^. name) (target ^. name) @@ -812,7 +812,7 @@ prop_voteLynchCommandErrorsWhenCallerDoesNotExist (GameAtVillagesTurn game) call prop_voteLynchCommandErrorsWhenTargetDoesNotExist :: GameAtVillagesTurn -> Player -> Property prop_voteLynchCommandErrorsWhenTargetDoesNotExist (GameAtVillagesTurn game) target = - not (doesPlayerExist (target ^. name) (game ^. players)) + not (doesPlayerExist (target ^. name) game) ==> forAll (arbitraryPlayer game) $ \caller -> do let command = voteLynchCommand (caller ^. name) (target ^. name) diff --git a/test/src/Game/Werewolf/Test/Engine.hs b/test/src/Game/Werewolf/Test/Engine.hs index 394bb1c..5b0bc3a 100644 --- a/test/src/Game/Werewolf/Test/Engine.hs +++ b/test/src/Game/Werewolf/Test/Engine.hs @@ -30,7 +30,7 @@ import Game.Werewolf.Engine hiding (doesPlayerExist, getDevour isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn, killPlayer) import Game.Werewolf.Game -import Game.Werewolf.Player +import Game.Werewolf.Internal.Player import Game.Werewolf.Role hiding (name) import qualified Game.Werewolf.Role as Role import Game.Werewolf.Test.Arbitrary diff --git a/test/src/Game/Werewolf/Test/Game.hs b/test/src/Game/Werewolf/Test/Game.hs index ba533f1..a1b78eb 100644 --- a/test/src/Game/Werewolf/Test/Game.hs +++ b/test/src/Game/Werewolf/Test/Game.hs @@ -18,7 +18,7 @@ import qualified Data.Map as Map import Data.Maybe import Game.Werewolf.Game -import Game.Werewolf.Player +import Game.Werewolf.Internal.Player import Game.Werewolf.Test.Arbitrary () import Prelude hiding (round) diff --git a/test/src/Game/Werewolf/Test/Player.hs b/test/src/Game/Werewolf/Test/Player.hs deleted file mode 100644 index 693b9d1..0000000 --- a/test/src/Game/Werewolf/Test/Player.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-| -Module : Game.Werewolf.Test.Player -Copyright : (c) Henry J. Wylde, 2016 -License : BSD3 -Maintainer : public@hjwylde.com --} - -{-# OPTIONS_HADDOCK hide, prune #-} - -module Game.Werewolf.Test.Player ( - -- * Tests - allPlayerTests, -) where - -import Control.Lens - -import Data.Text - -import Game.Werewolf.Player -import Game.Werewolf.Role -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 diff --git a/werewolf.cabal b/werewolf.cabal index e3d6aec..a428d8a 100644 --- a/werewolf.cabal +++ b/werewolf.cabal @@ -72,7 +72,7 @@ library Game.Werewolf.Command, Game.Werewolf.Engine, Game.Werewolf.Game, - Game.Werewolf.Player, + Game.Werewolf.Internal.Player, Game.Werewolf.Response, Game.Werewolf.Role other-modules: @@ -111,7 +111,6 @@ test-suite werewolf-test Game.Werewolf.Test.Command Game.Werewolf.Test.Engine Game.Werewolf.Test.Game - Game.Werewolf.Test.Player Game.Werewolf.Test.Util default-language: Haskell2010