Clarify LVar listen behaviour

README.md

@@ -34,7 +34,7 @@ Run `bin/run` (or <kbd>Ctrl+Shift+B</kbd> in VSCode). This runs the documentatio
 pre-announce,
 - CLI UX 
   - [x] opts
-  - [ ] logging
+  - [x] logging
     - Expose it to apps (inc/ helpers) in a simple way
 - [x] [deal with errors](https://github.com/srid/memoir/issues/1)
 - [x] How to serve non-generated files (css, img, etc.)

src/Data/LVar.hs

@@ -1,8 +1,6 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TypeApplications #-}
 
--- | @LVar@ is like @Control.Concurrent.STM.TVar@ but with a capability for
+-- | @LVar@ is like @Control.Concurrent.STM.TMVar@ but with a capability for
 -- listening to its changes.
 module Data.LVar
   ( -- * Types
@@ -29,8 +27,8 @@ import Control.Exception (throw)
 import qualified Data.Map.Strict as Map
 import Prelude hiding (empty, get, modify)
 
--- A mutable variable, changes (@set@, @modify@) to which can be listened
--- (@addListener@, @removeListener@) to from multiple threads.
+-- A mutable variable (like @TMVar@), changes to which can be listened to from
+-- multiple threads.
 data LVar a = LVar
   { -- | A value that changes over time
     lvarCurrent :: TMVar a,
@@ -56,7 +54,7 @@ get :: MonadIO m => LVar a -> m a
 get v =
   atomically $ readTMVar $ lvarCurrent v
 
--- | Set the @LVar@ value; listeners from @listen@ are automatically notifed.
+-- | Set the @LVar@ value; active listeners are automatically notifed.
 set :: MonadIO m => LVar a -> a -> m ()
 set v val = do
   atomically $ do
@@ -66,10 +64,7 @@ set v val = do
       False -> void $ swapTMVar var val
     notifyListeners v
 
--- | Modify the @LVar@ value; listeners from @listen@ are automatically
--- notified.
---
--- Returns the number of listeners notified.
+-- | Modify the @LVar@ value; active listeners are automatically notified.
 modify :: MonadIO m => LVar a -> (a -> a) -> m ()
 modify v f = do
   atomically $ do
@@ -86,7 +81,11 @@ notifyListeners v' = do
 data ListenerDead = ListenerDead
   deriving (Exception, Show)
 
--- | Create a listener for changes to the @LVar@, as they are set by @set@ or @modify@
+-- | Create a listener for changes to the @LVar@, as they are set by @set@ or
+-- @modify@ from this time onwards.
+--
+-- You must call @listenNext@ to get the next updated value (or current value if
+-- there is one).
 --
 -- Returns a @ListenerId@ that can be used to stop listening later (via
 -- @removeListener@)
@@ -102,18 +101,29 @@ addListener v = do
       tryReadTMVar (lvarCurrent v) >>= \case
         Nothing -> newEmptyTMVar
         -- As a value is already available, send that as first notification.
-        -- FIXME: This may not be desirable; due to unnececessary DOM replacement by websocket client.
+        --
+        -- NOTE: Creating a TMVar that is "full" ensures that we send a current
+        -- (which is not empty) value on @listenNext@).
         Just _ -> newTMVar ()
     void $ swapTMVar (lvarListeners v) $ Map.insert nextIdx notify subs
     pure nextIdx
 
--- | Listen for the next value update (since the last @listenNext@ or @addListener@)
+-- | Listen for the next value update (since the last @listenNext@ or
+-- @addListener@). Unless the @LVar@ was empty when @addListener@ was invoked,
+-- the first invocation of @listenNext@ will return the current value even if
+-- there wasn't an update.  Therefore, the *first* call to @listenNext@ will
+-- *always* return immediately, unless the @LVar@ is empty.
+--
+-- Call this in a loop to listen on a series of updates.
+--
+-- Throws @ListenerDead@ if called with a @ListenerId@ that got already removed
+-- by @removeListener@.
 listenNext :: MonadIO m => LVar a -> ListenerId -> m a
 listenNext v idx = do
   atomically $ do
     lookupListener v idx >>= \case
       Nothing ->
-        -- XXX: can we avoid this?
+        -- FIXME: can we avoid this by design?
         throw ListenerDead
       Just listenVar -> do
         takeTMVar listenVar

src/Ema/Server.hs

@@ -53,12 +53,17 @@ runServerWithWebSocketHotReload port model render = do
             let log s = logDebugNS (toText @String $ printf "WS.Client.%.2d" subId) s
             log "Connected"
             let askClientForRoute = do
-                  msg :: Text <- WS.receiveData conn
-                  pure $
-                    msg
-                      & pathInfoFromWsMsg
-                      & routeFromPathInfo
-                      & fromMaybe (error "invalid route from ws")
+                  msg :: Text <- liftIO $ WS.receiveData conn
+                  let r =
+                        msg
+                          & pathInfoFromWsMsg
+                          & routeFromPathInfo
+                          & fromMaybe (error "invalid route from ws")
+                  log $ "<~~ " <> show r
+                  pure r
+                sendRouteHtmlToClient r s = do
+                  liftIO $ WS.sendTextData conn $ renderWithEmaHtmlShims s r
+                  log $ " ~~> " <> show r
                 loop = flip runLoggingT logger $ do
                   -- Notice that we @askClientForRoute@ in succession twice here.
                   -- The first route will be the route the client intends to observe
@@ -66,27 +71,22 @@ runServerWithWebSocketHotReload port model render = do
                   -- that the client wants to *switch* to that route. This proecess
                   -- repeats ad infinitum: i.e., the third route is for observing
                   -- changes, the fourth route is for switching to, and so on.
-                  watchingRoute <- liftIO askClientForRoute
-                  log $ "<~~ " <> show watchingRoute
+                  watchingRoute <- askClientForRoute
                   -- Listen *until* either we get a new value, or the client requests
                   -- to switch to a new route.
                   liftIO $ do
-                    race (LVar.listenNext model subId) askClientForRoute >>= \res -> flip runLoggingT logger $ case res of
+                    race (LVar.listenNext model subId) (runLoggingT askClientForRoute logger) >>= \res -> flip runLoggingT logger $ case res of
                       Left newHtml -> do
                         -- The page the user is currently viewing has changed. Send
                         -- the new HTML to them.
-                        liftIO $ WS.sendTextData conn $ renderWithEmaHtmlShims newHtml watchingRoute
-                        log $ " ~~> " <> show watchingRoute
+                        sendRouteHtmlToClient watchingRoute newHtml
                         lift loop
                       Right nextRoute -> do
                         -- The user clicked on a route link; send them the HTML for
                         -- that route this time, ignoring what we are watching
                         -- currently (we expect the user to initiate a watch route
                         -- request immediately following this).
-                        log $ "[Switch]: <~~ " <> show nextRoute
-                        html <- LVar.get model
-                        liftIO $ WS.sendTextData conn $ renderWithEmaHtmlShims html nextRoute
-                        log $ "[Switch]: ~~> " <> show nextRoute
+                        sendRouteHtmlToClient nextRoute =<< LVar.get model
                         lift loop
             liftIO (try loop) >>= \case
               Right () -> pure ()