Practice meeting, 10/21/19

Skip to first unread message

Lyle Kopnicky

Oct 8, 2019, 12:53:01 AM10/8/19
to pdxfunc
When: Monday, Oct 21st, 6:30-8:30pm

Where: Collective Agency Downtown, Suite 1108, 511 SW 10th Ave, Portland, OR (opposite side of the floor from the elevators)

We'll finish up Chapter 12, "Concurrent Network Servers", of Parallel and Concurrent Programming in Haskell, starting on page 216 with the section "A Chat Server". Please read it beforehand. You may wish to try running the code examples from the book. At the meeting anyone will be able to present and contribute to the discussion.

Meetup link to RSVP:

Hope to see you then!

Lyle Kopnicky

Nov 10, 2019, 1:38:41 AM11/10/19
to pdxfunc
We finished up Chapter 12, discussing how to write a chat server. We were able to compile and run the code, opening up a server in one window, and several clients in other windows.

One thing that struck me as not quite satisfying was that clientKicked is a TVar rather than a message. Marlow says “we could send a message to its TChan, but because we are using STM, we might as well just watch the global state for changes as we did for the factor example in the previous section.” Uh, OK. But since we’re already using a TChan, why complicate things by adding another variable?

Another thing I found odd was that Marlow says on page 220 that in this particular situation we can’t use the bracket function, because our resource acquisition with checkAddClient is conditional. He then has to resort to the lower-level mask in order to mask asynchronous exceptions:

      else mask $ \restore -> do        -- <1>
             ok <- checkAddClient server name handle
             case ok of
               Nothing -> restore $ do  -- <2>
                  hPrintf handle
                     "The name %s is in use, please choose another\n" name
               Just client ->
                  restore (runClient server client) -- <3>
                      `finally` removeClient server name

I don’t think that the resource acquisition being conditional is a problem. We can write it using bracket - we just need to pattern match on the result of checkAddClient:

      else bracket
             (checkAddClient server name handle)
             (\ok -> case ok of
               Nothing -> return ()
               Just _ -> removeClient server name
             (\ok -> case ok of
                Nothing -> do
                   hPrintf handle
                      "The name %s is in use, please choose another\n" name
                Just client -> runClient server client

I believe this will work correctly, and it runs fine at least in the normal use situation.

Another option would be to use ResourceT, which allows you to allocate multiple resources within the scope of runResourceT, and guarantees that all of them will be freed if there is an exception. This works, but isn’t as much of a win as I had thought:

      else runResourceT $ do
             (_, ok) <- allocate (checkAddClient server name handle)
                (\ok -> case ok of
                   Nothing -> return ()
                   Just _ -> liftIO $ removeClient server name
             liftIO $ case ok of
               Nothing -> do
                  hPrintf handle
                     "The name %s is in use, please choose another\n" name
               Just client -> runClient server client

The upside is that the lower section no longer needs to be parenthesized. The downside is that we have to throw in some liftIOs.

Unfortunately, we can’t push the resource cleanup into checkAddClient, because it runs in STM. We can’t run ResourceT inside STM, only wrap it around the call to atomically.

At the end of the chapter, Marlow suggests that we try to improve the performance of broadcast messages by using a broadcast channel. I tried this, and STM made it quite easy! If we were using MVars, we’d have to have another thread per client to listen to the broadcast channel, to send messages to the client’s own channel. But with STM, we can just use the magical orElse to listen to either!

First we need to extend the server datatype to contain a broadcast channel, to send messages on:

-- <<Server
data Server = Server
  { clients :: TVar (Map ClientName Client)
  , broadcastChan :: TChan Message

newServer :: IO Server
newServer = do
  c <- newTVarIO Map.empty
  chan <- newTChanIO
  return Server { clients = c, broadcastChan = chan }
-- >>

Then we need to extend the client datatype to contain its own copy of the broadcast channel, made using dupTChan:

data Client = Client
  { clientName     :: ClientName
  , clientHandle   :: Handle
  , clientKicked   :: TVar (Maybe String)
  , clientSendChan :: TChan Message
  , clientBroadcastChan :: TChan Message
-- >>

-- <<newClient
newClient :: TChan Message -> ClientName -> Handle -> STM Client
newClient serverBroadcastChan name handle = do
  c <- newTChan
  k <- newTVar Nothing
  bc <- dupTChan serverBroadcastChan
  return Client { clientName     = name
                , clientHandle   = handle
                , clientSendChan = c
                , clientKicked   = k
                , clientBroadcastChan = bc
-- >>

We can now simplify broadcast. No more looping over the client list:

broadcast :: Server -> Message -> STM ()
broadcast Server{..} msg = writeTChan broadcastChan msg

In runClient, we just change this one line:

        msg <- readTChan clientSendChan `orElse` readTChan clientBroadcastChan

Now, if it finds no messages on its own channel, it will check the broadcast channel. The orElse does the merging for us.

This is one of those code changes that worked correctly as soon as I got it to compile. :)

See you next time!

- Lyle

You received this message because you are subscribed to the Google Groups "pdxfunc" group.
To unsubscribe from this group and stop receiving emails from it, send an email to
To view this discussion on the web visit

Lyle Kopnicky

Nov 10, 2019, 1:58:11 AM11/10/19
to pdxfunc
It just occurred to me that my broadcast channel version of the chat program has a space leak. The server’s copy of the broadcast channel will keep growing, because nothing ever reads from it.

In newServer, instead of using newTChanIO, we need to use newBroadcastTChanIO. That will create a write-only channel. The duplicated copies of it will be readable.
Reply all
Reply to author
0 new messages