diff --git a/ema-examples/ema-examples.cabal b/ema-examples/ema-examples.cabal index 88d0c779..b7095331 100644 --- a/ema-examples/ema-examples.cabal +++ b/ema-examples/ema-examples.cabal @@ -87,7 +87,7 @@ library , generic-optics , generics-sop , http-types - , lvar + , lvar >=0.2 , monad-logger , monad-logger-extras , mtl diff --git a/ema/CHANGELOG.md b/ema/CHANGELOG.md index 2a165ed4..76dc5823 100644 --- a/ema/CHANGELOG.md +++ b/ema/CHANGELOG.md @@ -3,6 +3,7 @@ ## Unreleased (0.10.4.0) - Relax `base` constraint forever +- Require `lvar` 0.2 or later ([simplified API](https://github.com/srid/lvar/pull/8)) - API changes - `Ema.CLI`: The `Action` type is no longer a GADT. - `Ema.Server`: This module has be split into several smaller modules diff --git a/ema/ema.cabal b/ema/ema.cabal index 7d1bbb47..8edaeeee 100644 --- a/ema/ema.cabal +++ b/ema/ema.cabal @@ -86,7 +86,7 @@ library , filepath , filepattern , http-types - , lvar + , lvar >=0.2 , monad-logger , monad-logger-extras , mtl diff --git a/ema/src/Ema/Server/WebSocket.hs b/ema/src/Ema/Server/WebSocket.hs index 9f5dc306..2368a9eb 100644 --- a/ema/src/Ema/Server/WebSocket.hs +++ b/ema/src/Ema/Server/WebSocket.hs @@ -17,7 +17,6 @@ import Ema.Site (EmaStaticSite) import Network.WebSockets (ConnectionException) import Network.WebSockets qualified as WS import Optics.Core (review) -import Text.Printf (printf) import UnliftIO.Async (race) import UnliftIO.Exception (try) @@ -32,9 +31,8 @@ wsApp :: wsApp logger model emaWsHandler pendingConn = do conn :: WS.Connection <- WS.acceptRequest pendingConn WS.withPingThread conn 30 pass . flip runLoggingT logger $ do - subId <- LVar.addListener model let log lvl (s :: Text) = - logWithoutLoc (toText @String $ printf "ema.ws.%.2d" subId) lvl s + logWithoutLoc "ema.ws" lvl s log LevelInfo "Connected" let wsHandler = unEmaWsHandler emaWsHandler conn sendRouteHtmlToClient path s = do @@ -60,7 +58,7 @@ wsApp logger model emaWsHandler pendingConn = do -- Listen *until* either we get a new value, or the client requests -- to switch to a new route. currentModel <- LVar.get model - race (LVar.listenNext model subId) (wsHandler currentModel) >>= \case + race (LVar.listenNext model) (wsHandler currentModel) >>= \case Left newModel -> do -- The page the user is currently viewing has changed. Send -- the new HTML to them. @@ -83,4 +81,3 @@ wsApp logger model emaWsHandler pendingConn = do log LevelInfo $ "Closing websocket connection (reason: " <> reason <> ")" _ -> log LevelError $ "Websocket error: " <> show connExc - LVar.removeListener model subId diff --git a/flake.lock b/flake.lock index 91e3d612..f6275a3b 100644 --- a/flake.lock +++ b/flake.lock @@ -225,6 +225,22 @@ "type": "github" } }, + "lvar": { + "flake": false, + "locked": { + "lastModified": 1745122737, + "narHash": "sha256-ZnYXkkPmnNvt4tA45JgSC7dpttmqhUo4AHfEjB1r1gE=", + "owner": "srid", + "repo": "lvar", + "rev": "047a24c4dcd7f85f9c18058f6be991cea531870e", + "type": "github" + }, + "original": { + "owner": "srid", + "repo": "lvar", + "type": "github" + } + }, "nixos-unified": { "locked": { "lastModified": 1729697921, @@ -291,6 +307,7 @@ "fourmolu-nix": "fourmolu-nix", "git-hooks": "git-hooks", "haskell-flake": "haskell-flake_2", + "lvar": "lvar", "nixpkgs": "nixpkgs_2" } }, diff --git a/flake.nix b/flake.nix index 836d00d4..bca66f9c 100644 --- a/flake.nix +++ b/flake.nix @@ -8,6 +8,9 @@ git-hooks.url = "github:cachix/git-hooks.nix"; git-hooks.flake = false; emanote.url = "github:srid/emanote"; + + lvar.url = "github:srid/lvar"; + lvar.flake = false; }; outputs = inputs@{ self, nixpkgs, flake-parts, ... }: flake-parts.lib.mkFlake { inherit inputs; } { @@ -22,6 +25,7 @@ # This attr is provided by https://github.com/srid/haskell-flake haskellProjects.default = { autoWire = [ "packages" "checks" ]; + packages.lvar.source = inputs.lvar; }; devShells.default = pkgs.mkShell {