More work on chapter 6.

haskell/GenServer.hs

@@ -52,51 +52,52 @@ spawn serverLoop = do
   return $ Server tid input
 -- ANCHOR_END: Spawn
 
--- ANCHOR: RequestReply
+-- ANCHOR: ReplyChan
 newtype ReplyChan a = ReplyChan (Chan a)
+-- ANCHOR_END: ReplyChan
 
-requestReply :: Server a -> (ReplyChan b -> a) -> IO b
-requestReply serv con = do
-  reply_chan <- ReplyChan <$> newChan
-  sendTo serv $ con reply_chan
-  receiveReply reply_chan
-
+-- ANCHOR: reply
 reply :: ReplyChan a -> a -> IO ()
 reply (ReplyChan chan) x = send chan x
+-- ANCHOR_END: reply
 
-receiveReply :: ReplyChan a -> IO a
-receiveReply (ReplyChan chan) = receive chan
+-- ANCHOR: RequestReply
+requestReply :: Server a -> (ReplyChan b -> a) -> IO b
+requestReply serv con = do
+  reply_chan <- newChan
+  sendTo serv $ con $ ReplyChan reply_chan
+  receive reply_chan
 -- ANCHOR_END: RequestReply
 
 data Timeout = Timeout
 
 -- ANCHOR: ActionWithTimeout
 actionWithTimeout :: Int -> IO a -> IO (Either Timeout a)
 actionWithTimeout seconds action = do
-  chan <- ReplyChan <$> newChan
+  chan <- newChan
   _ <- forkIO $ do
     -- worker thread
     x <- action
-    reply chan $ Right x
+    send chan $ Right x
   _ <- forkIO $ do
     -- timeout thread
     threadDelay (seconds * 1000000)
-    reply chan $ Left Timeout
-  receiveReply chan
+    send chan $ Left Timeout
+  receive chan
 -- ANCHOR_END: ActionWithTimeout
 
 -- ANCHOR: ActionWithTimeoutKill
 actionWithTimeoutKill :: Int -> IO a -> IO (Either Timeout a)
 actionWithTimeoutKill seconds action = do
-  chan <- ReplyChan <$> newChan
+  chan <- newChan
   worker_tid <- forkIO $ do
     -- worker thread
     x <- action
-    reply chan $ Right x
+    send chan $ Right x
   _ <- forkIO $ do
     -- timeout thread
     threadDelay (seconds * 1000000)
     killThread worker_tid
-    reply chan $ Left Timeout
-  receiveReply chan
+    send chan $ Left Timeout
+  receive chan
 -- ANCHOR_END: ActionWithTimeoutKill

haskell/Week6/Counter.hs

@@ -9,43 +9,43 @@ module Week6.Counter
   )
 where
 
-import qualified GenServer as GS
+import GenServer
 import Control.Monad (replicateM_)
 
 type InternalData = Int
 
 -- ANCHOR: CounterMsg
-data Msg = GetValue (GS.ReplyChan Int)
+data Msg = GetValue (ReplyChan Int)
          | Incr
-         | Decr Int (GS.ReplyChan Bool)
+         | Decr Int (ReplyChan Bool)
 -- ANCHOR_END: CounterMsg
 
 -- ANCHOR: CounterAPI
-type CounterServer = GS.Server Msg
+type CounterServer = Server Msg
 
 newCounter :: Int -> IO CounterServer
-newCounter initial | initial >= 0 = GS.spawn $ counterLoop initial
+newCounter initial | initial >= 0 = spawn $ counterLoop initial
 newCounter _                      = error "Initial value should be non-negative"
 
 getValue :: CounterServer -> IO Int
-getValue cnt = GS.requestReply cnt GetValue
+getValue cnt = requestReply cnt GetValue
 
 incr :: CounterServer -> IO ()
-incr cnt = GS.sendTo cnt Incr
+incr cnt = sendTo cnt Incr
 
 decr :: CounterServer -> Int -> IO Bool
-decr cnt n | n >= 0 = GS.requestReply cnt $ Decr n
+decr cnt n | n >= 0 = requestReply cnt $ Decr n
 decr _ _            = error "Cannot decrement with negative amount"
 -- ANCHOR_END: CounterAPI
 
 -- ANCHOR: CounterLoop
-counterLoop :: InternalData -> GS.Chan Msg -> IO ()
+counterLoop :: InternalData -> Chan Msg -> IO ()
 counterLoop state input = do
-  msg <- GS.receive input
+  msg <- receive input
   case msg of
     GetValue from -> do
       let (newState, res) = (state, state)
-      GS.reply from res
+      reply from res
       counterLoop newState input
     Incr -> do
       let newState = state + 1
@@ -55,7 +55,7 @@ counterLoop state input = do
             case state of
               value | value > n -> (value - n, True)
               _                 -> (state, False)
-      GS.reply from res
+      reply from res
       counterLoop newState input
 -- ANCHOR_END: CounterLoop
 

src/chapter_6.md

@@ -326,13 +326,38 @@ sending a message to the server.
 ### Request-Reply Pattern
 
 We saw above how to implement RPC on top of asynchronous messages. To
-cut down on the boilerplate and avoid incorrect usage, we provide a
-convenience API in the `GenServer` API for performing RPCs.
+cut down on the boilerplate and avoid incorrect usage, `GenServer`
+provides a structured facility for performing RPCs.
+
+First, we define an abstract type that encapsulates a the *reply
+channel*. Under the hood, this is just a normal channel, but the
+wrapper type denotes that its purpose is to reply to an RPC.
+
+```Haskell
+{{#include ../haskell/GenServer.hs:ReplyChan}}
+```
+
+The idea is that only one message is ever sent to this channel. This
+is not something we can express within Haskell's type system (at least
+not without extensions that go beyond what we discuss in AP). We
+provide a function `reply` for sending a reply on a `ReplyChan`:
+
+```haskell
+{{#include ../haskell/GenServer.hs:reply}}
+```
+
+Finally, we provide a function `requestReply` that encapsulates the
+notion of creating a reply channel, providing it to a message
+constructor, and reading the response from the reply channel.
 
 ```haskell
 {{#include ../haskell/GenServer.hs:RequestReply}}
 ```
 
+If we avoid exporting the definition of `ReplyChan` from `GenServer`
+(meaning it is an abstract type), then `requestReply` is the *only*
+place one can read from the reply channel, which is exactly what we
+want.
 
 ## Method
 
@@ -407,13 +432,11 @@ In this example we want to make a server that keeps track of a count,
 a *counter server*. It should be possible to *get the value* of the
 counter, to *increment* the counter by one, or to *decrement* the
 counter by positive amount `n`. We will maintain the invariant that
-the counter is always non-negative.
-
-~~~admonish warning title='WIP: Text can be improved'
-Maybe explain why a counter server is a useful server. For instance it
-can be used to dynamically bound a resource, such a the number of
-threads started when traversing a tree.
-~~~
+the counter is always non-negative. While this is perhaps not a
+terribly useful server, it does demonstrate facilities that most
+servers will need; namely keeping some kind of state, responding to
+requests for changes to that state, and maintaining invariants for
+that state.
 
 ### Step 1: Internal state