diff --git a/src/Ema/Changing.hs b/src/Ema/Changing.hs index b169db8..17747fd 100644 --- a/src/Ema/Changing.hs +++ b/src/Ema/Changing.hs @@ -3,10 +3,10 @@ module Ema.Changing where --- A mutable variable with change notification --- TODO: Rename to something more accurate? import qualified Data.Map.Strict as Map +-- A mutable variable with change notification +-- TODO: Rename to something more accurate? data Changing a = Changing { -- | A value that changes over time changingCurrent :: TMVar a, @@ -26,42 +26,39 @@ get :: MonadIO m => Changing a -> m a get v = atomically $ readTMVar $ changingCurrent v +-- | Sets a new value; listeners from @subscribe@ are automatically notifed. set :: MonadIO m => Changing a -> a -> m () set v val = do n <- atomically $ do void $ swapTMVar (changingCurrent v) val publish v when (n > 0) $ - putStrLn $ "pub: sent to " <> show n <> " subscribers" + putStrLn $ "pub: published; " <> show n <> " subscribers listening" + where + publish :: Changing a -> STM Int + publish v' = do + subs <- readTMVar $ changingSubscribers v' + forM_ (Map.elems subs) $ \subVar -> do + tryPutTMVar subVar () + pure $ Map.size subs -publish :: Changing a -> STM Int -publish v = do - subs <- readTMVar $ changingSubscribers v - forM_ (Map.elems subs) $ \subVar -> do - tryPutTMVar subVar () - pure $ Map.size subs - --- | Subscribes to new values as they are set. +-- | Subscribes to new values as they are set by @set@. subscribe :: MonadIO m => Changing a -> (Int -> a -> IO b) -> m (Int, IO ()) subscribe v f = do - putStrLn "sub" (idx, notify) <- atomically $ do subs <- readTMVar $ changingSubscribers v - let nextIdx = maybe 0 (succ . fst) $ Map.lookupMax subs + let nextIdx = maybe 1 (succ . fst) $ Map.lookupMax subs notify <- newEmptyTMVar void $ swapTMVar (changingSubscribers v) $ Map.insert nextIdx notify subs pure (nextIdx, notify) - putStrLn $ "sub[" <> show idx <> "]: created notify" - pure - ( idx, - void $ + let runSubscription = forever $ do val :: a <- atomically $ do takeTMVar notify readTMVar (changingCurrent v) - putStrLn $ "sub[" <> show idx <> "]: calling f" - liftIO $ f idx val - ) + putStrLn $ "sub[" <> show idx <> "]: sending" + liftIO $ void $ f idx val + pure (idx, runSubscription) unsubscribe :: MonadIO m => Changing a -> Int -> m () unsubscribe v subId = do diff --git a/src/Ema/Server.hs b/src/Ema/Server.hs index e45c436..47f5183 100644 --- a/src/Ema/Server.hs +++ b/src/Ema/Server.hs @@ -36,7 +36,7 @@ runServerWithWebSocketHotReload model render = do pathInfo <- pathInfoFromWsMsg <$> WS.receiveData @Text conn let r :: route = fromMaybe (error "invalid route from ws") $ routeFromPathInfo pathInfo log $ "Browser at route: " <> show r - (subId, send) <- Changing.subscribe @IO model $ \subId (val :: model) -> do + (subId, send) <- Changing.subscribe model $ \subId (val :: model) -> do try (WS.sendTextData conn $ routeHtml val r) >>= \case Right () -> pure () Left (err :: ConnectionException) -> do @@ -63,7 +63,8 @@ runServerWithWebSocketHotReload model render = do routeHtml m r = do render m r <> wsClientShim --- | Return equivalent of WAI's @pathInfo@, from the raw path string the browser strings us. +-- | Return the equivalent of WAI's @pathInfo@, from the raw path string +-- (`document.location.pathname`) the browser sends us. pathInfoFromWsMsg :: Text -> [Text] pathInfoFromWsMsg = filter (/= "") . T.splitOn "/" . T.drop 1 @@ -116,16 +117,13 @@ wsClientShim = ws.send(document.location.pathname); }; ws.onclose = () => { + // TODO: Display a message box on page during disconnected state. console.log("ema: closed; reloading.."); refreshPage(); }; ws.onmessage = evt => { - // console.log(evt.data); console.log("ema: Resetting HTML body") setInnerHtml(document.documentElement, evt.data); - // document.documentElement.innerHTML = evt.data; - // ws.close(); - // history.go(0); }; window.onbeforeunload = evt => { ws.close(); }; window.onpagehide = evt => { ws.close(); };