This one will be an experimental post, as I have just added a ton of new code. I did not have enough time to do this properly, so this looks like a giant tangle of
STM functions now. I will probably rewrite a large part of it, but I still think the though process that led me to this could be interesting to others, so here we are.
TLDR: I wrote a lot of code, it sucks, and I will rewrite a large part of it for the next episode.
Stuff that was refactored since last time
A pair of minor items :
- I fixed the
- I changed the type of
playerActionsDialogso that it only accepts
- I did the same for allowableActions. I also rendered the function partial by mistake, can you spot the bug ? :)
The big change came from the fact that I realized my operation types were wrong. In particular this one :
AskCard :: Age -> PlayerId -> NonEmpty Card -> Message -> GameInstr Card
This type seemed right for writing the game rules, and the console version. However, it does suck for a multiplayer version, as this code will ask the second player for his choice only after the first one has answered. This will slow down the game considerably. We should query all players at once, and wait for their answers after that. I decided to model this as an abstract promise, ie. a value container that will eventually be filled. There is a new type parameter
p for the
GameInstr type, along with a new GetPromise instruction.
Now, all players are consulted at the same time, and the game then waits for them to answer (code).
This is all very abstract, but in practice things are not that simple, and the promise might not get fulfilled. One problem is a player disconnecting from a backend. One way to do this would be to make the return value of the
getPromise function be an
Either of some sort. But the only sensible option in the game logic would be to throw an error, so instead the interpreter's
getPromise can fail, but not the version that's exposed to the game.
For the pure backend, the promise type is just
Identity, as seen here.
An ambitious step
I decided to get a bit more ambitious for this episode. I wanted to implement code that would be able to run several games at once, over several medias at once, with player being connected on any media combination. I did not write a simple backend to start with, to get a feel of where the actual problems were, and decided to write the code top-down.
So here is what I had in mind :
So basically, there would be a "Hub" that would hold the player list, who is playing which game, and that would also run the games. Backends would interact with it to provide IO with the players. As IRC and XMPP have the same kind of communication model, they would be merged in a single "virtual backend" that would communicate with a pair of "real backends". Now how to do that ?
Both backends need to listen to two kinds of events :
- Requests from the game, such as asking a specific player to choose a card.
- Instant messages from a server, a channel, or a person.
From the point of view of a game, the messages from the players are usually of no interest. It just needs them to choose a card, or an action to play from times to times. The backends, however, will need to watch out for administrative commands. This means there should be a lot of filtering.
The main problem resides in asking something to a player, and get his answer. An extremely naive way to go about this would be something along the lines of:
RUser playerid) message sendTextContent session (<- getMessage sessionresp
This would be completely wrong because we are not assured the next message will be the one we are expecting. So instead, we need to implement some sort of callbacks, so that when a message arrives, the backend would check if we were expecting something from the sender, and react accordingly. This means that we need an extra thread that will just wait for messages, and handle administrative commands and callbacks. So something like :
$ forever $ do forkIO <- getMessage session msg let pid = getPlayerId msg case callbacks ^. at pid of Just cb -> cb msg Nothing -> case getContent msg of "xxx" -> adminCommandXxx "yyy" -> adminCommandYyy -> return () _ runGame
Where the game would do something like this to implement, for example, the "ask card" function:
askCard :: PlayerId -> NonEmpty Card -> m (promise Card) = do askCard pid necards let msg = buildAskCardMessage necards sendMessage session pid msg<- newPromise p $ \msg -> addCallback pid case decodeMsg of Just x -> fulfill p x Nothing -> askAgain return p
So that was cool, but what if there are multiple backends ? All of them must be able to fulfill that promise ! What I would like to do is to be able to return a promise that will be fulfilled at a later date in another part of my program. Usually, this would be something like that :
promise :: IO a -> IO (Promise a) getPromise :: Promise a -> IO a
But I decided most of my function will live in the
STM (I did not document this choice, but the STM is so useful it's a no brainer), and I wanted to write code anyway.
Because of "not invented here", I wrote my own implementation, gave it a bad name (
PubSub) and wrote buggy
Monoid instances. Code is here and is wrong on many levels. It exposes this set of functions :
newPubSub :: STM (PubFP e a, SubFP e a) fulfillPub :: PubFP e a -> a -> STM () failPub :: PubFP e a -> e -> STM () getResult :: SubFP e a -> STM (Either e a) addPubAction :: STM () -> PubFP e a -> PubFP e a
newPubSub gives you a pair of values, one of them you can publish to (using
fulfillPub for success and
failPub for failure), and one of them you can get results from (with a blocking
The name is wrong because
getResult will always return the same value, so this does not behave at all like a stream, which could be implied by the
addPubAction is horrible too. I only had a sketchy idea that I needed callbacks at some point when I wrote this module, and that these callbacks should be lifted as soon as possible, so probably as soon as a response is published. This is wrong because :
- The type here let you do a ton of stuff, so it's not obvious what this function does or is supposed to be used for.
- It is not actually useful. I realized later this was not needed.
Monoid instances suffer the same problem, as they are probably not useful. Even worse, one of them doesn't even work !
instance Monoid (PubFP e a) where mempty = PubFP (const (return ())) PubFP a `mappend` PubFP b = PubFP (a >> b)
It actually used the monad instance of
(->) and not
STM, which, if I desugar it properly, does something like that :
>> b a >>= \_ -> b a -> (\_ -> b) (a z) z \z -> b z \z b
So it basically only used the last
PubFP. The correct implementation for
mappend should have been :
instance Monoid (PubFP e a) where PubFP a `mappend` PubFP b = PubFP (\e -> a e >> b e)
Abstracting a backend
Now that I have decided to have a "hub" connecting several backends, I need to find a way to abstract them. I will need to keep a list of them, and it must be possible to add and remove them dynamically, so I need some way to identify each backend. I also need a way to tell the backend that it is to be removed, so that it can clean things up and say goodbye. Finally, I need a way to talk to a backend, and a way for the backend to interact with the hub.
Here is the set of threads I should need without undue multiplexing :
- One thread per active game. I don't think it's possible to combine them in a single thread due to the API I exposed, and I don't think it's worth worrying about this anyway.
- One thread per backend, that will listen to messages from the outside world.
That is probably all I need, but because I started writing code before thinking about my architecture, I introduced a bad abstraction. I decided I would talk to the backends using a
TChan, which means :
- One additional thread per backend, listening to messages from the games.
So backends are defined here. A better abstraction for
backendChan :: TChan Interaction could be
backendTell :: Interaction -> STM (). You might notice that the comments are talking about a set of function, which was my first shot, and which was a better idea indeed.
Communications from the game and to the player are currently of three types :
- Asking the player what card he would like to play during normal play. This returns a
- Asking the player to choose between several cards. This returns a
- Telling various things to the player. There is no return value expected from the player.
For all cases, we need to contact each backends and tell them to contact a player or broadcast some message.
For the first two cases we need also to set some callback machinery and wait for them to answer. The function performing this should return quickly some kind of promise object that will be filled once a player has answered.
We would like to write a function with a type looking somehow like :
communicate :: TVar GlobalState -> a -> STM (Promise b)
a is one of the three message types, and
b the corresponding answer. Obviously, we can't write such a function with this type. But we can use the
TypeFamilies extension to write it :
data IAskingAction = IAskingAction PlayerId Age (NonEmpty Card) GameState Turn data IAskingCard = IAskingCard PlayerId Age (NonEmpty Card) GameState Message data ISimpleMessage = ISimpleMessage CommunicationType GameId type family InteractionResult a :: * type instance InteractionResult IAskingAction = (PlayerAction, Exchange) type instance InteractionResult IAskingCard = Card type instance InteractionResult ISimpleMessage = () communicate :: TVar GlobalState -> a -> STM (Promise (InteractionResult a))
Now the type of
a and of the
Promise are statically linked, which will be useful for writing generic functions.
This episode was about hasty decisions and code quickly written. I was not exactly in my comfort zone with the multiple backends concept, and should probably have aimed lower to get a feel of the problem first.
I will rework all of this before the next episode, which will be about concurrency, the
STM, and how to mix