diff --git a/haskell/GenServer.hs b/haskell/GenServer.hs index 1a090bf..768544f 100644 --- a/haskell/GenServer.hs +++ b/haskell/GenServer.hs @@ -52,20 +52,21 @@ 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 @@ -73,30 +74,30 @@ 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 diff --git a/haskell/Week6/Counter.hs b/haskell/Week6/Counter.hs index 9ecf681..18ce915 100644 --- a/haskell/Week6/Counter.hs +++ b/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 diff --git a/src/chapter_6.md b/src/chapter_6.md index c112c15..62b41b2 100644 --- a/src/chapter_6.md +++ b/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