Whew, I just added a big pile of code to what was done previously. I wrote all the missing game types and rules. It took about 4 or 5 hours.

In this post, I will describe how I decided to define the main game types, and some various details of interest.

Choosing the rules monad

I will describe the rules using a monad, mainly because I am used to work with them, and because they are mighty convenient in Haskell, with the do notation and the numerous libraries. As is often the case with games, there will be a state, containing the game state at a given time. But while I will just write the rules, I need to graft user interaction at some point. The goal of this project is to write a 7 Wonders clone that might work with multiple backends. To achieve this, I will try not to constraint my implementation any more than necessary.

Player identification

The first important type is to find a way to identify each players. I wrote this :

1

type PlayerId = T.Text

I currently am not sure this is sufficient / precise enough, but the backends I have in mind (IRC, XMPP, console and email) all have string based identifiers, so it should work for at least those three. Anyway, the backends will probably have to keep a relationship between a player nickname and his actual identity in the system, so this will probably turn out OK.

Game state

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

data GameState = GameState { _playermap   :: M.Map PlayerId PlayerState
                           , _discardpile :: [Card]
                           , _rnd         :: StdGen
}

data PlayerState = PlayerState { _pCompany         :: CompanyProfile
                               , _pCompanyStage    :: CompanyStage
                               , _pCards           :: [Card]
                               , _pFunds           :: Funding
                               , _pNeighborhood    :: M.Map Neighbor PlayerId
                               , _pPoachingResults :: [PoachingOutcome]
}

makeLenses ''GameState
makeLenses ''PlayerState

This might look pretty obvious, and it might be (as it is my first version), but this model has several shortcomings, the worst of them being the way that neighboring information is encoded. This is originally a tabletop game, and each player has two neighbors : on his left and on his right. Unfortunately, the Map Neighbor PlayerId only means that a player can have up to two neighbors (there are only two constructors in the Neighbor type), and it doesn’t even garantee they have a corresponding state in the GameState.

A type that would properly model this property would be to store [(PlayerId, PlayerState)] in GameState, interpreted as a circular list (the first player in the list being the right neighbor of the last one). But this would be a major PITA to manipulate.

Another idea would be to store the neighboring information in a read-only structure. That way, we can make sure that no invariants are being violated, as the structure can’t be modified, but this also might be too much of a hassle. I will probably refactor some of this for the next episode with something less challenging : a simple pair.

And now, the monad !

As we have seen, we will need a MonadState GameState to model most of the rules. Some parts of the game might also throw errors, so it might be a good idea to have our monad be an instance of MonadError. Finally, we need some user interaction. In order to be able to write any backend, I decided to keep it abstract for now :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

type GameStateOnly m = ( MonadState GameState m
                       , Monad m
                       , Functor m
                       , Applicative m)
type NonInteractive m = (MonadState GameState m
                        , Monad m
                        , MonadError Message m
                        , Functor m
                        , Applicative m)

class NonInteractive m => GameMonad m where
    playerDecision    :: Age -> Turn -> PlayerId -> [Card] -> GameState
                             -> m (PlayerAction, Exchange)
    askCard           :: Age -> PlayerId -> [Card] -> GameState -> Message -> m Card
    -- | Tell some information to a specific player
    tellPlayer        :: PlayerId -> Message -> m ()
    generalMessage    :: Message -> m () -- ^ Broadcast some information

First of all are two constraints synonyms :

• GameStateOnly : basically MonadState State with all the implied constaints, which will be used in all the functions that can’t fail and that don’t require user interaction.
• NonInteractive : just like the previous constraint, but for functions that can throw errors.

Finally, a GameMonad typeclass. The monad our game will work in must implement these four functions, which are all I found was needed for player communication :

• playerDecision: this is the main interaction. Given all kinds of data, it asks the player to decide what he will do in the current turn.
• askCard: there are two effects where a player must chose a card over a list (copy community, and play for free a card from the discard pile). This is what this function is about, at least for now.
• tellPlayer: tells a specific message to a given player.
• generalMessage: tells a message to all players. This might not be necessary, as we could just iterate over the list of players and use tellPlayer. On the other hand, for IRC or XMPP backends, it might make sense to display this information on a conversation channel, so that watchers can follow the game.

The reason why it might make sense to have such granularity (pure, GameStateOnly, NonInteractive, GameMonad) is twofold :

• It is easier to reason about the functions.
• The less “powerful” a function is, the easier it is to test.

What is important to note is that I can’t write arbitrary effects with just the GameMonad constraint. Even better, I know I should be careful only when using the first two functions, as they are the only ones where user input can creep in. This explains why the part of the code that deals with playerDecision is so full of checks.

The choice of a typeclass is debatable, as there probably will only be a single implementation. I chose to do so because it will let me write code without worrying about how the monad itself will be implemented. I will probably ditch the typeclass later.

One problem so far is that these functions don’t have the proper type. Indeed, what happens when I pass askCard an empty list ? How is the player supposed to provide a card ? The other problem now is what to do with this Message type. Right now, it’s a type synonym to String, but it will change for the next episode !

Various notes

No error recovery

I decided not to have error recovery in the game rules description. This is the responsability of the “driver” (which will be described in a later post) to make sure sore losers can’t DoS the game. The game will just end on the first error it encounters.

Lenses everywhere

This code uses the lens library all over the place. This is not surprising, as it involves a lot of mangling of nested structures in the State monad. But the prisms are even better ! Here is an example :

1
2
3
4
5
6
7
8

-- | Compute the money that a card gives to a player
getCardFunding :: GameStateOnly m => PlayerId -> Card -> m Funding
getCardFunding pid card = do
    stt <- use playermap
    -- note how we exploit the fact that ^. behaves like foldMap here
    let funding = card ^. cEffect . traverse . _GainFunding . to computeFunding
        computeFunding (n, cond) = countConditionTrigger pid cond stt * n
    return funding

The choice of writing this option in GameStateOnly is debatable, as it just needs a read only access to the state once, and might just have been like that :

1

getCardFunding :: GameState -> PlayerId -> Card -> Funding

However, what is interesting is how it is working. Here is an anotated of how the funding function is composed :

1
2
3
4

cEffect                                               :: Traversal' Card [Effect]
cEffect . traverse                                    :: Traversal' Card Effect
cEffect . traverse . _GainFunding                     :: Traversal' Card (Funding, Condition)
cEffect . traverse . _GainFunding . to computeFunding :: Fold Card Funding

So basically we wrote a traversal that goes through all effects of a card, keeping those with the GainFunding constructor, extracting its arguments, and finally using them to compute a Funding.

Now, if I had written funding = card ^.. ..., I would have obtained a [Funding], that I could add with sum. But remember that we made sure that our numerical newtypes, such as Funding and Victory, had a monoid instance for addition. In that case, ^. (or view) will make a monoidal summary, meaning it will give me 0 if there were no matches, or the sum of these matches, which is exactly what I wanted.

Order of execution

In this game, order of execution is really important, as most actions are supposed to happen simultaneously, and some only at very specific steps. In particular, a players can “trade” a resource belonging to a neighbor in exchange for money. A naïve implementation would be something like :

1
2

playermap . ix playerid . cFunds -= x
playermap . ix neighbor . cFunds += x

But this would create a (risky) exploit : namely declaring that you want to trade more resource than what you have money for, hoping somebody else will trade with you and that this transaction will be processed before yours.

In order to fix this, the resolveExchange function only removes money from the current player, returning the set of bought resources and an AddMap PlayerId Funding, listing the money that needs to be given to the neighbors.

The AddMap newtype

The resolveAction function also returns this AddMap PlayerId Funding, and the payouts are only processed after all actions are resolved. In order to make the code nicer, we need this AddMap k v newtype to be Traversable and have a Monoid instance that does unionWith (+).

The code is here and is an example on how this is done. I also derived the Ix and At instances, even though I didn’t end up using them. Strangely, someone asked on the cafe mailing list how to do this.

The 7th turn

There are only 6 turns for each age. But there is a company stage that let players use the 7th card, at the end of an age. Instead of having a special case, this is done by having an optional 7th turn.

No tests

Despite my claim that my rules are easy to test, tests are horrible to write, as they need a big setup. For this reason I postponed writing them ;) This will be a good test of the “Haskell code almost works the first time it runs” theory.

Next time

I will refactor a bit, and introduce a custom pretty-printer that will work with multiple backends, so that it is possible to have a nice view of what is going on during play.