packages feed

werewolf (empty) → 0.1.0.0

raw patch · 23 files changed

+1562/−0 lines, 23 filesdep +HUnitdep +MonadRandomdep +QuickChecksetup-changed

Dependencies added: HUnit, MonadRandom, QuickCheck, aeson, base, bytestring, containers, directory, extra, filepath, lens, mtl, optparse-applicative, random-shuffle, tasty, tasty-hunit, tasty-quickcheck, text, transformers, werewolf

Files

+ CHANGELOG.md view
@@ -0,0 +1,9 @@+## Changelog++#### Upcoming++#### v0.1.0.0++*Major*++* Initial implementation with villagers and werewolves.
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2015, Henry J. Wylde+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++* The name of werewolf's contributors may be used to endorse or promote+  products derived from this software without specific prior written+  permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,112 @@+# werewolf++[![Project Status: Wip - Initial development is in progress, but there has not yet been a stable, usable release suitable for the public.](http://www.repostatus.org/badges/1.0.0/wip.svg)](http://www.repostatus.org/#wip)+[![Build Status](https://travis-ci.org/hjwylde/werewolf.svg?branch=master)](https://travis-ci.org/hjwylde/werewolf)+[![Release](https://img.shields.io/github/release/hjwylde/werewolf.svg)](https://github.com/hjwylde/werewolf/releases/latest)++A game engine for running werewolf in a chat client.+This engine is based off of [Werewolves of Millers Hollow](http://www.games-wiki.org/wiki/Werewolves_of_Millers_Hollow/).++### Game description++Deep in the American countryside, the little town of Millers Hollow has recently been infiltrated by werewolves.+Each night, murders are committed by the villagers, who due to some mysterious phenomenon (possibly the greenhouse effect) have become werewolves.+It is now time to take control and eliminate this ancient evil, before the town loses its last few inhabitants.++Objective of the Game:  +For the villagers: kill all of the werewolves.  +For the werewolves: kill all of the villagers.++#### Roles++The current implemented roles are:+* Villager.+* Werewolf.++### Installing++Installing werewolf is easiest done using either+    [stack](https://github.com/commercialhaskell/stack) (recommended) or+    [Cabal](https://github.com/haskell/cabal).++**Using stack:**++```bash+stack install werewolf+export PATH=$PATH:~/.local/bin+```++**Using Cabal:**++```bash+cabal-install werewolf+export PATH=$PATH:~/.cabal/bin+```++### Usage++This section covers how a chat client interacts with the werewolf game engine.++All werewolf commands are designed to be run by a user from the chat client.+E.g., to start a game:+```bash+> werewolf --caller @foo start @foo @bar @baz @qux @quux @corge @grault+{"ok":true,"messages":[{"to":null,"message":"Night falls, the town is asleep. The werewolves wake+up, recognise one another and choose a new victim."},{"to":["@foo"],"message":"You slip away+silently from your home."},{"to":["@bar"],"message":"ZzzZZzzz, you're sound asleep."},...]}+```++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.++Any command ran returns a JSON result.+The result contains a boolean for whether the command was successful and a list of messages.+The `to` header on a message may either be `null` for a public message or have a list of intended+    recipients.++Let's have _@foo_, a werewolf, vote to kill a villager.+```bash+> werewolf --caller @foo vote @bar+{"ok":true,"messages":[]}+```++This time, even though the command was successful, there are no messages.+In this implementation of werewolf votes are only revealed once tallied.++```bash+> werewolf --caller @foo vote @bar+{"ok":false,"messages":[{"to":["@foo"],"message":"You've already voted!"}]}+```++Here the command was unsuccessful and an error message is sent to _@foo_.+Note that even though the command was unsuccessful, the chat client interface probably won't need to+    do anything special.+Relaying the error message back to the user should suffice.++```bash+> werewolf --caller @qux vote @bar+{"ok":true,"messages":[{"to":["@foo","@baz"],"message":"@baz voted to kill+@bar."},{"to":["@foo","@baz"],"message":"@foo voted to kill @bar."},{"to":null,"message":"The sun+rises. Everybody wakes up and opens their eyes..."},{"to":null,"message":"As you open them you+notice a door broken down and @bar's guts spilling out over the cobblestones. From the look of their+personal effects, you deduce they were a Villager."}]}+```++And so on.++Thus a chat client interface must implement the following:+* The ability to call werewolf commands. This includes passing the `--caller` option and arguments+  correctly. Note that it is possible to just implement the `interpret` command, which interprets+  the caller's input.+* The ability to send resultant messages. Resultant messages may be to everyone or to specific+  users.++#### Commands++See `werewolf --help`.++#### Chat clients++**Coming soon:**+* Slack
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,34 @@+{-|+Module      : Main++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com+-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide, prune #-}++module Main (+    main,+) where++import Options.Applicative++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.Start     as Start+import qualified Werewolf.Commands.Vote      as Vote+import           Werewolf.Options++main :: IO ()+main = customExecParser werewolfPrefs werewolfInfo >>= handle++handle :: Options -> IO ()+handle (Options caller command) = case command of+    End                 -> End.handle caller+    Help options        -> Help.handle caller options+    Interpret options   -> Interpret.handle caller options+    Start options       -> Start.handle caller options+    Vote options        -> Vote.handle caller options
+ app/Werewolf/Commands/End.hs view
@@ -0,0 +1,37 @@+{-|+Module      : Werewolf.Commands.End+Description : Handler for the end subcommand.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Handler for the end subcommand.+-}++{-# LANGUAGE OverloadedStrings #-}++module Werewolf.Commands.End (+    -- * Handle+    handle,+) where++import Control.Monad.Extra+import Control.Monad.IO.Class++import           Data.Text (Text)+import qualified Data.Text as T++import Game.Werewolf.Engine+import Game.Werewolf.Response++-- | Handle.+handle :: MonadIO m => Text -> m ()+handle callerName = do+    unlessM doesGameExist $ exitWith failure { messages = [privateMessage [callerName] "No game is running."] }++    deleteGame++    exitWith success { messages = [gameEndedMessage] }+    where+        gameEndedMessage = publicMessage $ T.concat ["Game ended by ", callerName, "."]
+ app/Werewolf/Commands/Help.hs view
@@ -0,0 +1,99 @@+{-|+Module      : Werewolf.Commands.Help+Description : Options and handler for the help subcommand.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Options and handler for the help subcommand.+-}++{-# LANGUAGE OverloadedStrings #-}++module Werewolf.Commands.Help (+    -- * Options+    Options(..), Command(..),++    -- * Handle+    handle,+) where++import Control.Lens+import Control.Monad.IO.Class++import           Data.List+import           Data.Text (Text)+import qualified Data.Text as T++import Game.Werewolf.Response+import Game.Werewolf.Role     as Role++-- | Options.+data Options = Options+    { argCommand :: Maybe Command+    } deriving (Eq, Show)++-- | Command.+data Command = Commands | Description | Rules | Roles+    deriving (Eq, Show)++-- | Handle.+handle :: MonadIO m => Text -> Options -> m ()+handle callerName (Options (Just Commands)) = exitWith success { messages = map (privateMessage [callerName]) [+    "Usage: COMMAND ARG ...",+    "",+    "Available commands:",+    "  end - end the current game",+    "  help - help documents",+    "  start - start a new game",+    "  vote - vote against a player",+    "",+    "End:",+    "Usage: end",+    "  Ends the current game.",+    "",+    "Start:",+    "Usage: start PLAYER ...",+    "  Starts a new game with the given players. A game requires at least 7 players.",+    "",+    "Vote:",+    "Usage: vote PLAYER",+    "  Vote against a player. A townsperson may vote at daytime to lynch someone and a werewolf may vote at nighttime to kill a villager."+    ] }+handle callerName (Options (Just Description)) = exitWith success { messages = map (privateMessage [callerName]) [+    "Deep in the American countryside, the little town of Millers Hollow has recently been infiltrated by werewolves.",+    "Each night, murders are committed by the villagers, who due to some mysterious phenomenon (possibly the greenhouse effect) have become werewolves.",+    "It is now time to take control and eliminate this ancient evil, before the town loses its last few inhabitants.",+    "",+    "Objective of the Game:",+    "For the villagers: kill all of the werewolves.",+    "For the werewolves: kill all of the villagers."+    ] }+handle callerName (Options (Just Roles)) = exitWith success { messages = map (privateMessage [callerName])+    $ intercalate [""] $ map (\role -> [+        T.snoc (role ^. Role.name) ':',+        role ^. description,+        role ^. advice+        ]) allRoles+    }+handle callerName (Options (Just Rules)) = exitWith success { messages = map (privateMessage [callerName]) [+    "Each night, the werewolves bite, kill and devour one villager. During the day they try to conceal their identity and vile deeds from the villagers. Depending upon the number of players and variants used in the game, there are 1, 2, 3 or 4 werewolves in play.",+    "Each day, the survivors gather in the town square and try to discover who the werewolves are. This is done by studying the other player's social behaviours for hidden signs of lycanthropy. After discussing and debating, the villagers vote to lynch a suspect, who is then hanged, burned and eliminated from the game.",+    "",+    "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.",+    "1. The town falls asleep.",+    "2. The werewolves wake up and select a victim.",+    "3. The town wakes up and find the victim.",+    "4. The town vote to lynch a suspect.",+    "The game is over when a single townsperson is left alive."+    ] }+handle callerName (Options Nothing) = exitWith success { messages = map (privateMessage [callerName]) [+    "Usage: help COMMAND",+    "",+    "Available commands:",+    "  commands - print the in-game commands",+    "  description - print the game description",+    "  rules - print the game rules",+    "  roles - print the roles and their description"+    ] }
+ app/Werewolf/Commands/Interpret.hs view
@@ -0,0 +1,48 @@+{-|+Module      : Werewolf.Commands.Interpret+Description : Options and handler for the interpret subcommand.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Options and handler for the interpret subcommand.+-}++{-# LANGUAGE OverloadedStrings #-}++module Werewolf.Commands.Interpret (+    -- * Options+    Options(..),++    -- * Handle+    handle,+) where++import Control.Monad.Except++import Data.Text (Text)++import qualified Werewolf.Commands.End   as End+import qualified Werewolf.Commands.Help  as Help+import qualified Werewolf.Commands.Start as Start+import qualified Werewolf.Commands.Vote  as Vote++-- | Options.+data Options = Options+    { args :: [Text]+    } deriving (Eq, Show)++-- | Handle.+handle :: MonadIO m => Text -> Options -> m ()+handle callerName (Options args) = interpret callerName args++interpret :: MonadIO m => Text -> [Text] -> m ()+interpret callerName ["end"]                    = End.handle callerName+interpret callerName ["help"]                   = Help.handle callerName (Help.Options Nothing)+interpret callerName ("help":["description"])   = Help.handle callerName (Help.Options $ Just Help.Description)+interpret callerName ("help":["rules"])         = Help.handle callerName (Help.Options $ Just Help.Rules)+interpret callerName ("help":["roles"])         = Help.handle callerName (Help.Options $ Just Help.Roles)+interpret callerName ("start":playerNames)      = Start.handle callerName (Start.Options playerNames)+interpret callerName ("vote":[targetName])      = Vote.handle callerName (Vote.Options targetName)+interpret callerName _                          = Help.handle callerName (Help.Options $ Just Help.Commands)
+ app/Werewolf/Commands/Start.hs view
@@ -0,0 +1,44 @@+{-|+Module      : Werewolf.Commands.Start+Description : Options and handler for the start subcommand.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Options and handler for the start subcommand.+-}++{-# LANGUAGE OverloadedStrings #-}++module Werewolf.Commands.Start (+    -- * Options+    Options(..),++    -- * Handle+    handle,+) where++import Control.Monad.Except+import Control.Monad.Extra++import Data.Text (Text)++import Game.Werewolf.Engine+import Game.Werewolf.Response++-- | Options.+data Options = Options+    { argPlayers :: [Text]+    } deriving (Eq, Show)++-- | Handle.+handle :: MonadIO m => Text -> Options -> m ()+handle callerName (Options playerNames) = do+    whenM doesGameExist $ exitWith failure { messages = [privateMessage [callerName] "A game is already running."] }++    players <- createPlayers playerNames++    case runExcept (startGame callerName players) of+        Left errorMessages  -> exitWith failure { messages = errorMessages }+        Right game          -> writeGame game >> exitWith success { messages = newGameMessages players }
+ app/Werewolf/Commands/Vote.hs view
@@ -0,0 +1,59 @@+{-|+Module      : Werewolf.Commands.Vote+Description : Options and handler for the vote subcommand.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Options and handler for the vote subcommand.+-}++{-# LANGUAGE OverloadedStrings #-}++module Werewolf.Commands.Vote (+    -- * Options+    Options(..),++    -- * Handle+    handle,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.State+import Control.Monad.Writer++import Data.Maybe+import Data.Text  (Text)++import Game.Werewolf.Command+import Game.Werewolf.Engine+import Game.Werewolf.Game+import Game.Werewolf.Player   as Player+import Game.Werewolf.Response++-- | Options.+data Options = Options+    { argTarget :: Text+    } deriving (Eq, Show)++-- | Handle.+handle :: MonadIO m => Text -> Options -> m ()+handle callerName (Options targetName) = do+    unlessM doesGameExist $ exitWith failure { messages = [privateMessage [callerName] "No game is running."] }++    game <- readGame++    let mCaller = findByName callerName (game ^. players)+    let mTarget = findByName targetName (game ^. players)++    when (isNothing mCaller) $ exitWith failure { messages = [playerDoesNotExistMessage callerName callerName] }+    when (isNothing mTarget) $ exitWith failure { messages = [playerDoesNotExistMessage callerName targetName] }++    let command = Vote { voter = fromJust mCaller, target = fromJust mTarget }++    case runExcept (runWriterT $ execStateT (validateCommand command >> applyCommand command >> checkGameOver) game) of+        Left errorMessages      -> exitWith failure { messages = errorMessages }+        Right (game', messages) -> writeGame game' >> exitWith success { messages = messages }
+ app/Werewolf/Options.hs view
@@ -0,0 +1,99 @@+{-|+Module      : Werewolf.Options+Description : Optparse utilities.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Optparse utilities.+-}++module Werewolf.Options (+    -- * Options+    Options(..), Command(..),++    -- * Optparse+    werewolfPrefs, werewolfInfo, werewolf,+) where++import           Data.Text    (Text)+import qualified Data.Text    as T+import           Data.Version (showVersion)++import qualified Werewolf.Commands.Help      as Help+import qualified Werewolf.Commands.Interpret as Interpret+import qualified Werewolf.Commands.Start     as Start+import qualified Werewolf.Commands.Vote      as Vote+import           Werewolf.Version            as This++import Options.Applicative++-- | Options.+data Options = Options+    { optCaller  :: Text+    , argCommand :: Command+    } deriving (Eq, Show)++-- | Command.+data Command+    = End+    | Help Help.Options+    | Interpret Interpret.Options+    | Start Start.Options+    | Vote Vote.Options+    deriving (Eq, Show)++-- | The default preferences.+--   Limits the help output to 100 columns.+werewolfPrefs :: ParserPrefs+werewolfPrefs = prefs $ columns 100++-- | An optparse parser of a werewolf command.+werewolfInfo :: ParserInfo Options+werewolfInfo = info (infoOptions <*> werewolf) (fullDesc <> header' <> progDesc')+    where+        infoOptions = helper <*> version+        version     = infoOption ("Version " ++ showVersion This.version) $ mconcat [+            long "version", short 'V', hidden,+            help "Show this binary's version"+            ]++        header'     = header "A game engine for running werewolf in a chat client."+        progDesc'   = progDesc "This engine is based off of Werewolves of Millers Hollow (http://www.games-wiki.org/wiki/Werewolves_of_Millers_Hollow/). See https://github.com/hjwylde/werewolf for help on writing chat interfaces."++-- | An options parser.+werewolf :: Parser Options+werewolf = Options+    <$> fmap T.pack (strOption $ mconcat [+        long "caller", metavar "PLAYER",+        help "Specify the calling player's name"+        ])+    <*> subparser (mconcat [+        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"),+        command "start"     $ info (helper <*> start)       (fullDesc <> progDesc "Start a new game"),+        command "vote"      $ info (helper <*> vote)        (fullDesc <> progDesc "Vote against a player")+        ])++end :: Parser Command+end = pure End++help_ :: Parser Command+help_ = Help . Help.Options+    <$> optional (subparser $ mconcat [+        command "commands"      $ info (pure Help.Commands)     (fullDesc <> progDesc "Print the in-game commands"),+        command "description"   $ info (pure Help.Description)  (fullDesc <> progDesc "Print the game description"),+        command "rules"         $ info (pure Help.Rules)        (fullDesc <> progDesc "Print the game rules"),+        command "roles"         $ info (pure Help.Roles)        (fullDesc <> progDesc "Print the roles and their descriptions")+        ])++interpret :: Parser Command+interpret = Interpret . Interpret.Options <$> many (T.pack <$> strArgument (metavar "COMMAND ARG..."))++start :: Parser Command+start = Start . Start.Options <$> many (T.pack <$> strArgument (metavar "PLAYER..."))++vote :: Parser Command+vote = Vote . Vote.Options . T.pack <$> strArgument (metavar "PLAYER")
+ app/Werewolf/Version.hs view
@@ -0,0 +1,18 @@+{-|+Module      : Werewolf.Version+Description : Haskell constant of the binary version.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Haskell constant of the binary version.+-}++module Werewolf.Version (+    -- * Version+    -- | The binary version.+    version,+) where++import Paths_werewolf (version)
+ src/Game/Werewolf/Command.hs view
@@ -0,0 +1,26 @@+{-|+Module      : Game.Werewolf.Command+Description : Command data structures.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Command data structures.+-}++{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}++module Game.Werewolf.Command (+    -- * Command+    Command(..),+) where++import Game.Werewolf.Player++data Command = Vote+    { voter  :: Player+    , target :: Player+    } deriving (Eq, Show)
+ src/Game/Werewolf/Engine.hs view
@@ -0,0 +1,191 @@+{-|+Module      : Game.Werewolf.Engine+Description : Engine functions.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Engine functions.+-}++{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}++module Game.Werewolf.Engine (+    -- * Command+    validateCommand, applyCommand, checkGameOver,++    -- * Game++    -- ** Manipulating+    startGame, isGameOver, getPlayerVote,++    -- ** Reading and writing+    defaultFilePath, writeGame, readGame, deleteGame, doesGameExist,++    -- * Player+    createPlayers, doesPlayerExist,++    -- * Role+    randomiseRoles,+) where++import Control.Lens hiding (only)+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.Random+import Control.Monad.Writer+import Control.Monad.State hiding (state)++import           Data.Aeson hiding ((.=))+import           Data.List.Extra+import qualified Data.Map as Map+import qualified Data.ByteString.Lazy as BS+import           Data.Text            (Text)++import Game.Werewolf.Game hiding (isGameOver)+import qualified Game.Werewolf.Game as Game+import Game.Werewolf.Command+import qualified Game.Werewolf.Player   as Player+import Game.Werewolf.Player   hiding (doesPlayerExist)+import Game.Werewolf.Response+import Game.Werewolf.Role     as Role++import System.Directory+import System.Exit+import System.FilePath+import System.Random.Shuffle++validateCommand :: MonadError [Message] m => MonadState Game m => Command -> m ()+validateCommand (Vote voter target) = do+    whenM isGameOver                        $ throwError [gameIsOverMessage voterName]+    unlessM (doesPlayerExist voterName)     $ throwError [playerDoesNotExistMessage voterName voterName]+    unlessM (doesPlayerExist targetName)    $ throwError [playerDoesNotExistMessage voterName targetName]++    when (isDead voter)     $ throwError [playerIsDeadMessage voterName]+    when (isDead target)    $ throwError [targetIsDeadMessage voterName targetName]++    whenJustM (getPlayerVote voter) $ const (throwError [playerHasAlreadyVotedMessage voterName])++    get >>= \game -> when (isWerewolvesTurn game && not (isWerewolf voter)) $ throwError [playerCannotDoThatMessage voterName]+    where+        voterName = voter ^. Player.name+        targetName = target ^. Player.name++applyCommand :: (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => Command -> m ()+applyCommand (Vote voter target) = do+    turn . votes %= Map.insert voterName targetName++    use turn >>= \turn' -> case turn' of+        Villagers {}    -> applyLynchVote+        Werewolves {}   -> applyKillVote+        NoOne           -> throwError [gameIsOverMessage voterName]+    where+        voterName   = voter ^. Player.name+        targetName  = target ^. Player.name++applyKillVote :: (MonadState Game m, MonadWriter [Message] m) => m ()+applyKillVote = do+    werewolvesCount <- uses players (length . filterAlive . filterWerewolves)+    votes           <- use $ turn . votes++    when (werewolvesCount == Map.size votes) $ do+        werewolfNames <- uses players (map Player._name . filterWerewolves)+        tell $ map (uncurry $ playerMadeKillVoteMessage werewolfNames) (Map.toList votes)++        turn .= newVillagersTurn+        tell villagersTurnMessages++        let mTargetName = only . last $ groupSortOn (length . flip elemIndices (Map.elems votes)) (nub $ Map.elems votes)+        case mTargetName of+            Nothing         -> tell [noPlayerKilledMessage]+            Just targetName -> do+                target <- uses players (findByName_ targetName)++                killPlayer target+                tell [playerKilledMessage (target ^. Player.name) (target ^. Player.role . Role.name)]++applyLynchVote :: (MonadState Game m, MonadWriter [Message] m) => m ()+applyLynchVote = do+    playersCount    <- uses players (length . filterAlive)+    votes           <- use $ turn . votes++    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             -> tell [noPlayerLynchedMessage]+            Just lynchedName    -> do+                target <- uses players (findByName_ lynchedName)++                killPlayer target+                tell [playerLynchedMessage (target ^. Player.name) (target ^. Player.role . Role.name)]++        turn .= newWerewolvesTurn+        tell werewolvesTurnMessages++only :: [a] -> Maybe a+only [a]    = Just a+only _      = Nothing++checkGameOver :: (MonadState Game m, MonadWriter [Message] m) => m ()+checkGameOver = do+    alivePlayers <- uses players filterAlive++    case length alivePlayers of+        0 -> turn .= NoOne >> tell [gameOverMessage Nothing]+        1 -> turn .= NoOne >> tell [gameOverMessage . Just $ head alivePlayers ^. Player.role . Role.name]+        _ -> return ()++startGame :: MonadError [Message] m => Text -> [Player] -> m Game+startGame callerName players = do+    when (playerNames /= nub playerNames)   $ throwError [privateMessage [callerName] "Player names must be unique."]+    when (length players < 7)               $ throwError [privateMessage [callerName] "Must have at least 7 players."]+    when (length players > 24)              $ throwError [privateMessage [callerName] "Cannot have more than 24 players."]++    return $ newGame players+    where+        playerNames = map Player._name players++isGameOver :: MonadState Game m => m Bool+isGameOver = gets Game.isGameOver++getPlayerVote :: MonadState Game m => Player -> m (Maybe Text)+getPlayerVote player = use $ turn . votes . at (player ^. Player.name)++defaultFilePath :: MonadIO m => m FilePath+defaultFilePath = (</> defaultFileName) <$> liftIO getHomeDirectory++defaultFileName :: FilePath+defaultFileName = ".werewolf"++readGame :: MonadIO m => m Game+readGame = liftIO $ defaultFilePath >>= BS.readFile >>= either die return . eitherDecode++writeGame :: MonadIO m => Game -> m ()+writeGame game = defaultFilePath >>= liftIO . flip BS.writeFile (encode game)++deleteGame :: MonadIO m => m ()+deleteGame = liftIO $ defaultFilePath >>= removeFile++doesGameExist :: MonadIO m => m Bool+doesGameExist = liftIO $ defaultFilePath >>= doesFileExist++createPlayers :: MonadIO m => [Text] -> m [Player]+createPlayers playerNames = zipWith newPlayer playerNames <$> randomiseRoles (length playerNames)++doesPlayerExist :: MonadState Game m => Text -> m Bool+doesPlayerExist name = uses players $ Player.doesPlayerExist name++killPlayer :: MonadState Game m => Player -> m ()+killPlayer player = players %= map (\player' -> if player' == player then player' & state .~ Dead else player')++randomiseRoles :: MonadIO m => Int -> m [Role]+randomiseRoles n = liftIO . evalRandIO . shuffleM $ werewolfRoles ++ villagerRoles+    where+        werewolfRoles = replicate (n `quot` 6 + 1) werewolf+        villagerRoles = replicate (n - length werewolfRoles) villager
+ src/Game/Werewolf/Game.hs view
@@ -0,0 +1,94 @@+{-|+Module      : Game.Werewolf.Game+Description : Game and turn data structures.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Game and turn data structures.+-}++{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TemplateHaskell       #-}++module Game.Werewolf.Game (+    -- * Game+    Game(..), turn, players,+    newGame,++    -- * Turn+    Turn(..), votes,+    newVillagersTurn, newWerewolvesTurn,++    -- ** Queries+    isVillagersTurn, isWerewolvesTurn, isGameOver,+) where++import Control.Lens++import Data.Aeson+#if !MIN_VERSION_aeson(0,10,0)+import Data.Aeson.Types+#endif+import           Data.Map  (Map)+import qualified Data.Map  as Map+import           Data.Text (Text)++import Game.Werewolf.Player+import GHC.Generics++data Game = Game+    { _turn    :: Turn+    , _players :: [Player]+    } deriving (Eq, Generic, Show)++instance FromJSON Game++instance ToJSON Game where+    toJSON      = genericToJSON defaultOptions+#if MIN_VERSION_aeson(0,10,0)+    toEncoding  = genericToEncoding defaultOptions+#endif++data Turn+    = Villagers { _votes :: Map Text Text }+    | Werewolves { _votes :: Map Text Text }+    | NoOne+    deriving (Eq, Generic, Show)++instance FromJSON Turn++instance ToJSON Turn where+    toJSON      = genericToJSON defaultOptions+#if MIN_VERSION_aeson(0,10,0)+    toEncoding  = genericToEncoding defaultOptions+#endif++makeLenses ''Game++makeLenses ''Turn++newGame :: [Player] -> Game+newGame = Game newWerewolvesTurn++newVillagersTurn :: Turn+newVillagersTurn = Villagers Map.empty++newWerewolvesTurn :: Turn+newWerewolvesTurn = Werewolves Map.empty++isVillagersTurn :: Game -> Bool+isVillagersTurn (Game (Villagers {}) _) = True+isVillagersTurn _                       = False++isWerewolvesTurn :: Game -> Bool+isWerewolvesTurn (Game (Werewolves {}) _)   = True+isWerewolvesTurn _                          = False++isGameOver :: Game -> Bool+isGameOver (Game turn _) = turn == NoOne
+ src/Game/Werewolf/Player.hs view
@@ -0,0 +1,118 @@+{-|+Module      : Game.Werewolf.Player+Description : Player data structures.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Player data structures.+-}++{-# LANGUAGE CPP               #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++module Game.Werewolf.Player (+    -- * Player+    Player(..), name, role, state,+    newPlayer,++    -- ** Searches+    findByName, findByName_,++    -- ** Filters+    filterVillagers, filterWerewolves,++    -- ** Queries+    doesPlayerExist, isVillager, isWerewolf, isAlive, isDead,++    -- * State+    State(..),++    -- ** Filters+    filterAlive, filterDead,+) where++import Control.Lens++import Data.Aeson+#if !MIN_VERSION_aeson(0,10,0)+import Data.Aeson.Types+#endif+import Data.List+import Data.Maybe+import Data.Text  (Text)++import Game.Werewolf.Role hiding (name, _name)+import GHC.Generics++data Player = Player+    { _name  :: Text+    , _role  :: Role+    , _state :: State+    } deriving (Eq, Generic, Show)++instance FromJSON Player++instance ToJSON Player where+    toJSON      = genericToJSON defaultOptions+#if MIN_VERSION_aeson(0,10,0)+    toEncoding  = genericToEncoding defaultOptions+#endif++data State = Alive | Dead+    deriving (Eq, Generic, Show)++instance FromJSON State++instance ToJSON State where+    toJSON      = genericToJSON defaultOptions+#if MIN_VERSION_aeson(0,10,0)+    toEncoding  = genericToEncoding defaultOptions+#endif++makeLenses ''Player++newPlayer :: Text -> Role -> Player+newPlayer name role = Player name role Alive++findByName :: Text -> [Player] -> Maybe Player+findByName name = find ((==) name . _name)++findByName_ :: Text -> [Player] -> Player+findByName_ name = fromJust . findByName name++filterRole :: Role -> [Player] -> [Player]+filterRole role = filter ((==) role . _role)++filterVillagers :: [Player] -> [Player]+filterVillagers = filterRole villager++filterWerewolves :: [Player] -> [Player]+filterWerewolves = filterRole werewolf++doesPlayerExist :: Text -> [Player] -> Bool+doesPlayerExist name = isJust . findByName name++isVillager :: Player -> Bool+isVillager player = player ^. role == villager++isWerewolf :: Player -> Bool+isWerewolf player = player ^. role == werewolf++isAlive :: Player -> Bool+isAlive player = player ^. state == Alive++isDead :: Player -> Bool+isDead player = player ^. state == Dead++filterState :: State -> [Player] -> [Player]+filterState state = filter ((==) state . _state)++filterAlive :: [Player] -> [Player]+filterAlive = filterState Alive++filterDead :: [Player] -> [Player]+filterDead = filterState Dead
+ src/Game/Werewolf/Response.hs view
@@ -0,0 +1,194 @@+{-|+Module      : Game.Werewolf.Response+Description : Response and message data structures.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Response and message data structures.+-}++{-# LANGUAGE CPP               #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}++module Game.Werewolf.Response (+    -- * Response+    Response(..),++    -- ** Common responses+    success, failure,++    -- ** Exit functions+    exitWith, exitSuccess, exitFailure,++    -- * Message+    Message(..),+    emptyMessage, publicMessage, privateMessage,++    -- ** Game messages+    newGameMessages, villagersTurnMessages, werewolvesTurnMessages, playerMadeKillVoteMessage,+    playerKilledMessage, noPlayerKilledMessage, playerMadeLynchVoteMessage, playerLynchedMessage,+    noPlayerLynchedMessage, gameOverMessage,++    -- ** Error messages+    playerDoesNotExistMessage, playerCannotDoThatMessage, playerCannotDoThatRightNowMessage,+    gameIsOverMessage, playerIsDeadMessage, playerHasAlreadyVotedMessage, targetIsDeadMessage,+) where++import Control.Lens+import Control.Monad.IO.Class++import Data.Aeson+#if !MIN_VERSION_aeson(0,10,0)+import Data.Aeson.Types+#endif+import qualified Data.ByteString.Lazy.Char8 as BS+import           Data.List+import           Data.Text                  (Text)+import qualified Data.Text                  as T++import Game.Werewolf.Player as Player+import Game.Werewolf.Role+import GHC.Generics++import qualified System.Exit as Exit++data Response = Response+    { ok       :: Bool+    , messages :: [Message]+    } deriving (Eq, Generic, Show)++instance FromJSON Response++instance ToJSON Response where+    toJSON      = genericToJSON defaultOptions+#if MIN_VERSION_aeson(0,10,0)+    toEncoding  = genericToEncoding defaultOptions+#endif++success :: Response+success = Response True []++failure :: Response+failure = Response False []++exitWith :: MonadIO m => Response -> m ()+exitWith response = liftIO $ BS.putStrLn (encode response) >> Exit.exitSuccess++exitSuccess :: MonadIO m => m ()+exitSuccess = exitWith success++exitFailure :: MonadIO m => m ()+exitFailure = exitWith failure++data Message = Message+    { to      :: Maybe [Text]+    , message :: Text+    } deriving (Eq, Generic, Show)++instance FromJSON Message++instance ToJSON Message where+    toJSON      = genericToJSON defaultOptions+#if MIN_VERSION_aeson(0,10,0)+    toEncoding  = genericToEncoding defaultOptions+#endif++emptyMessage :: Message+emptyMessage = Message Nothing ""++publicMessage :: Text -> Message+publicMessage = Message Nothing++privateMessage :: [Text] -> Text -> Message+privateMessage to = Message (Just to)++newGameMessages :: [Player] -> [Message]+newGameMessages players = concat [+    werewolvesTurnMessages,+    map newPlayerMessage players,+    werewolvesFirstTurnMessages (filterWerewolves players)+    ]++newPlayerMessage :: Player -> Message+newPlayerMessage player = privateMessage [player ^. Player.name] (message' $ player ^. role)+    where+        message' role+            | role == villager  = "ZzZZzz, you're sound asleep."+            | role == werewolf  = "You slip away silently from your home."+            | otherwise         = undefined++werewolvesFirstTurnMessages :: [Player] -> [Message]+werewolvesFirstTurnMessages werewolves = map (\werewolf -> privateMessage [werewolf ^. Player.name] (messageFor werewolf)) werewolves+    where+        messageFor werewolf = T.concat $ "As you look around you see the rest of your " : T.intercalate ", " ("pack":names (werewolves \\ [werewolf])) : ["."]+        names = map Player._name++villagersTurnMessages :: [Message]+villagersTurnMessages = map publicMessage messages+    where+        messages = ["The sun rises. Everybody wakes up and opens their eyes..."]++werewolvesTurnMessages :: [Message]+werewolvesTurnMessages = map publicMessage messages+    where+        messages = ["Night falls, the town is asleep. The werewolves wake up, recognise one another and choose a new victim."]++playerMadeKillVoteMessage :: [Text] -> Text -> Text -> Message+playerMadeKillVoteMessage to voterName targetName = privateMessage to $ T.concat [voterName, " voted to kill ", targetName, "."]++playerKilledMessage :: Text -> Text -> Message+playerKilledMessage name roleName = publicMessage $ T.concat [+    "As you open them you notice a door broken down and ",+    name, "'s guts spilling out over the cobblestones.",+    " From the look of their personal effects, you deduce they were a ", roleName, "."+    ]++noPlayerKilledMessage :: Message+noPlayerKilledMessage = publicMessage "Surprisingly you see everyone present at the town square. Perhaps the werewolves have left Miller's Hollow?"++playerMadeLynchVoteMessage :: Text -> Text -> Message+playerMadeLynchVoteMessage voterName targetName = publicMessage $ T.concat [voterName, " voted to lynch ", targetName, "."]++playerLynchedMessage :: Text -> Text -> Message+playerLynchedMessage name "Werewolf"    = publicMessage $ T.unwords [+    name,+    "is tied up to a pyre and set alight.",+    "As they scream their body starts to contort and writhe, transforming into a werewolf.",+    "Thankfully they go limp before breaking free of their restraints."+    ]+playerLynchedMessage name roleName      = publicMessage $ T.concat [+    name, "is tied up to a pyre and set alight.",+    " Eventually the screams start to die and with their last breath,",+    " they reveal themselves as a ", roleName, "."+    ]++noPlayerLynchedMessage :: Message+noPlayerLynchedMessage = publicMessage "Daylight is wasted as the villagers squabble over whom to tie up. Looks like no one is being burned this day."++gameOverMessage :: Maybe Text -> Message+gameOverMessage Nothing                 = publicMessage "The game is over! Everyone died..."+gameOverMessage (Just roleName)  = publicMessage $ T.concat ["The game is over! The ", roleName, "s have won."]++playerDoesNotExistMessage :: Text -> Text -> Message+playerDoesNotExistMessage to name = privateMessage [to] $ T.unwords ["Player", name, "does not exist."]++playerCannotDoThatMessage :: Text -> Message+playerCannotDoThatMessage name = privateMessage [name] "You cannot do that!"++playerCannotDoThatRightNowMessage :: Text -> Message+playerCannotDoThatRightNowMessage name = privateMessage [name] "You cannot do that right now!"++gameIsOverMessage :: Text -> Message+gameIsOverMessage name = privateMessage [name] "The game is over!"++playerIsDeadMessage :: Text -> Message+playerIsDeadMessage name = privateMessage [name] "Sshh, you're meant to be dead!"++playerHasAlreadyVotedMessage :: Text -> Message+playerHasAlreadyVotedMessage name = privateMessage [name] "You've already voted!"++targetIsDeadMessage :: Text -> Text -> Message+targetIsDeadMessage name targetName = privateMessage [name] $ T.unwords [targetName, "is already dead!"]
+ src/Game/Werewolf/Role.hs view
@@ -0,0 +1,60 @@+{-|+Module      : Game.Werewolf.Role+Description : Role data structures.++Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com++Role data structures.+-}++{-# LANGUAGE CPP               #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++module Game.Werewolf.Role (+    -- * Role+    Role(..), name, description, advice,++    -- ** Instances+    allRoles, villager, werewolf,+) where++import Control.Lens++import Data.Aeson+#if !MIN_VERSION_aeson(0,10,0)+import Data.Aeson.Types+#endif+import Data.Text (Text)++import GHC.Generics++import Prelude hiding (all)++data Role = Role+    { _name        :: Text+    , _description :: Text+    , _advice      :: Text+    } deriving (Eq, Generic, Show)++instance FromJSON Role++instance ToJSON Role where+    toJSON      = genericToJSON defaultOptions+#if MIN_VERSION_aeson(0,10,0)+    toEncoding  = genericToEncoding defaultOptions+#endif++makeLenses ''Role++allRoles :: [Role]+allRoles = [villager, werewolf]++villager :: Role+villager = Role "Villager" "An ordinary townsfolk humbly living in Millers Hollow." "Bluffing can be a good technique, but you had better be convincing about what you say."++werewolf :: Role+werewolf = Role "Werewolf" "A shapeshifting human that, at night, hunts the residents of Millers Hollow." "Voting against your partner can be a good way to deflect suspicion from yourself."
+ test/app/Main.hs view
@@ -0,0 +1,58 @@+{-|+Module      : Main+Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com+-}++{-# OPTIONS_HADDOCK hide, prune #-}++module Main (+    main+) where++import Game.Werewolf.Test.Arbitrary ()+import Game.Werewolf.Test.Engine+import Game.Werewolf.Test.Game+import Game.Werewolf.Test.Player++import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++main :: IO ()+main = defaultMain =<< tests++tests :: IO TestTree+tests = return $ testGroup "Tests" (concat [allEngineTests, allGameTests, allPlayerTests])++allEngineTests :: [TestTree]+allEngineTests = [+    testProperty "PROP: validate vote command errors when game is over" prop_validateVoteCommandErrorsWhenGameIsOver,+    testProperty "PROP: validate vote command errors when voter not in game" prop_validateVoteCommandErrorsWhenVoterDoesNotExist,+    testProperty "PROP: validate vote command errors when target not in game" prop_validateVoteCommandErrorsWhenTargetDoesNotExist,+    testProperty "PROP: validate vote command errors when voter is dead" prop_validateVoteCommandErrorsWhenVoterIsDead,+    testProperty "PROP: validate vote command errors when target is dead" prop_validateVoteCommandErrorsWhenTargetIsDead,+    testProperty "PROP: validate vote command errors when voter has voted" prop_validateVoteCommandErrorsWhenVoterHasVoted,+    testProperty "PROP: validate kill vote command errors when voter not werewolf" prop_validateKillVoteCommandErrorsWhenVoterNotWerewolf,++    testProperty "PROP: start game starts with werewolves turn" prop_startGameStartsWithWerewolvesTurn,+    testProperty "PROP: start game errors unless unique player names" prop_startGameErrorsUnlessUniquePlayerNames,+    testProperty "PROP: start game errors when less than 7 players" prop_startGameErrorsWhenLessThan7Players,+    testProperty "PROP: start game errors when more than 24 players" prop_startGameErrorsWhenMoreThan24Players,++    testProperty "PROP: create players uses given player names" prop_createPlayersUsesGivenPlayerNames,+    testProperty "PROP: create players creates alive players" prop_createPlayersCreatesAlivePlayers,++    testProperty "PROP: randomise roles returns n roles" prop_randomiseRolesReturnsNRoles+    ]++allGameTests :: [TestTree]+allGameTests = [+    testProperty "PROP: new game starts with werewolves turn" prop_newGameStartsWithWerewolvesTurn,+    testCase "CHCK: newVillagersTurn" check_newVillagersTurn,+    testCase "CHCK: newWerewolvesTurn" check_newWerewolvesTurn+    ]++allPlayerTests :: [TestTree]+allPlayerTests = [testProperty "PROP: new player is alive" prop_newPlayerIsAlive]
+ test/src/Game/Werewolf/Test/Arbitrary.hs view
@@ -0,0 +1,64 @@+{-|+Module      : Game.Werewolf.Test.Arbitrary+Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com+-}++{-# OPTIONS_HADDOCK hide, prune #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Game.Werewolf.Test.Arbitrary (+    arbitraryCommand, arbitraryNewGame, arbitraryNewPlayer,+) where++import Control.Lens hiding (elements)++import Data.List.Extra+import Data.Text       (Text, pack)++import Game.Werewolf.Command+import Game.Werewolf.Game+import Game.Werewolf.Player+import Game.Werewolf.Role    hiding (_name)++import Test.QuickCheck++instance Arbitrary Command where+    arbitrary = Vote <$> arbitrary <*> arbitrary++arbitraryCommand :: Game -> Gen Command+arbitraryCommand game = Vote <$> elements (game ^. players) <*> elements (game ^. players)++instance Arbitrary Game where+    arbitrary = do+        n <- choose (7, 24)+        turn <- arbitrary+        players <- infiniteList++        return $ Game turn (take n $ nubOn _name players)++arbitraryNewGame :: Gen Game+arbitraryNewGame = do+    n <- choose (7, 24)+    players <- infiniteListOf arbitraryNewPlayer++    return $ newGame (take n $ nubOn _name players)++instance Arbitrary Turn where+    arbitrary = elements [newVillagersTurn, newWerewolvesTurn, NoOne]++instance Arbitrary Player where+    arbitrary = Player <$> arbitrary <*> arbitrary <*> arbitrary++arbitraryNewPlayer :: Gen Player+arbitraryNewPlayer = newPlayer <$> arbitrary <*> arbitrary++instance Arbitrary State where+    arbitrary = elements [Alive, Dead]++instance Arbitrary Role where+    arbitrary = elements allRoles++instance Arbitrary Text where+    arbitrary = pack <$> vectorOf 6 (elements ['a'..'z'])
+ test/src/Game/Werewolf/Test/Game.hs view
@@ -0,0 +1,31 @@+{-|+Module      : Game.Werewolf.Test.Game+Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com+-}++{-# OPTIONS_HADDOCK hide, prune #-}+{-# LANGUAGE OverloadedStrings #-}++module Game.Werewolf.Test.Game (+    prop_newGameStartsWithWerewolvesTurn, check_newVillagersTurn, check_newWerewolvesTurn,+) where++import Control.Lens++import Data.Map as Map++import Game.Werewolf.Game+import Game.Werewolf.Player++import Test.HUnit++prop_newGameStartsWithWerewolvesTurn :: [Player] -> Bool+prop_newGameStartsWithWerewolvesTurn players = newGame players ^. turn == newWerewolvesTurn++check_newVillagersTurn :: Assertion+check_newVillagersTurn = newVillagersTurn @?= Villagers Map.empty++check_newWerewolvesTurn :: Assertion+check_newWerewolvesTurn = newWerewolvesTurn @?= Werewolves Map.empty
+ test/src/Game/Werewolf/Test/Player.hs view
@@ -0,0 +1,23 @@+{-|+Module      : Game.Werewolf.Test.Player+Copyright   : (c) Henry J. Wylde, 2015+License     : BSD3+Maintainer  : public@hjwylde.com+-}++{-# OPTIONS_HADDOCK hide, prune #-}++module Game.Werewolf.Test.Player (+    prop_newPlayerIsAlive,+) where++import Control.Lens++import Data.Text++import Game.Werewolf.Player+import Game.Werewolf.Role+import Game.Werewolf.Test.Arbitrary ()++prop_newPlayerIsAlive :: Text -> Role -> Bool+prop_newPlayerIsAlive name role = newPlayer name role ^. state == Alive
+ werewolf.cabal view
@@ -0,0 +1,115 @@+name:           werewolf+version:        0.1.0.0++author:         Henry J. Wylde+maintainer:     public@hjwylde.com+homepage:       https://github.com/hjwylde/werewolf++synopsis:       A game engine for running werewolf in a chat client+description:    This engine is based off of Werewolves of Millers Hollow+                (http://www.games-wiki.org/wiki/Werewolves_of_Millers_Hollow/).+                See https://github.com/hjwylde/werewolf for help on writing chat interfaces.++license:        BSD3+license-file:   LICENSE++cabal-version:  >= 1.10+category:       Game+build-type:     Simple++extra-source-files: CHANGELOG.md README.md++source-repository head+    type:       git+    location:   git@github.com:hjwylde/werewolf++executable werewolf+    main-is:        Main.hs+    hs-source-dirs: app/+    ghc-options:    -threaded -with-rtsopts=-N+    other-modules:+        Werewolf.Commands.End,+        Werewolf.Commands.Help,+        Werewolf.Commands.Interpret,+        Werewolf.Commands.Start,+        Werewolf.Commands.Vote,+        Werewolf.Options,+        Werewolf.Version,+        Paths_werewolf++    default-language: Haskell2010+    other-extensions:+        OverloadedStrings+    build-depends:+        aeson >= 0.8,+        base >= 4.8 && < 5,+        bytestring >= 0.10,+        directory >= 1.2,+        extra >= 1.4,+        filepath >= 1.4,+        lens >= 4.12,+        mtl >= 2.2,+        optparse-applicative >= 0.11,+        text >= 1.2,+        transformers >= 0.4,+        werewolf++library+    hs-source-dirs: src/+    exposed-modules:+        Game.Werewolf.Command,+        Game.Werewolf.Engine,+        Game.Werewolf.Game,+        Game.Werewolf.Player,+        Game.Werewolf.Response,+        Game.Werewolf.Role++    default-language: Haskell2010+    other-extensions:+        CPP,+        DeriveGeneric,+        FlexibleContexts,+        MultiParamTypeClasses,+        OverloadedStrings,+        TemplateHaskell+    build-depends:+        aeson >= 0.8,+        base >= 4.8 && < 5,+        bytestring >= 0.10,+        containers >= 0.5,+        directory >= 1.2,+        extra >= 1.4,+        filepath >= 1.4,+        lens >= 4.12,+        MonadRandom >= 0.4,+        mtl >= 2.2,+        random-shuffle,+        text >= 1.2,+        transformers >= 0.4++test-suite werewolf-test+    type:           exitcode-stdio-1.0+    main-is:        Main.hs+    hs-source-dirs: test/app/, test/src/+    ghc-options:    -threaded -with-rtsopts=-N+    other-modules:+        Game.Werewolf.Test.Arbitrary+        Game.Werewolf.Test.Game+        Game.Werewolf.Test.Player++    default-language: Haskell2010+    other-extensions:+        OverloadedStrings+    build-depends:+        base >= 4.8 && < 5,+        containers >= 0.5,+        extra >= 1.4,+        HUnit >= 1.2,+        lens >= 4.12,+        mtl >= 2.2,+        QuickCheck >= 2.8,+        tasty >= 0.10 && < 0.12,+        tasty-hunit >= 0.9,+        tasty-quickcheck >= 0.8,+        text >= 1.2,+        werewolf