werewolf 0.4.12.0 → 0.5.0.0
raw patch · 22 files changed
+141/−127 lines, 22 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−0
- README.md +13/−11
- app/Main.hs +22/−22
- app/Werewolf/Command/Boot.hs +5/−5
- app/Werewolf/Command/Choose.hs +5/−5
- app/Werewolf/Command/Circle.hs +4/−4
- app/Werewolf/Command/End.hs +5/−5
- app/Werewolf/Command/Heal.hs +5/−5
- app/Werewolf/Command/Help.hs +9/−9
- app/Werewolf/Command/Pass.hs +5/−5
- app/Werewolf/Command/Ping.hs +4/−4
- app/Werewolf/Command/Poison.hs +5/−5
- app/Werewolf/Command/Protect.hs +5/−5
- app/Werewolf/Command/Quit.hs +5/−5
- app/Werewolf/Command/Reveal.hs +5/−5
- app/Werewolf/Command/See.hs +5/−5
- app/Werewolf/Command/Start.hs +4/−4
- app/Werewolf/Command/Status.hs +4/−4
- app/Werewolf/Command/Vote.hs +5/−5
- app/Werewolf/Game.hs +14/−13
- app/Werewolf/Options.hs +5/−0
- werewolf.cabal +1/−1
CHANGELOG.md view
@@ -2,6 +2,12 @@ ### Upcoming +### v0.5.0.0++*Major*++* Added required `--tag` option for enabling multiple games at once. ([#29](https://github.com/hjwylde/werewolf/issues/29))+ ### v0.4.12.0 *Minor*
README.md view
@@ -110,7 +110,7 @@ E.g., to start a game: ```bash-> werewolf --caller @foo start --extra-roles seer @bar @baz @qux @quux @corge @grault+> werewolf --caller @foo --tag werewolf start --extra-roles seer @bar @baz @qux @quux @corge @grault {"ok":true,"messages":[ {"to":null,"message":"A new game of werewolf is starting with @foo, @bar, @baz, @qux, @quux, @corge, @grault!"}, {"to":null,"message":"The roles in play are Seer (1), Simple Villager (4), Simple Werewolf (2) for a total balance of -2."},@@ -123,8 +123,10 @@ ``` In this example, user _@foo_ ran the `start` command with the player names as arguments.-Note that the calling user, _@foo_ was passed in to the `--caller` option.-All commands require this option.+Note that the calling user, _@foo_, was passed in to the `--caller` option and a game tag,+ _werewolf_, was passed in to the `--tag` option.+All commands require these options (n.b., the tag option is arbitrary, it just enables multiple+ games of werewolf to be running at once). Any command ran returns a JSON result. The result contains a boolean for whether the command was successful and a list of messages.@@ -134,7 +136,7 @@ It's the Seer's turn now. ```bash-> werewolf --caller @corge see @grault+> werewolf --caller @corge --tag werewolf see @grault {"ok":true,"messages":[ {"to":"@corge","message":"@grault is aligned with the Werewolves."}, {"to":"@quux","message":"You feel restless, like an old curse is keeping you from sleep. It seems you're not the only one... @grault are also emerging from their homes."},@@ -148,11 +150,11 @@ Let's have the Werewolves, _@quux_ and _@grault_, vote to devour a Villager. ```bash-> werewolf --caller @quux vote @foo+> werewolf --caller @quux --tag werewolf vote @foo {"ok":true,"messages":[ {"to":"@grault","message":"@quux voted to devour @foo."} ]}-> werewolf --caller @grault vote @foo+> werewolf --caller @grault --tag werewolf vote @foo {"ok":true,"messages":[ {"to":"@quux","message":"@grault voted to devour @foo."}, {"to":null,"message":"The sun rises. Everybody wakes up and opens their eyes..."},@@ -165,14 +167,14 @@ Too bad for _@foo_. Maybe the village can get some vengeance... ```bash-> werewolf --caller @corge vote @grault+> werewolf --caller @corge --tag werewolf vote @grault {"ok":true,"messages":[]} ``` This time, even though the command was successful, there are no messages. ```bash-> werewolf --caller @corge vote @grault+> werewolf --caller @corge --tag werewolf vote @grault {"ok":false,"messages":[{"to":"@corge","message":"You've already voted!"}]} ``` @@ -182,9 +184,9 @@ Relaying the error message back to the user should suffice. Thus a chat interface must implement the following:-* The ability to call werewolf commands. This includes passing the `--caller` option and arguments- correctly. It is possible to only implement the `interpret` command, which interprets the- caller's input.+* The ability to call werewolf commands. This includes passing the `--caller` and `--tag` options+ and arguments correctly. It is possible to only implement the `interpret` command, which+ interprets the caller's input. * The ability to send resultant messages. Resultant messages may be to everyone or to a specific user.
app/Main.hs view
@@ -46,31 +46,31 @@ run :: [String] -> IO () run args = handleParseResult (execParserPure werewolfPrefs werewolfInfo args) >>= handle -interpret :: Text -> [Text] -> IO ()-interpret callerName args = do- let result = execParserPure werewolfPrefs werewolfInfo (map T.unpack $ "--caller":callerName:args)+interpret :: Text -> Text -> [Text] -> IO ()+interpret callerName tag args = do+ let result = execParserPure werewolfPrefs werewolfInfo (map T.unpack $ "--caller":callerName:"--tag":tag:args) case result of Success options -> handle options- _ -> handle (Options callerName . Help . Help.Options . Just $ Help.Commands False)+ _ -> handle (Options callerName tag . Help . Help.Options . Just $ Help.Commands False) handle :: Options -> IO ()-handle (Options callerName command) = case command of- Choose options -> Choose.handle callerName options- Boot options -> Boot.handle callerName options- Circle options -> Circle.handle callerName options- End options -> End.handle callerName options- Heal -> Heal.handle callerName- Help options -> Help.handle callerName options- Interpret (Interpret.Options args) -> interpret callerName args- Pass -> Pass.handle callerName- Ping -> Ping.handle callerName- Poison options -> Poison.handle callerName options- Protect options -> Protect.handle callerName options- Quit -> Quit.handle callerName- Reveal -> Reveal.handle callerName- See options -> See.handle callerName options- Start options -> Start.handle callerName options- Status -> Status.handle callerName+handle (Options callerName tag command) = case command of+ Choose options -> Choose.handle callerName tag options+ Boot options -> Boot.handle callerName tag options+ Circle options -> Circle.handle callerName tag options+ End options -> End.handle callerName tag options+ Heal -> Heal.handle callerName tag+ Help options -> Help.handle callerName tag options+ Interpret (Interpret.Options args) -> interpret callerName tag args+ Pass -> Pass.handle callerName tag+ Ping -> Ping.handle callerName tag+ Poison options -> Poison.handle callerName tag options+ Protect options -> Protect.handle callerName tag options+ Quit -> Quit.handle callerName tag+ Reveal -> Reveal.handle callerName tag+ See options -> See.handle callerName tag options+ Start options -> Start.handle callerName tag options+ Status -> Status.handle callerName tag Version -> Version.handle callerName- Vote options -> Vote.handle callerName options+ Vote options -> Vote.handle callerName tag options
app/Werewolf/Command/Boot.hs view
@@ -34,16 +34,16 @@ { argTarget :: Text } deriving (Eq, Show) -handle :: MonadIO m => Text -> Options -> m ()-handle callerName (Options targetName) = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> Options -> m ()+handle callerName tag (Options targetName) = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = bootCommand callerName targetName case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages }- Right (game', messages) -> writeGame game' >> exitWith success { messages = messages }+ Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Choose.hs view
@@ -39,13 +39,13 @@ { args :: [Text] } deriving (Eq, Show) -handle :: MonadIO m => Text -> Options -> m ()-handle callerName (Options args) = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> Options -> m ()+handle callerName tag (Options args) = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = case game ^. stage of ScapegoatsTurn -> Scapegoat.chooseCommand callerName args@@ -56,4 +56,4 @@ case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages }- Right (game, messages) -> writeGame game >> exitWith success { messages = messages }+ Right (game, messages) -> writeGame tag game >> exitWith success { messages = messages }
app/Werewolf/Command/Circle.hs view
@@ -34,13 +34,13 @@ { optIncludeDead :: Bool } deriving (Eq, Show) -handle :: MonadIO m => Text -> Options -> m ()-handle callerName (Options includeDead) = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> Options -> m ()+handle callerName tag (Options includeDead) = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = circleCommand callerName includeDead
app/Werewolf/Command/End.hs view
@@ -34,17 +34,17 @@ { optForce :: Bool } deriving (Eq, Show) -handle :: MonadIO m => Text -> Options -> m ()-handle callerName (Options force) = do- unlessM doesGameExist $ exitWith failure { messages = [noGameRunningMessage callerName] }+handle :: MonadIO m => Text -> Text -> Options -> m ()+handle callerName tag (Options force) = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } unless force $ do- game <- readGame+ game <- readGame tag unless (doesPlayerExist callerName game) $ exitWith failure { messages = [playerCannotDoThatMessage callerName] } - deleteGame+ deleteGame tag exitWith success { messages = [gameEndedMessage] } where
app/Werewolf/Command/Heal.hs view
@@ -29,16 +29,16 @@ import Werewolf.Game import Werewolf.Messages -handle :: MonadIO m => Text -> m ()-handle callerName = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> m ()+handle callerName tag = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = healCommand callerName case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages }- Right (game', messages) -> writeGame game' >> exitWith success { messages = messages }+ Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Help.hs view
@@ -45,28 +45,28 @@ { optAll :: Bool } deriving (Eq, Show) -handle :: MonadIO m => Text -> Options -> m ()-handle callerName (Options (Just (Commands optAll))) = do- mGame <- ifM (doesGameExist &&^ return (not optAll)) (Just <$> readGame) (return Nothing)+handle :: MonadIO m => Text -> Text -> Options -> m ()+handle callerName tag (Options (Just (Commands optAll))) = do+ mGame <- ifM (doesGameExist tag &&^ return (not optAll)) (Just <$> readGame tag) (return Nothing) exitWith success { messages = map (privateMessage callerName) (commandsMessages callerName mGame) }-handle callerName (Options (Just (Roles optAll))) = do- roles <- (sortBy (compare `on` view Role.name) . nub) <$> ifM (doesGameExist &&^ return (not optAll))- (toListOf (players . roles) <$> readGame)+handle callerName tag (Options (Just (Roles optAll))) = do+ roles <- (sortBy (compare `on` view Role.name) . nub) <$> ifM (doesGameExist tag &&^ return (not optAll))+ (toListOf (players . roles) <$> readGame tag) (return allRoles) exitWith success { messages = map (privateMessage callerName . roleMessage) roles }-handle callerName (Options (Just (Rules optAll))) = do- mGame <- ifM (doesGameExist &&^ return (not optAll)) (Just <$> readGame) (return Nothing)+handle callerName tag (Options (Just (Rules optAll))) = do+ mGame <- ifM (doesGameExist tag &&^ return (not optAll)) (Just <$> readGame tag) (return Nothing) exitWith success { messages = map (privateMessage callerName) (rulesMessages mGame) }-handle callerName (Options Nothing) = exitWith success+handle callerName _ (Options Nothing) = exitWith success { messages = map (privateMessage callerName) helpMessages }
app/Werewolf/Command/Pass.hs view
@@ -29,13 +29,13 @@ import Werewolf.Game import Werewolf.Messages -handle :: MonadIO m => Text -> m ()-handle callerName = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> m ()+handle callerName tag = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = case game ^. stage of DevotedServantsTurn -> DevotedServant.passCommand callerName@@ -45,4 +45,4 @@ case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages }- Right (game', messages) -> writeGame game' >> exitWith success { messages = messages }+ Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Ping.hs view
@@ -27,13 +27,13 @@ import Werewolf.Game import Werewolf.Messages -handle :: MonadIO m => Text -> m ()-handle callerName = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> m ()+handle callerName tag = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = pingCommand callerName
app/Werewolf/Command/Poison.hs view
@@ -34,16 +34,16 @@ { argTarget :: Text } deriving (Eq, Show) -handle :: MonadIO m => Text -> Options -> m ()-handle callerName (Options targetName) = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> Options -> m ()+handle callerName tag (Options targetName) = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = poisonCommand callerName targetName case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages }- Right (game', messages) -> writeGame game' >> exitWith success { messages = messages }+ Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Protect.hs view
@@ -34,16 +34,16 @@ { argTarget :: Text } deriving (Eq, Show) -handle :: MonadIO m => Text -> Options -> m ()-handle callerName (Options targetName) = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> Options -> m ()+handle callerName tag (Options targetName) = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = protectCommand callerName targetName case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages }- Right (game', messages) -> writeGame game' >> exitWith success { messages = messages }+ Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Quit.hs view
@@ -27,16 +27,16 @@ import Werewolf.Game import Werewolf.Messages -handle :: MonadIO m => Text -> m ()-handle callerName = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> m ()+handle callerName tag = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = quitCommand callerName case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages }- Right (game', messages) -> writeGame game' >> exitWith success { messages = messages }+ Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Reveal.hs view
@@ -29,16 +29,16 @@ import Werewolf.Game import Werewolf.Messages -handle :: MonadIO m => Text -> m ()-handle callerName = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> m ()+handle callerName tag = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = revealCommand callerName case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages }- Right (game', messages) -> writeGame game' >> exitWith success { messages = messages }+ Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/See.hs view
@@ -34,16 +34,16 @@ { argTarget :: Text } deriving (Eq, Show) -handle :: MonadIO m => Text -> Options -> m ()-handle callerName (Options targetName) = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> Options -> m ()+handle callerName tag (Options targetName) = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = seeCommand callerName targetName case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages }- Right (game', messages) -> writeGame game' >> exitWith success { messages = messages }+ Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Command/Start.hs view
@@ -47,9 +47,9 @@ data ExtraRoles = None | Random | Use [Text] deriving (Eq, Show) -handle :: MonadIO m => Text -> Options -> m ()-handle callerName (Options extraRoles playerNames) = do- whenM (doesGameExist &&^ (hasn't (stage . _GameOver) <$> readGame)) $ exitWith failure+handle :: MonadIO m => Text -> Text -> Options -> m ()+handle callerName tag (Options extraRoles playerNames) = do+ whenM (doesGameExist tag &&^ (hasn't (stage . _GameOver) <$> readGame tag)) $ exitWith failure { messages = [gameAlreadyRunningMessage callerName] } @@ -65,7 +65,7 @@ case result of Left errorMessages -> exitWith failure { messages = errorMessages }- Right (game, messages) -> writeGame game >> exitWith success { messages = messages }+ Right (game, messages) -> writeGame tag game >> exitWith success { messages = messages } randomExtraRoles :: MonadIO m => Int -> m [Role] randomExtraRoles n = liftIO . evalRandIO $ do
app/Werewolf/Command/Status.hs view
@@ -27,13 +27,13 @@ import Werewolf.Game import Werewolf.Messages -handle :: MonadIO m => Text -> m ()-handle callerName = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> m ()+handle callerName tag = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = statusCommand callerName
app/Werewolf/Command/Vote.hs view
@@ -36,13 +36,13 @@ { argTarget :: Text } deriving (Eq, Show) -handle :: MonadIO m => Text -> Options -> m ()-handle callerName (Options targetName) = do- unlessM doesGameExist $ exitWith failure+handle :: MonadIO m => Text -> Text -> Options -> m ()+handle callerName tag (Options targetName) = do+ unlessM (doesGameExist tag) $ exitWith failure { messages = [noGameRunningMessage callerName] } - game <- readGame+ game <- readGame tag let command = case game ^. stage of VillagesTurn -> Villager.voteCommand callerName targetName@@ -52,4 +52,4 @@ case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages }- Right (game', messages) -> writeGame game' >> exitWith success { messages = messages }+ Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages }
app/Werewolf/Game.hs view
@@ -17,7 +17,7 @@ startGame, createPlayers, padRoles, -- ** Working with an existing- defaultFilePath, readGame, writeGame, deleteGame, doesGameExist,+ filePath, readGame, writeGame, deleteGame, doesGameExist, ) where import Control.Lens hiding (cons)@@ -26,6 +26,7 @@ import Data.List.Extra import Data.Text (Text)+import qualified Data.Text as T import Game.Werewolf @@ -55,20 +56,20 @@ simpleVillagerRoles = replicate simpleVillagersCount simpleVillagerRole simpleWerewolfRoles = replicate simpleWerewolvesCount simpleWerewolfRole -defaultFilePath :: MonadIO m => m FilePath-defaultFilePath = (</> defaultFileName) <$> liftIO getHomeDirectory+filePath :: MonadIO m => Text -> m FilePath+filePath tag = (</> ".werewolf" </> T.unpack tag) <$> liftIO getHomeDirectory -defaultFileName :: FilePath-defaultFileName = ".werewolf"+readGame :: MonadIO m => Text -> m Game+readGame tag = liftIO . fmap read $ filePath tag >>= readFile -readGame :: MonadIO m => m Game-readGame = liftIO . fmap read $ defaultFilePath >>= readFile+writeGame :: MonadIO m => Text -> Game -> m ()+writeGame tag game = liftIO $ filePath tag >>= \tag -> do+ createDirectoryIfMissing True (dropFileName tag) -writeGame :: MonadIO m => Game -> m ()-writeGame game = liftIO $ defaultFilePath >>= flip writeFile (show game)+ writeFile tag (show game) -deleteGame :: MonadIO m => m ()-deleteGame = liftIO $ defaultFilePath >>= removeFile+deleteGame :: MonadIO m => Text -> m ()+deleteGame tag = liftIO $ filePath tag >>= removeFile -doesGameExist :: MonadIO m => m Bool-doesGameExist = liftIO $ defaultFilePath >>= doesFileExist+doesGameExist :: MonadIO m => Text -> m Bool+doesGameExist tag = liftIO $ filePath tag >>= doesFileExist
app/Werewolf/Options.hs view
@@ -40,6 +40,7 @@ data Options = Options { optCaller :: Text+ , optTag :: Text , argCommand :: Command } deriving (Eq, Show) @@ -89,6 +90,10 @@ <$> fmap T.pack (strOption $ mconcat [ long "caller", metavar "PLAYER" , help "Specify the calling player's name"+ ])+ <*> fmap T.pack (strOption $ mconcat+ [ long "tag", metavar "TAG"+ , help "Specify the game tag (for running multiple games at once)" ]) <*> subparser (mconcat [ command "boot" $ info (helper <*> boot) (fullDesc <> progDesc "Vote to boot a player")
werewolf.cabal view
@@ -1,5 +1,5 @@ name: werewolf-version: 0.4.12.0+version: 0.5.0.0 author: Henry J. Wylde maintainer: public@hjwylde.com